From 54a68014ea9f8e1593d1871fecb8a739563b98f0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 24 Apr 2018 17:31:05 +0200 Subject: [PATCH 01/79] Ntrans not needed/used. Simplified storage of parameters --- PRIVATE | 2 +- src/plastic_phenopowerlaw.f90 | 286 ++++++++++++++-------------------- 2 files changed, 121 insertions(+), 167 deletions(-) diff --git a/PRIVATE b/PRIVATE index af8516892..7c69abfc5 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit af851689285b8c1a633495219abd9dbbd5a11c69 +Subproject commit 7c69abfc5bf54c083b9096511abde7d74b806b7f diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 229d03c26..368ce8bd5 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -24,36 +24,13 @@ module plastic_phenopowerlaw integer(pInt), dimension(:), allocatable, public, protected :: & plastic_phenopowerlaw_totalNslip, & !< no. of slip system used in simulation - plastic_phenopowerlaw_totalNtwin, & !< no. of twin system used in simulation - plastic_phenopowerlaw_totalNtrans !< no. of trans system used in simulation + plastic_phenopowerlaw_totalNtwin !< no. of twin system used in simulation + integer(pInt), dimension(:,:), allocatable, private :: & plastic_phenopowerlaw_Nslip, & !< active number of slip systems per family (input parameter, per family) - plastic_phenopowerlaw_Ntwin, & !< active number of twin systems per family (input parameter, per family) - plastic_phenopowerlaw_Ntrans !< active number of trans systems per family (input parameter, per family) + plastic_phenopowerlaw_Ntwin !< active number of twin systems per family (input parameter, per family) - real(pReal), dimension(:), allocatable, private :: & - plastic_phenopowerlaw_gdot0_slip, & !< reference shear strain rate for slip (input parameter) - plastic_phenopowerlaw_gdot0_twin, & !< reference shear strain rate for twin (input parameter) - plastic_phenopowerlaw_n_slip, & !< stress exponent for slip (input parameter) - plastic_phenopowerlaw_n_twin, & !< stress exponent for twin (input parameter) - plastic_phenopowerlaw_spr, & !< push-up factor for slip saturation due to twinning - plastic_phenopowerlaw_twinB, & - plastic_phenopowerlaw_twinC, & - plastic_phenopowerlaw_twinD, & - plastic_phenopowerlaw_twinE, & - plastic_phenopowerlaw_h0_SlipSlip, & !< reference hardening slip - slip (input parameter) - plastic_phenopowerlaw_h0_TwinSlip, & !< reference hardening twin - slip (input parameter) - plastic_phenopowerlaw_h0_TwinTwin, & !< reference hardening twin - twin (input parameter) - plastic_phenopowerlaw_a_slip, & - plastic_phenopowerlaw_aTolResistance, & - plastic_phenopowerlaw_aTolShear, & - plastic_phenopowerlaw_aTolTwinfrac, & - plastic_phenopowerlaw_aTolTransfrac, & - plastic_phenopowerlaw_Cnuc, & !< coefficient for strain-induced martensite nucleation - plastic_phenopowerlaw_Cdwp, & !< coefficient for double well potential - plastic_phenopowerlaw_Cgro, & !< coefficient for stress-assisted martensite growth - plastic_phenopowerlaw_deltaG !< free energy difference between austensite and martensite [MPa] real(pReal), dimension(:,:), allocatable, private :: & plastic_phenopowerlaw_tau0_slip, & !< initial critical shear stress for slip (input parameter, per family) @@ -89,6 +66,41 @@ module plastic_phenopowerlaw integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & plastic_phenopowerlaw_outputID !< ID of each post result output + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + gdot0_slip, & !< reference shear strain rate for slip + gdot0_twin, & !< reference shear strain rate for twin + n_slip, & !< stress exponent for slip + n_twin, & !< stress exponent for twin + spr, & !< push-up factor for slip saturation due to twinning + twinB, & + twinC, & + twinD, & + twinE, & + h0_SlipSlip, & !< reference hardening slip - slip + h0_TwinSlip, & !< reference hardening twin - slip + h0_TwinTwin, & !< reference hardening twin - twin + a_slip, & + aTolResistance = 1.0_pReal, & ! default absolute tolerance 1 Pa + aTolShear = 1.0e-6_pReal, & ! default absolute tolerance 1e-6 + aTolTwinfrac = 1.0e-6_pReal ! default absolute tolerance 1e-6 + integer(pInt), dimension(:), allocatable :: & + Nslip, & !< active number of slip systems per family + Ntwin !< active number of twin systems per family + real(pReal), dimension(:), allocatable :: & + tau0_slip, & !< initial critical shear stress for slip + tau0_twin, & !< initial critical shear stress for twin + tausat_slip, & !< maximum critical shear stress for slip + nonSchmidCoeff, & + H_int, & !< per family hardening activity (optional) + + interaction_SlipSlip, & !< slip resistance from slip activity + interaction_SlipTwin, & !< slip resistance from twin activity + interaction_TwinSlip, & !< twin resistance from slip activity + interaction_TwinTwin !< twin resistance from twin activity + end type + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type, private :: tPhenopowerlawState real(pReal), pointer, dimension(:,:) :: & s_slip, & @@ -180,7 +192,8 @@ subroutine plastic_phenopowerlaw_init(fileUnit) startIndex, endIndex character(len=65536) :: & tag = '', & - line = '' + line = '', & + outputtag = '' real(pReal), dimension(:), allocatable :: tempPerSlip write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' @@ -200,29 +213,19 @@ subroutine plastic_phenopowerlaw_init(fileUnit) allocate(plastic_phenopowerlaw_output(maxval(phase_Noutput),maxNinstance)) plastic_phenopowerlaw_output = '' allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) + + allocate(param(maxNinstance)) ! one container of parameters per instance + + allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_Ntrans(lattice_maxNtransFamily,maxNinstance),source=0_pInt) allocate(plastic_phenopowerlaw_totalNslip(maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_totalNtwin(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_totalNtrans(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_gdot0_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_n_slip(maxNinstance), source=0.0_pReal) allocate(plastic_phenopowerlaw_tau0_slip(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) allocate(plastic_phenopowerlaw_tausat_slip(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) allocate(plastic_phenopowerlaw_H_int(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_phenopowerlaw_gdot0_twin(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_n_twin(maxNinstance), source=0.0_pReal) allocate(plastic_phenopowerlaw_tau0_twin(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_spr(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinB(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinC(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinD(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinE(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_h0_SlipSlip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_h0_TwinSlip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_h0_TwinTwin(maxNinstance), source=0.0_pReal) allocate(plastic_phenopowerlaw_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance), & source=0.0_pReal) allocate(plastic_phenopowerlaw_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance), & @@ -231,17 +234,8 @@ subroutine plastic_phenopowerlaw_init(fileUnit) source=0.0_pReal) allocate(plastic_phenopowerlaw_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance), & source=0.0_pReal) - allocate(plastic_phenopowerlaw_a_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolResistance(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolShear(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolTwinfrac(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolTransfrac(maxNinstance), source=0.0_pReal) allocate(plastic_phenopowerlaw_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), & source=0.0_pReal) - allocate(plastic_phenopowerlaw_Cnuc(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_Cdwp(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_Cgro(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_deltaG(maxNinstance), source=0.0_pReal) rewind(fileUnit) phase = 0_pInt @@ -261,7 +255,6 @@ subroutine plastic_phenopowerlaw_init(fileUnit) if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase - Nchunks_TransFamilies = count(lattice_NtransSystem(:,phase) > 0_pInt) ! maximum number of trans families according to lattice type of current phase Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) @@ -278,58 +271,43 @@ subroutine plastic_phenopowerlaw_init(fileUnit) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') + outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt ! assume valid output + plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = outputtag ! assume valid output select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) case ('resistance_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulatedshear_slip','accumulated_shear_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shearrate_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolvedstress_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('totalshear') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalshear_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resistance_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('accumulatedshear_twin','accumulated_shear_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('shearrate_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('resolvedstress_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt + plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case ('totalvolfrac_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalvolfrac_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + case default + plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) - 1_pInt ! correct for invalid end select !-------------------------------------------------------------------------------------------------- @@ -374,17 +352,6 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plastic_phenopowerlaw_tau0_twin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo !-------------------------------------------------------------------------------------------------- -! parameters depending on number of transformation families - case ('ntrans') - if (chunkPos(1) < Nchunks_TransFamilies + 1_pInt) & - call IO_warning(53_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (chunkPos(1) > Nchunks_TransFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_TransFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_TransFamilies - plastic_phenopowerlaw_Ntrans(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo -!-------------------------------------------------------------------------------------------------- ! parameters depending on number of interactions case ('interaction_slipslip') if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & @@ -416,50 +383,41 @@ subroutine plastic_phenopowerlaw_init(fileUnit) do j = 1_pInt,Nchunks_nonSchmid plastic_phenopowerlaw_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip/twin systems case ('gdot0_slip') - plastic_phenopowerlaw_gdot0_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%gdot0_slip = IO_floatValue(line,chunkPos,2_pInt) case ('n_slip') - plastic_phenopowerlaw_n_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%n_slip = IO_floatValue(line,chunkPos,2_pInt) case ('a_slip', 'w0_slip') - plastic_phenopowerlaw_a_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%a_slip = IO_floatValue(line,chunkPos,2_pInt) case ('gdot0_twin') - plastic_phenopowerlaw_gdot0_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%gdot0_twin = IO_floatValue(line,chunkPos,2_pInt) case ('n_twin') - plastic_phenopowerlaw_n_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%n_twin = IO_floatValue(line,chunkPos,2_pInt) case ('s_pr') - plastic_phenopowerlaw_spr(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%spr = IO_floatValue(line,chunkPos,2_pInt) case ('twin_b') - plastic_phenopowerlaw_twinB(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%twinB = IO_floatValue(line,chunkPos,2_pInt) case ('twin_c') - plastic_phenopowerlaw_twinC(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%twinC = IO_floatValue(line,chunkPos,2_pInt) case ('twin_d') - plastic_phenopowerlaw_twinD(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%twinD = IO_floatValue(line,chunkPos,2_pInt) case ('twin_e') - plastic_phenopowerlaw_twinE(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%twinE = IO_floatValue(line,chunkPos,2_pInt) case ('h0_slipslip') - plastic_phenopowerlaw_h0_SlipSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%h0_SlipSlip = IO_floatValue(line,chunkPos,2_pInt) case ('h0_twinslip') - plastic_phenopowerlaw_h0_TwinSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%h0_TwinSlip = IO_floatValue(line,chunkPos,2_pInt) case ('h0_twintwin') - plastic_phenopowerlaw_h0_TwinTwin(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%h0_TwinTwin = IO_floatValue(line,chunkPos,2_pInt) case ('atol_resistance') - plastic_phenopowerlaw_aTolResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%aTolResistance = IO_floatValue(line,chunkPos,2_pInt) case ('atol_shear') - plastic_phenopowerlaw_aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%aTolShear = IO_floatValue(line,chunkPos,2_pInt) case ('atol_twinfrac') - plastic_phenopowerlaw_aTolTwinfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_transfrac') - plastic_phenopowerlaw_aTolTransfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cnuc') - plastic_phenopowerlaw_Cnuc(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cdwp') - plastic_phenopowerlaw_Cdwp(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cgro') - plastic_phenopowerlaw_Cgro(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('deltag') - plastic_phenopowerlaw_deltaG(instance) = IO_floatValue(line,chunkPos,2_pInt) + param(instance)%aTolTwinfrac = IO_floatValue(line,chunkPos,2_pInt) case default end select @@ -477,37 +435,34 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plastic_phenopowerlaw_Ntwin(:,instance)) plastic_phenopowerlaw_totalNslip(instance) = sum(plastic_phenopowerlaw_Nslip(:,instance)) ! how many slip systems altogether plastic_phenopowerlaw_totalNtwin(instance) = sum(plastic_phenopowerlaw_Ntwin(:,instance)) ! how many twin systems altogether - plastic_phenopowerlaw_totalNtrans(instance) = sum(plastic_phenopowerlaw_Ntrans(:,instance)) ! how many trans systems altogether if (any(plastic_phenopowerlaw_tau0_slip(:,instance) < 0.0_pReal .and. & plastic_phenopowerlaw_Nslip(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (plastic_phenopowerlaw_gdot0_slip(instance) <= 0.0_pReal) & + if (param(instance)%gdot0_slip <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (plastic_phenopowerlaw_n_slip(instance) <= 0.0_pReal) & + if (param(instance)%n_slip <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') if (any(plastic_phenopowerlaw_tausat_slip(:,instance) <= 0.0_pReal .and. & plastic_phenopowerlaw_Nslip(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(dEq0(plastic_phenopowerlaw_a_slip(instance)) .and. plastic_phenopowerlaw_Nslip(:,instance) > 0)) & + if (any(dEq0(param(instance)%a_slip) .and. plastic_phenopowerlaw_Nslip(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') if (any(plastic_phenopowerlaw_tau0_twin(:,instance) < 0.0_pReal .and. & plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( plastic_phenopowerlaw_gdot0_twin(instance) <= 0.0_pReal .and. & + if ( param(instance)%gdot0_twin <= 0.0_pReal .and. & any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( plastic_phenopowerlaw_n_twin(instance) <= 0.0_pReal .and. & + if ( param(instance)%n_twin <= 0.0_pReal .and. & any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (plastic_phenopowerlaw_aTolResistance(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolResistance(instance) = 1.0_pReal ! default absolute tolerance 1 Pa - if (plastic_phenopowerlaw_aTolShear(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolShear(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (plastic_phenopowerlaw_aTolTwinfrac(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolTwinfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (plastic_phenopowerlaw_aTolTransfrac(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolTransfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + if (param(instance)%aTolResistance <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolResistance ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (param(instance)%aTolShear <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolShear ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (param(instance)%aTolTwinfrac <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') endif myPhase enddo sanityChecks @@ -578,7 +533,7 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plasticState(phase)%sizePostResults = plastic_phenopowerlaw_sizePostResults(instance) plasticState(phase)%nSlip =plastic_phenopowerlaw_totalNslip(instance) plasticState(phase)%nTwin =plastic_phenopowerlaw_totalNtwin(instance) - plasticState(phase)%nTrans=plastic_phenopowerlaw_totalNtrans(instance) + plasticState(phase)%nTrans=0_pInt allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) @@ -751,19 +706,18 @@ subroutine plastic_phenopowerlaw_aTolState(ph,instance) plasticState(ph)%aTolState(1:plastic_phenopowerlaw_totalNslip(instance)+ & plastic_phenopowerlaw_totalNtwin(instance)) = & - plastic_phenopowerlaw_aTolResistance(instance) + param(instance)%aTolResistance plasticState(ph)%aTolState(1+plastic_phenopowerlaw_totalNslip(instance)+ & plastic_phenopowerlaw_totalNtwin(instance)) = & - plastic_phenopowerlaw_aTolShear(instance) + param(instance)%aTolShear plasticState(ph)%aTolState(2+plastic_phenopowerlaw_totalNslip(instance)+ & plastic_phenopowerlaw_totalNtwin(instance)) = & - plastic_phenopowerlaw_aTolTwinFrac(instance) + param(instance)%aTolTwinFrac plasticState(ph)%aTolState(3+plastic_phenopowerlaw_totalNslip(instance)+ & plastic_phenopowerlaw_totalNtwin(instance): & 2+2*(plastic_phenopowerlaw_totalNslip(instance)+ & plastic_phenopowerlaw_totalNtwin(instance))) = & - plastic_phenopowerlaw_aTolShear(instance) - + param(instance)%aTolShear end subroutine plastic_phenopowerlaw_aTolState @@ -850,20 +804,20 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)*& lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo - gdot_slip_pos = 0.5_pReal*plastic_phenopowerlaw_gdot0_slip(instance)* & + gdot_slip_pos = 0.5_pReal*param(instance)%gdot0_slip* & ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of))) & - **plastic_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_pos) + **param(instance)%n_slip)*sign(1.0_pReal,tau_slip_pos) - gdot_slip_neg = 0.5_pReal*plastic_phenopowerlaw_gdot0_slip(instance)* & + gdot_slip_neg = 0.5_pReal*param(instance)%gdot0_slip* & ((abs(tau_slip_neg)/(state(instance)%s_slip(j,of))) & - **plastic_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_neg) + **param(instance)%n_slip)*sign(1.0_pReal,tau_slip_neg) Lp = Lp + (1.0_pReal-state(instance)%sumF(of))*& ! 1-F (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! Calculation of the tangent of Lp if (dNeq0(gdot_slip_pos)) then - dgdot_dtauslip_pos = gdot_slip_pos*plastic_phenopowerlaw_n_slip(instance)/tau_slip_pos + dgdot_dtauslip_pos = gdot_slip_pos*param(instance)%n_slip/tau_slip_pos 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*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & @@ -871,7 +825,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, endif if (dNeq0(gdot_slip_neg)) then - dgdot_dtauslip_neg = gdot_slip_neg*plastic_phenopowerlaw_n_slip(instance)/tau_slip_neg + dgdot_dtauslip_neg = gdot_slip_neg*param(instance)%n_slip/tau_slip_neg 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*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & @@ -891,14 +845,14 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, ! Calculation of Lp tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) gdot_twin = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F - plastic_phenopowerlaw_gdot0_twin(instance)*& + param(instance)%gdot0_twin*& (abs(tau_twin)/state(instance)%s_twin(j,of))**& - plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) ! Calculation of the tangent of Lp if (dNeq0(gdot_twin)) then - dgdot_dtautwin = gdot_twin*plastic_phenopowerlaw_n_twin(instance)/tau_twin + dgdot_dtautwin = gdot_twin*param(instance)%n_twin/tau_twin 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*lattice_Stwin(k,l,index_myFamily+i,ph)* & @@ -971,17 +925,17 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices - c_SlipSlip = plastic_phenopowerlaw_h0_SlipSlip(instance)*& - (1.0_pReal + plastic_phenopowerlaw_twinC(instance)*plasticState(ph)%state(index_F,of)**& - plastic_phenopowerlaw_twinB(instance)) - c_TwinSlip = plastic_phenopowerlaw_h0_TwinSlip(instance)*& - plasticState(ph)%state(index_Gamma,of)**plastic_phenopowerlaw_twinE(instance) - c_TwinTwin = plastic_phenopowerlaw_h0_TwinTwin(instance)*& - plasticState(ph)%state(index_F,of)**plastic_phenopowerlaw_twinD(instance) + c_SlipSlip = param(instance)%h0_slipslip*& + (1.0_pReal + param(instance)%twinC*plasticState(ph)%state(index_F,of)**& + param(instance)%twinB) + c_TwinSlip = param(instance)%h0_TwinSlip*& + plasticState(ph)%state(index_Gamma,of)**param(instance)%twinE + c_TwinTwin = param(instance)%h0_TwinTwin*& + plasticState(ph)%state(index_F,of)**param(instance)%twinD !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors and calculate dot gammas - ssat_offset = plastic_phenopowerlaw_spr(instance)*sqrt(plasticState(ph)%state(index_F,of)) + ssat_offset = param(instance)%spr*sqrt(plasticState(ph)%state(index_F,of)) j = 0_pInt slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family @@ -991,7 +945,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & - **plastic_phenopowerlaw_a_slip(instance)& + **param(instance)%a_slip& *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) right_TwinSlip(j) = 1.0_pReal ! no system-dependent part @@ -1006,10 +960,10 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems - gdot_slip(j) = plastic_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/(plasticState(ph)%state(j,of)))**plastic_phenopowerlaw_n_slip(instance) & + gdot_slip(j) = param(instance)%gdot0_slip*0.5_pReal* & + ((abs(tau_slip_pos)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**plastic_phenopowerlaw_n_slip(instance) & + +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -1030,9 +984,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ! Calculation of dot vol frac tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - plastic_phenopowerlaw_gdot0_twin(instance)*& + param(instance)%gdot0_twin*& (abs(tau_twin)/plasticState(ph)%state(nslip+j,of))**& - plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) enddo twinSystems1 enddo twinFamilies1 @@ -1153,10 +1107,10 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo - plastic_phenopowerlaw_postResults(c+j) = plastic_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**plastic_phenopowerlaw_n_slip(instance) & + plastic_phenopowerlaw_postResults(c+j) = param(instance)%gdot0_slip*0.5_pReal* & + ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**plastic_phenopowerlaw_n_slip(instance) & + +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -1196,9 +1150,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) j = j + 1_pInt tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - plastic_phenopowerlaw_gdot0_twin(instance)*& + param(instance)%gdot0_twin*& (abs(tau)/plasticState(ph)%state(j+nSlip,of))**& - plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau)) + param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) enddo twinSystems1 enddo twinFamilies1 c = c + nTwin From 81cab02d7ab98b36fdc43b3c9b339aa25566a7a5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 25 Apr 2018 19:41:18 +0200 Subject: [PATCH 02/79] simplified reading in and initialization init of absolute tolerances and state0 done on the fly reading in array type parameters in the param structure : --- src/math.f90 | 3 +- src/plastic_phenopowerlaw.f90 | 527 ++++++++++++++-------------------- 2 files changed, 225 insertions(+), 305 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 7e35ca390..4354354f7 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -159,7 +159,8 @@ module math math_rotate_forward33, & math_rotate_backward33, & math_rotate_forward3333, & - math_limit + math_limit, & + math_expand private :: & halton, & halton_memory, & diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 368ce8bd5..4b41f9ad2 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -22,33 +22,19 @@ module plastic_phenopowerlaw integer(pInt), dimension(:), allocatable, target, public :: & plastic_phenopowerlaw_Noutput !< number of outputs per instance of this constitution - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_phenopowerlaw_totalNslip, & !< no. of slip system used in simulation - plastic_phenopowerlaw_totalNtwin !< no. of twin system used in simulation + integer(pInt), dimension(:), allocatable, private :: & + totalNslip, & !< no. of slip system used in simulation + totalNtwin !< no. of twin system used in simulation - integer(pInt), dimension(:,:), allocatable, private :: & - plastic_phenopowerlaw_Nslip, & !< active number of slip systems per family (input parameter, per family) - plastic_phenopowerlaw_Ntwin !< active number of twin systems per family (input parameter, per family) + real(pReal), dimension(:,:,:), allocatable, private :: & + + interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) + interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) + interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) + interaction_TwinTwin !< interaction factors twin - twin (input parameter) - real(pReal), dimension(:,:), allocatable, private :: & - plastic_phenopowerlaw_tau0_slip, & !< initial critical shear stress for slip (input parameter, per family) - plastic_phenopowerlaw_tau0_twin, & !< initial critical shear stress for twin (input parameter, per family) - plastic_phenopowerlaw_tausat_slip, & !< maximum critical shear stress for slip (input parameter, per family) - plastic_phenopowerlaw_H_int, & !< per family hardening activity(input parameter(optional), per family) - plastic_phenopowerlaw_nonSchmidCoeff, & - - plastic_phenopowerlaw_interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) - plastic_phenopowerlaw_interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) - plastic_phenopowerlaw_interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) - plastic_phenopowerlaw_interaction_TwinTwin !< interaction factors twin - twin (input parameter) - - real(pReal), dimension(:,:,:), allocatable, private :: & - plastic_phenopowerlaw_hardeningMatrix_SlipSlip, & - plastic_phenopowerlaw_hardeningMatrix_SlipTwin, & - plastic_phenopowerlaw_hardeningMatrix_TwinSlip, & - plastic_phenopowerlaw_hardeningMatrix_TwinTwin enum, bind(c) enumerator :: undefined_ID, & @@ -114,18 +100,13 @@ module plastic_phenopowerlaw type(tPhenopowerlawState), allocatable, dimension(:), private :: & dotState, & - state, & - state0 + state public :: & plastic_phenopowerlaw_init, & plastic_phenopowerlaw_LpAndItsTangent, & plastic_phenopowerlaw_dotState, & plastic_phenopowerlaw_postResults - private :: & - plastic_phenopowerlaw_aTolState, & - plastic_phenopowerlaw_stateInit - contains @@ -148,7 +129,8 @@ subroutine plastic_phenopowerlaw_init(fileUnit) debug_levelBasic use math, only: & math_Mandel3333to66, & - math_Voigt66to3333 + math_Voigt66to3333, & + math_expand use IO, only: & IO_read, & IO_lc, & @@ -191,8 +173,10 @@ subroutine plastic_phenopowerlaw_init(fileUnit) mySize=0_pInt,sizeState,sizeDotState, sizeDeltaState, & startIndex, endIndex character(len=65536) :: & - tag = '', & - line = '', & + tag = '', & + line = '', & + extmsg = '' + character(len=64) :: & outputtag = '' real(pReal), dimension(:), allocatable :: tempPerSlip @@ -214,28 +198,11 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plastic_phenopowerlaw_output = '' allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) - allocate(param(maxNinstance)) ! one container of parameters per instance - - allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_totalNslip(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_totalNtwin(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_tau0_slip(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_phenopowerlaw_tausat_slip(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_phenopowerlaw_H_int(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_phenopowerlaw_tau0_twin(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_TwinSlip(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), & - source=0.0_pReal) + + allocate(totalNslip(maxNinstance), source=0_pInt) + allocate(totalNtwin(maxNinstance), source=0_pInt) + allocate(param(maxNinstance)) ! one container of parameters per instance rewind(fileUnit) phase = 0_pInt @@ -253,6 +220,7 @@ subroutine plastic_phenopowerlaw_init(fileUnit) if (IO_getTag(line,'[',']') /= '') then ! next phase phase = phase + 1_pInt ! advance phase section counter if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then + instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) @@ -261,15 +229,24 @@ subroutine plastic_phenopowerlaw_init(fileUnit) Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) Nchunks_nonSchmid = lattice_NnonSchmid(phase) if(allocated(tempPerSlip)) deallocate(tempPerSlip) + !allocate(param(instance)%H_int,source=tempPerSlip) gfortran 5 does not support this + allocate(param(instance)%H_int(Nchunks_SlipFamilies),source=0.0_pReal) + allocate(param(instance)%interaction_SlipSlip(Nchunks_SlipSlip),source=0.0_pReal) + allocate(param(instance)%interaction_SlipTwin(Nchunks_SlipTwin),source=0.0_pReal) + allocate(param(instance)%interaction_TwinSlip(Nchunks_TwinSlip),source=0.0_pReal) + allocate(param(instance)%interaction_TwinTwin(Nchunks_TwinTwin),source=0.0_pReal) + allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid),source=0.0_pReal) + allocate(tempPerSlip(Nchunks_SlipFamilies)) endif cycle ! skip to next line endif 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 + chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) + select case(tag) + case ('(output)') outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt ! assume valid output @@ -310,80 +287,87 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) - 1_pInt ! correct for invalid end select + !-------------------------------------------------------------------------------------------------- ! parameters depending on number of slip families case ('nslip') - if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) + if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) call IO_warning(50_pInt,ext_msg=extmsg) + if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) + allocate(param(instance)%Nslip(Nchunks_SlipFamilies),source=-1_pInt) do j = 1_pInt, Nchunks_SlipFamilies - plastic_phenopowerlaw_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + param(instance)%Nslip(j) = min(IO_intValue(line,chunkPos,1_pInt+j), & + lattice_NslipSystem(j,phase)) ! limit active slip systems per family to min of available and requested enddo - case ('tausat_slip','tau0_slip','H_int') + totalNslip(instance) = sum(param(instance)%Nslip) ! how many slip systems altogether + + case ('tausat_slip','tau0_slip','h_int') tempPerSlip = 0.0_pReal do j = 1_pInt, Nchunks_SlipFamilies - if (plastic_phenopowerlaw_Nslip(j,instance) > 0_pInt) & + if (param(instance)%Nslip(j) > 0_pInt) & tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo - select case(tag) + select case(tag) ! here, all arrays are allocated automatically case ('tausat_slip') - plastic_phenopowerlaw_tausat_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + param(instance)%tausat_slip = tempPerSlip case ('tau0_slip') - plastic_phenopowerlaw_tau0_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('H_int') - plastic_phenopowerlaw_H_int(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) + param(instance)%tau0_slip = tempPerSlip + case ('h_int') + param(instance)%H_int = tempPerSlip end select + !-------------------------------------------------------------------------------------------------- ! parameters depending on number of twin families case ('ntwin') - if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & - call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) call IO_warning(51_pInt,ext_msg=extmsg) + if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) Nchunks_TwinFamilies = chunkPos(1) - 1_pInt + allocate(param(instance)%Ntwin(Nchunks_TwinFamilies),source=-1_pInt) do j = 1_pInt, Nchunks_TwinFamilies - plastic_phenopowerlaw_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + param(instance)%Ntwin(j) = min(IO_intValue(line,chunkPos,1_pInt+j), & + lattice_NtwinSystem(j,phase)) ! limit active twin systems per family to min of available and requested enddo + totalNtwin(instance) = sum(param(instance)%Ntwin) ! how many twin systems altogether + case ('tau0_twin') + allocate(param(instance)%tau0_twin(Nchunks_TwinFamilies),source=0.0_pReal) do j = 1_pInt, Nchunks_TwinFamilies - if (plastic_phenopowerlaw_Ntwin(j,instance) > 0_pInt) & - plastic_phenopowerlaw_tau0_twin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + if (param(instance)%Ntwin(j) > 0_pInt) & + param(instance)%tau0_twin(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + !-------------------------------------------------------------------------------------------------- ! parameters depending on number of interactions case ('interaction_slipslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) call IO_warning(52_pInt,ext_msg=extmsg) do j = 1_pInt, Nchunks_SlipSlip - plastic_phenopowerlaw_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + param(instance)%interaction_SlipSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + case ('interaction_sliptwin') - if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) call IO_warning(52_pInt,ext_msg=extmsg) do j = 1_pInt, Nchunks_SlipTwin - plastic_phenopowerlaw_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + param(instance)%interaction_SlipTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + case ('interaction_twinslip') - if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) call IO_warning(52_pInt,ext_msg=extmsg) do j = 1_pInt, Nchunks_TwinSlip - plastic_phenopowerlaw_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + param(instance)%interaction_TwinSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + case ('interaction_twintwin') - if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) call IO_warning(52_pInt,ext_msg=extmsg) do j = 1_pInt, Nchunks_TwinTwin - plastic_phenopowerlaw_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + param(instance)%interaction_TwinTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo + case ('nonschmid_coefficients') - if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) call IO_warning(52_pInt,ext_msg=extmsg) do j = 1_pInt,Nchunks_nonSchmid - plastic_phenopowerlaw_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) + param(instance)%nonSchmidCoeff(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo - + !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip/twin systems case ('gdot0_slip') @@ -427,36 +411,35 @@ subroutine plastic_phenopowerlaw_init(fileUnit) sanityChecks: do phase = 1_pInt, size(phase_plasticity) myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then instance = phase_plasticityInstance(phase) - plastic_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 - plastic_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,instance)) - plastic_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 - plastic_phenopowerlaw_Ntwin(:,instance)) - plastic_phenopowerlaw_totalNslip(instance) = sum(plastic_phenopowerlaw_Nslip(:,instance)) ! how many slip systems altogether - plastic_phenopowerlaw_totalNtwin(instance) = sum(plastic_phenopowerlaw_Ntwin(:,instance)) ! how many twin systems altogether + totalNslip(instance) = sum(param(instance)%Nslip) ! how many slip systems altogether. ToDo: ok for unallocated Nslip + totalNtwin(instance) = sum(param(instance)%Ntwin) ! how many twin systems altogether. ToDo: ok for unallocated Ntwin + slipActive: if (allocated(param(instance)%Nslip)) then + if (any(param(instance)%tau0_slip < 0.0_pReal .and. & + param(instance)%Nslip(:) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (param(instance)%gdot0_slip <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (param(instance)%n_slip <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(param(instance)%tausat_slip <= 0.0_pReal .and. & + param(instance)%Nslip(:) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(dEq0(param(instance)%a_slip) .and. param(instance)%Nslip(:) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + endif slipActive + + twinActive: if (allocated(param(instance)%Ntwin)) then + ! if (any(param(instance)%tau0_twin < 0.0_pReal .and. & + ! param(instance)%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + ! if ( param(instance)%gdot0_twin <= 0.0_pReal .and. & + ! any(param(instance)%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + ! if ( param(instance)%n_twin <= 0.0_pReal .and. & + ! any(param(instance)%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + endif twinActive - if (any(plastic_phenopowerlaw_tau0_slip(:,instance) < 0.0_pReal .and. & - plastic_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%gdot0_slip <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%n_slip <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(plastic_phenopowerlaw_tausat_slip(:,instance) <= 0.0_pReal .and. & - plastic_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(dEq0(param(instance)%a_slip) .and. plastic_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(plastic_phenopowerlaw_tau0_twin(:,instance) < 0.0_pReal .and. & - plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( param(instance)%gdot0_twin <= 0.0_pReal .and. & - any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( param(instance)%n_twin <= 0.0_pReal .and. & - any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') if (param(instance)%aTolResistance <= 0.0_pReal) & call IO_error(211_pInt,el=instance,ext_msg='aTolResistance ('//PLASTICITY_PHENOPOWERLAW_label//')') if (param(instance)%aTolShear <= 0.0_pReal) & @@ -465,26 +448,21 @@ subroutine plastic_phenopowerlaw_init(fileUnit) call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') endif myPhase enddo sanityChecks + -!-------------------------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------------------------- ! allocation of variables whose size depends on the total number of active slip systems - allocate(plastic_phenopowerlaw_hardeningMatrix_SlipSlip(maxval(plastic_phenopowerlaw_totalNslip),& ! slip resistance from slip activity - maxval(plastic_phenopowerlaw_totalNslip),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_hardeningMatrix_SlipTwin(maxval(plastic_phenopowerlaw_totalNslip),& ! slip resistance from twin activity - maxval(plastic_phenopowerlaw_totalNtwin),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_hardeningMatrix_TwinSlip(maxval(plastic_phenopowerlaw_totalNtwin),& ! twin resistance from slip activity - maxval(plastic_phenopowerlaw_totalNslip),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_hardeningMatrix_TwinTwin(maxval(plastic_phenopowerlaw_totalNtwin),& ! twin resistance from twin activity - maxval(plastic_phenopowerlaw_totalNtwin),& - maxNinstance), source=0.0_pReal) + allocate(interaction_SlipSlip(maxval(totalNslip),maxval(totalNslip),maxNinstance), source=0.0_pReal) + allocate(interaction_SlipTwin(maxval(totalNslip),maxval(totalNtwin),maxNinstance), source=0.0_pReal) + allocate(interaction_TwinSlip(maxval(totalNtwin),maxval(totalNslip),maxNinstance), source=0.0_pReal) + allocate(interaction_TwinTwin(maxval(totalNtwin),maxval(totalNtwin),maxNinstance), source=0.0_pReal) + + allocate(state(maxNinstance)) - allocate(state0(maxNinstance)) allocate(dotState(maxNinstance)) initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop through all phases in material.config + myPhase2: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then ! only consider my phase NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase instance = phase_plasticityInstance(phase) ! which instance of my phase @@ -498,13 +476,13 @@ subroutine plastic_phenopowerlaw_init(fileUnit) accumulatedshear_slip_ID, & resolvedstress_slip_ID & ) - mySize = plastic_phenopowerlaw_totalNslip(instance) + mySize = totalNslip(instance) case(resistance_twin_ID, & shearrate_twin_ID, & accumulatedshear_twin_ID, & resolvedstress_twin_ID & ) - mySize = plastic_phenopowerlaw_totalNtwin(instance) + mySize = totalNtwin(instance) case(totalshear_ID, & totalvolfrac_twin_ID & ) @@ -519,11 +497,11 @@ subroutine plastic_phenopowerlaw_init(fileUnit) enddo outputsLoop !-------------------------------------------------------------------------------------------------- ! allocate state arrays - sizeState = plastic_phenopowerlaw_totalNslip(instance) & ! s_slip - + plastic_phenopowerlaw_totalNtwin(instance) & ! s_twin + sizeState = totalNslip(instance) & ! s_slip + + totalNtwin(instance) & ! s_twin + 2_pInt & ! sum(gamma) + sum(f) - + plastic_phenopowerlaw_totalNslip(instance) & ! accshear_slip - + plastic_phenopowerlaw_totalNtwin(instance) ! accshear_twin + + totalNslip(instance) & ! accshear_slip + + totalNtwin(instance) ! accshear_twin sizeDotState = sizeState sizeDeltaState = 0_pInt @@ -531,8 +509,8 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plasticState(phase)%sizeDotState = sizeDotState plasticState(phase)%sizeDeltaState = sizeDeltaState plasticState(phase)%sizePostResults = plastic_phenopowerlaw_sizePostResults(instance) - plasticState(phase)%nSlip =plastic_phenopowerlaw_totalNslip(instance) - plasticState(phase)%nTwin =plastic_phenopowerlaw_totalNtwin(instance) + plasticState(phase)%nSlip =totalNslip(instance) + plasticState(phase)%nTwin =totalNtwin(instance) plasticState(phase)%nTrans=0_pInt allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) @@ -556,171 +534,112 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plasticState(phase)%accumulatedSlip => & plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X - index_myFamily = sum(plastic_phenopowerlaw_Nslip(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) ! loop over (active) systems in my family (slip) - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_phenopowerlaw_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) - plastic_phenopowerlaw_hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_SlipSlip(lattice_interactionSlipSlip( & +!-------------------------------------------------------------------------------------------------- +! calculate hardening matrices and extend intitial values (per family -> per system) + mySlipFamilies: do f = 1_pInt,size(param(instance)%Nslip,1) ! >>> interaction slip -- X + index_myFamily = sum(param(instance)%Nslip(1:f-1_pInt)) + + mySlipSystems: do j = 1_pInt,param(instance)%Nslip(f) + otherSlipFamilies: do o = 1_pInt,size(param(instance)%Nslip,1) + index_otherFamily = sum(param(instance)%Nslip(1:o-1_pInt)) + otherSlipSystems: do k = 1_pInt,param(instance)%Nslip(o) + interaction_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & + param(instance)%interaction_SlipSlip(lattice_interactionSlipSlip( & sum(lattice_NslipSystem(1:f-1,phase))+j, & sum(lattice_NslipSystem(1:o-1,phase))+k, & - phase), instance ) - enddo; enddo + phase)) + enddo otherSlipSystems; enddo otherSlipFamilies - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(plastic_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - plastic_phenopowerlaw_hardeningMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_SlipTwin(lattice_interactionSlipTwin( & + twinFamilies: do o = 1_pInt,size(param(instance)%Ntwin,1) + index_otherFamily = sum(param(instance)%Ntwin(1:o-1_pInt)) + twinSystems: do k = 1_pInt,param(instance)%Ntwin(o) + interaction_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & + param(instance)%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 + phase)) + enddo twinSystems; enddo twinFamilies + enddo mySlipSystems + enddo mySlipFamilies - enddo; enddo - - do f = 1_pInt,lattice_maxNtwinFamily ! >>> interaction twin -- X - index_myFamily = sum(plastic_phenopowerlaw_Ntwin(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) ! loop over (active) systems in my family (twin) - - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_phenopowerlaw_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) - plastic_phenopowerlaw_hardeningMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_TwinSlip(lattice_interactionTwinSlip( & + myTwinFamilies: do f = 1_pInt,size(param(instance)%Ntwin,1) ! >>> interaction twin -- X + index_myFamily = sum(param(instance)%Ntwin(1:f-1_pInt)) + myTwinSystems: do j = 1_pInt,param(instance)%Ntwin(f) + slipFamilies: do o = 1_pInt,size(param(instance)%Nslip,1) + index_otherFamily = sum(param(instance)%Nslip(1:o-1_pInt)) + slipSystems: do k = 1_pInt,param(instance)%Nslip(o) + interaction_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & + param(instance)%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 + phase)) + enddo slipSystems; enddo slipFamilies - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(plastic_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - plastic_phenopowerlaw_hardeningMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_TwinTwin(lattice_interactionTwinTwin( & + otherTwinFamilies: do o = 1_pInt,size(param(instance)%Ntwin,1) + index_otherFamily = sum(param(instance)%Ntwin(1:o-1_pInt)) + otherTwinSystems: do k = 1_pInt,param(instance)%Ntwin(o) + interaction_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & + param(instance)%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 + phase)) + enddo otherTwinSystems; enddo otherTwinFamilies + enddo myTwinSystems + enddo myTwinFamilies - enddo; enddo +!-------------------------------------------------------------------------------------------------- +! locally defined state aliases and initialization of state0 and aTolState startIndex = 1_pInt - endIndex = plastic_phenopowerlaw_totalNslip(instance) + endIndex = totalNslip(instance) state (instance)%s_slip=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%s_slip=>plasticState(phase)%state0 (startIndex:endIndex,:) dotState(instance)%s_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(phase)%state0(startIndex:endIndex,:) = & + spread(math_expand(param(instance)%tau0_slip, param(instance)%Nslip), 2, NipcMyPhase) + + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolResistance startIndex = endIndex + 1_pInt - endIndex = endIndex + plastic_phenopowerlaw_totalNtwin(instance) + endIndex = endIndex + totalNtwin(instance) state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%s_twin=>plasticState(phase)%state0 (startIndex:endIndex,:) dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(phase)%state0(startIndex:endIndex,:) = & + spread(param(instance)%tau0_twin(1:totalNtwin(instance)),2,NipcMyPhase) + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumGamma=>plasticState(phase)%state (startIndex,:) - state0 (instance)%sumGamma=>plasticState(phase)%state0 (startIndex,:) dotState(instance)%sumGamma=>plasticState(phase)%dotState(startIndex,:) + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumF=>plasticState(phase)%state (startIndex,:) - state0 (instance)%sumF=>plasticState(phase)%state0 (startIndex,:) dotState(instance)%sumF=>plasticState(phase)%dotState(startIndex,:) + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolTwinFrac startIndex = endIndex + 1_pInt - endIndex = endIndex +plastic_phenopowerlaw_totalNslip(instance) + endIndex = endIndex + totalNslip(instance) state (instance)%accshear_slip=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%accshear_slip=>plasticState(phase)%state0 (startIndex:endIndex,:) dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear + ! global alias + plasticState(phase)%slipRate =>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(phase)%accumulatedSlip =>plasticState(phase)%state(startIndex:endIndex,:) startIndex = endIndex + 1_pInt - endIndex = endIndex +plastic_phenopowerlaw_totalNtwin(instance) + endIndex = endIndex + totalNtwin(instance) state (instance)%accshear_twin=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%accshear_twin=>plasticState(phase)%state0 (startIndex:endIndex,:) dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) + plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear - - call plastic_phenopowerlaw_stateInit(phase,instance) - call plastic_phenopowerlaw_aTolState(phase,instance) endif myPhase2 enddo initializeInstances + end subroutine plastic_phenopowerlaw_init -!-------------------------------------------------------------------------------------------------- -!> @brief sets the initial microstructural state for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_stateInit(ph,instance) - use lattice, only: & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: & - instance, & !< number specifying the instance of the plasticity - ph - integer(pInt) :: & - i - real(pReal), dimension(plasticState(ph)%sizeState) :: & - tempState - - tempState = 0.0_pReal - do i = 1_pInt,lattice_maxNslipFamily - tempState(1+sum(plastic_phenopowerlaw_Nslip(1:i-1,instance)) : & - sum(plastic_phenopowerlaw_Nslip(1:i ,instance))) = & - plastic_phenopowerlaw_tau0_slip(i,instance) - enddo - - do i = 1_pInt,lattice_maxNtwinFamily - tempState(1+sum(plastic_phenopowerlaw_Nslip(:,instance))+& - sum(plastic_phenopowerlaw_Ntwin(1:i-1,instance)) : & - sum(plastic_phenopowerlaw_Nslip(:,instance))+& - sum(plastic_phenopowerlaw_Ntwin(1:i ,instance))) = & - plastic_phenopowerlaw_tau0_twin(i,instance) - enddo - - plasticState(ph)%state0(:,:) = spread(tempState, & ! spread single tempstate array - 2, & ! along dimension 2 - size(plasticState(ph)%state0(1,:))) ! number of copies (number of IPCs) - -end subroutine plastic_phenopowerlaw_stateInit - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_aTolState(ph,instance) - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: & - instance, & !< number specifying the instance of the plasticity - ph - - plasticState(ph)%aTolState(1:plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance)) = & - param(instance)%aTolResistance - plasticState(ph)%aTolState(1+plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance)) = & - param(instance)%aTolShear - plasticState(ph)%aTolState(2+plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance)) = & - param(instance)%aTolTwinFrac - plasticState(ph)%aTolState(3+plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance): & - 2+2*(plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance))) = & - param(instance)%aTolShear -end subroutine plastic_phenopowerlaw_aTolState - - !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- @@ -784,9 +703,9 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, !-------------------------------------------------------------------------------------------------- ! Slip part j = 0_pInt - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies: do f = 1_pInt,size(param(instance)%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems: do i = 1_pInt,param(instance)%Nslip(f) j = j+1_pInt ! Calculation of Lp @@ -795,13 +714,13 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_neg = tau_slip_neg + param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)*& + nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + param(instance)%nonSchmidCoeff(k)*& lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)*& + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + param(instance)%nonSchmidCoeff(k)*& lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo gdot_slip_pos = 0.5_pReal*param(instance)%gdot0_slip* & @@ -837,9 +756,9 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, !-------------------------------------------------------------------------------------------------- ! Twinning part j = 0_pInt - twinFamilies: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems: do i = 1_pInt,param(instance)%Ntwin(f) j = j+1_pInt ! Calculation of Lp @@ -905,17 +824,17 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ssat_offset, & tau_slip_pos,tau_slip_neg,tau_twin - real(pReal), dimension(plastic_phenopowerlaw_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip - real(pReal), dimension(plastic_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - nSlip = plastic_phenopowerlaw_totalNslip(instance) - nTwin = plastic_phenopowerlaw_totalNtwin(instance) + nSlip = totalNslip(instance) + nTwin = totalNtwin(instance) index_Gamma = nSlip + nTwin + 1_pInt index_F = nSlip + nTwin + 2_pInt @@ -937,17 +856,17 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ! calculate left and right vectors and calculate dot gammas ssat_offset = param(instance)%spr*sqrt(plasticState(ph)%state(index_F,of)) j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies1: do f =1_pInt,size(param(instance)%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems1: do i = 1_pInt,param(instance)%Nslip(f) j = j+1_pInt - left_SlipSlip(j) = 1.0_pReal + plastic_phenopowerlaw_H_int(f,instance) ! modified no system-dependent left part + left_SlipSlip(j) = 1.0_pReal + param(instance)%H_int(f) ! modified no system-dependent left part left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & + (param(instance)%tausat_slip(f)+ssat_offset)) & **param(instance)%a_slip& *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) + (param(instance)%tausat_slip(f)+ssat_offset)) right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- @@ -955,9 +874,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_neg = tau_slip_neg +param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems gdot_slip(j) = param(instance)%gdot0_slip*0.5_pReal* & @@ -971,9 +890,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) j = 0_pInt - twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies1: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems1: do i = 1_pInt,param(instance)%Ntwin(f) j = j+1_pInt left_TwinSlip(j) = 1.0_pReal ! no system-dependent left part left_TwinTwin(j) = 1.0_pReal ! no system-dependent left part @@ -993,14 +912,14 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above j = 0_pInt - slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily - slipSystems2: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipFamilies2: do f = 1_pInt,size(param(instance)%Nslip,1) + slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) j = j+1_pInt plasticState(ph)%dotState(j,of) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & - dot_product(plastic_phenopowerlaw_hardeningMatrix_SlipSlip(j,1:nSlip,instance), & + dot_product(interaction_SlipSlip(j,1:totalNslip(instance),instance), & right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(plastic_phenopowerlaw_hardeningMatrix_SlipTwin(j,1:nTwin,instance), & + dot_product(interaction_SlipTwin(j,1:totalNtwin(instance),instance), & right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor plasticState(ph)%dotState(index_Gamma,of) = plasticState(ph)%dotState(index_Gamma,of) + & abs(gdot_slip(j)) @@ -1009,16 +928,16 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) enddo slipFamilies2 j = 0_pInt - twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems2: do i = 1_pInt,param(instance)%Ntwin(f) j = j+1_pInt plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j c_TwinSlip * left_TwinSlip(j) * & - dot_product(plastic_phenopowerlaw_hardeningMatrix_TwinSlip(j,1:nSlip,instance), & + dot_product(interaction_TwinSlip(j,1:totalNslip(instance),instance), & right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * left_TwinTwin(j) * & - dot_product(plastic_phenopowerlaw_hardeningMatrix_TwinTwin(j,1:nTwin,instance), & + dot_product(interaction_TwinTwin(j,1:totalNtwin(instance),instance), & right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (plasticState(ph)%state(index_F,of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 plasticState(ph)%dotState(index_F,of) = plasticState(ph)%dotState(index_F,of) + & @@ -1071,8 +990,8 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - nSlip = plastic_phenopowerlaw_totalNslip(instance) - nTwin = plastic_phenopowerlaw_totalNtwin(instance) + nSlip = totalNslip(instance) + nTwin = totalNtwin(instance) index_Gamma = nSlip + nTwin + 1_pInt index_F = nSlip + nTwin + 2_pInt @@ -1095,16 +1014,16 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (shearrate_slip_ID) j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies1: do f = 1_pInt,size(param(instance)%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems1: do i = 1_pInt,param(instance)%Nslip(f) j = j + 1_pInt tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_pos = tau_slip_pos +param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_neg = tau_slip_neg +param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo plastic_phenopowerlaw_postResults(c+j) = param(instance)%gdot0_slip*0.5_pReal* & @@ -1118,9 +1037,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (resolvedstress_slip_ID) j = 0_pInt - slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems2: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) @@ -1144,9 +1063,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + nTwin case (shearrate_twin_ID) j = 0_pInt - twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies1: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems1: do i = 1_pInt,param(instance)%Ntwin(f) j = j + 1_pInt tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F @@ -1159,9 +1078,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (resolvedstress_twin_ID) j = 0_pInt - twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems2: do i = 1_pInt,param(instance)%Ntwin(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) From e3bd09d8e69a8d0efa9f7c4899e0af4396c14ae3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 26 Apr 2018 18:12:45 +0200 Subject: [PATCH 03/79] wrong initiatilization --- src/plastic_phenopowerlaw.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 4b41f9ad2..bcb87a25d 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -603,7 +603,7 @@ subroutine plastic_phenopowerlaw_init(fileUnit) state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%state0(startIndex:endIndex,:) = & - spread(param(instance)%tau0_twin(1:totalNtwin(instance)),2,NipcMyPhase) + spread(math_expand(param(instance)%tau0_twin, param(instance)%Ntwin), 2, NipcMyPhase) plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolResistance startIndex = endIndex + 1_pInt From d9548b455ebec08a93903a2b77313dcdcf23f781 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 26 Apr 2018 18:35:49 +0200 Subject: [PATCH 04/79] should loop over slip systems --- src/plastic_phenopowerlaw.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index bcb87a25d..82deea1c3 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -1037,7 +1037,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (resolvedstress_slip_ID) j = 0_pInt - slipFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) + slipFamilies2: do f = 1_pInt,size(param(instance)%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) j = j + 1_pInt From 423fcd6e0dcafa83ba879e6945f42d93759d6773 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Fri, 27 Apr 2018 19:53:54 +0200 Subject: [PATCH 05/79] using state pointer increases readability in dotState --- src/plastic_phenopowerlaw.f90 | 46 +++++++++++++++-------------------- 1 file changed, 19 insertions(+), 27 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 82deea1c3..042b80be3 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -816,8 +816,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) instance,ph, & nSlip,nTwin, & f,i,j,k, & - index_Gamma,index_F,index_myFamily, & - offset_accshear_slip,offset_accshear_twin, & + index_myfamily, & of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & @@ -833,28 +832,21 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - nSlip = totalNslip(instance) - nTwin = totalNtwin(instance) - - index_Gamma = nSlip + nTwin + 1_pInt - index_F = nSlip + nTwin + 2_pInt - offset_accshear_slip = nSlip + nTwin + 2_pInt - offset_accshear_twin = nSlip + nTwin + 2_pInt + nSlip plasticState(ph)%dotState(:,of) = 0.0_pReal !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices c_SlipSlip = param(instance)%h0_slipslip*& - (1.0_pReal + param(instance)%twinC*plasticState(ph)%state(index_F,of)**& + (1.0_pReal + param(instance)%twinC*state(instance)%sumF(of)**& param(instance)%twinB) c_TwinSlip = param(instance)%h0_TwinSlip*& - plasticState(ph)%state(index_Gamma,of)**param(instance)%twinE + state(instance)%sumGamma(of)**param(instance)%twinE c_TwinTwin = param(instance)%h0_TwinTwin*& - plasticState(ph)%state(index_F,of)**param(instance)%twinD + state(instance)%sumF(of)**param(instance)%twinD !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors and calculate dot gammas - ssat_offset = param(instance)%spr*sqrt(plasticState(ph)%state(index_F,of)) + ssat_offset = param(instance)%spr*sqrt(state(instance)%sumF(of)) j = 0_pInt slipFamilies1: do f =1_pInt,size(param(instance)%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family @@ -862,11 +854,11 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) j = j+1_pInt left_SlipSlip(j) = 1.0_pReal + param(instance)%H_int(f) ! modified no system-dependent left part left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part - right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & + right_SlipSlip(j) = abs(1.0_pReal-state(instance)%s_slip(j,of) / & (param(instance)%tausat_slip(f)+ssat_offset)) & **param(instance)%a_slip& - *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & - (param(instance)%tausat_slip(f)+ssat_offset)) + *sign(1.0_pReal,1.0_pReal-state(instance)%s_slip(j,of)) / & + (param(instance)%tausat_slip(f)+ssat_offset) right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- @@ -880,9 +872,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems gdot_slip(j) = param(instance)%gdot0_slip*0.5_pReal* & - ((abs(tau_slip_pos)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & + ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & + +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -902,9 +894,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! Calculation of dot vol frac tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F + gdot_twin(j) = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F param(instance)%gdot0_twin*& - (abs(tau_twin)/plasticState(ph)%state(nslip+j,of))**& + (abs(tau_twin)/state(instance)%s_twin(j,of))**& param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) enddo twinSystems1 enddo twinFamilies1 @@ -915,15 +907,15 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) slipFamilies2: do f = 1_pInt,size(param(instance)%Nslip,1) slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) j = j+1_pInt - plasticState(ph)%dotState(j,of) = & ! evolution of slip resistance j + dotState(instance)%s_slip(j,of) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & dot_product(interaction_SlipSlip(j,1:totalNslip(instance),instance), & right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor dot_product(interaction_SlipTwin(j,1:totalNtwin(instance),instance), & right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor - plasticState(ph)%dotState(index_Gamma,of) = plasticState(ph)%dotState(index_Gamma,of) + & + dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + & abs(gdot_slip(j)) - plasticState(ph)%dotState(offset_accshear_slip+j,of) = abs(gdot_slip(j)) + dotState(instance)%accshear_slip(j,of) = abs(gdot_slip(j)) enddo slipSystems2 enddo slipFamilies2 @@ -932,17 +924,17 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystems2: do i = 1_pInt,param(instance)%Ntwin(f) j = j+1_pInt - plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j + dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j c_TwinSlip * left_TwinSlip(j) * & dot_product(interaction_TwinSlip(j,1:totalNslip(instance),instance), & right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * left_TwinTwin(j) * & dot_product(interaction_TwinTwin(j,1:totalNtwin(instance),instance), & right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor - if (plasticState(ph)%state(index_F,of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 - plasticState(ph)%dotState(index_F,of) = plasticState(ph)%dotState(index_F,of) + & + if (state(instance)%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 + dotState(instance)%sumF(of) = dotState(instance)%sumF(of) + & gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) - plasticState(ph)%dotState(offset_accshear_twin+j,of) = abs(gdot_twin(j)) + dotState(instance)%accshear_twin(j,of) = abs(gdot_twin(j)) enddo twinSystems2 enddo twinFamilies2 From c3322b589e9360ec67679726d96e8fae09157be7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 30 Apr 2018 13:58:50 +0200 Subject: [PATCH 06/79] not needed anymore --- src/plastic_phenopowerlaw.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 042b80be3..c754e3127 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -814,9 +814,8 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) integer(pInt) :: & instance,ph, & - nSlip,nTwin, & f,i,j,k, & - index_myfamily, & + index_myFamily, & of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & From 51f56f5bad94de97fef1b214d6b2ddfdc6fed3e6 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Mon, 30 Apr 2018 21:30:53 +0200 Subject: [PATCH 07/79] using state pointers increases readability in constitutive results --- src/plastic_phenopowerlaw.f90 | 32 +++++++++++++------------------- 1 file changed, 13 insertions(+), 19 deletions(-) mode change 100644 => 100755 src/plastic_phenopowerlaw.f90 diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 old mode 100644 new mode 100755 index 042b80be3..acf6a4a44 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -832,6 +832,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) + plasticState(ph)%dotState(:,of) = 0.0_pReal !-------------------------------------------------------------------------------------------------- @@ -974,7 +975,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) instance,ph, of, & nSlip,nTwin, & o,f,i,c,j,k, & - index_Gamma,index_F,index_accshear_slip,index_accshear_twin,index_myFamily + index_myFamily real(pReal) :: & tau_slip_pos,tau_slip_neg,tau @@ -982,26 +983,19 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - nSlip = totalNslip(instance) - nTwin = totalNtwin(instance) - - index_Gamma = nSlip + nTwin + 1_pInt - index_F = nSlip + nTwin + 2_pInt - index_accshear_slip = nSlip + nTwin + 3_pInt - index_accshear_twin = nSlip + nTwin + 3_pInt + nSlip + plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) select case(plastic_phenopowerlaw_outputID(o,instance)) case (resistance_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(1:nSlip,of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%s_slip(of) c = c + nSlip case (accumulatedshear_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(index_accshear_slip:& - index_accshear_slip+nSlip-1_pInt,of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%accshear_slip(of) c = c + nSlip case (shearrate_slip_ID) @@ -1019,9 +1013,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo plastic_phenopowerlaw_postResults(c+j) = param(instance)%gdot0_slip*0.5_pReal* & - ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**param(instance)%n_slip & + ((abs(tau_slip_pos)/state(instance)%s_slip(j,of))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**param(instance)%n_slip & + +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -1041,17 +1035,17 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (totalshear_ID) plastic_phenopowerlaw_postResults(c+1_pInt) = & - plasticState(ph)%state(index_Gamma,of) + state(instance)%sumGamma(of) c = c + 1_pInt case (resistance_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - plasticState(ph)%state(1_pInt+nSlip:1_pInt+nSlip+nTwin-1_pInt,of) + state(instance)%s_twin(of) c = c + nTwin case (accumulatedshear_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - plasticState(ph)%state(index_accshear_twin:index_accshear_twin+nTwin-1_pInt,of) + state(instance)%accshear_twin(of) c = c + nTwin case (shearrate_twin_ID) j = 0_pInt @@ -1060,9 +1054,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) twinSystems1: do i = 1_pInt,param(instance)%Ntwin(f) j = j + 1_pInt tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F + plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F param(instance)%gdot0_twin*& - (abs(tau)/plasticState(ph)%state(j+nSlip,of))**& + (abs(tau)/state(instance)%s_twin(j,of))**& param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) enddo twinSystems1 enddo twinFamilies1 @@ -1081,7 +1075,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + nTwin case (totalvolfrac_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt) = plasticState(ph)%state(index_F,of) + plastic_phenopowerlaw_postResults(c+1_pInt) = state(instance)%sumF(of) c = c + 1_pInt end select From 74956de9bd4f658ffd954f6d57ded22e7f32d4b5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 2 May 2018 16:06:30 +0200 Subject: [PATCH 08/79] misplaced bracket caused wrong results introduced in commit e3bd09d8 --- src/plastic_phenopowerlaw.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index c754e3127..f1d419c14 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -856,8 +856,8 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) right_SlipSlip(j) = abs(1.0_pReal-state(instance)%s_slip(j,of) / & (param(instance)%tausat_slip(f)+ssat_offset)) & **param(instance)%a_slip& - *sign(1.0_pReal,1.0_pReal-state(instance)%s_slip(j,of)) / & - (param(instance)%tausat_slip(f)+ssat_offset) + *sign(1.0_pReal,1.0_pReal-state(instance)%s_slip(j,of) / & + (param(instance)%tausat_slip(f)+ssat_offset)) right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- From 235b2fe3c89ead13ecfac6f45240716d6d9d7dfd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 2 May 2018 16:44:27 +0200 Subject: [PATCH 09/79] ntwin = [0] cause problems math_expand now works for sum(how) == 0 --- src/math.f90 | 3 +++ src/plastic_phenopowerlaw.f90 | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/math.f90 b/src/math.f90 index 4354354f7..82945a822 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -386,6 +386,9 @@ pure function math_expand(what,how) real(pReal), dimension(sum(how)) :: math_expand integer(pInt) :: i + if (sum(how) == 0_pInt) & + return + do i = 1_pInt, size(how) math_expand(sum(how(1:i-1))+1:sum(how(1:i))) = what(mod(i-1_pInt,size(what))+1_pInt) enddo diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index f1d419c14..ab65490d1 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -202,7 +202,7 @@ subroutine plastic_phenopowerlaw_init(fileUnit) allocate(totalNslip(maxNinstance), source=0_pInt) allocate(totalNtwin(maxNinstance), source=0_pInt) - allocate(param(maxNinstance)) ! one container of parameters per instance + allocate(param(maxNinstance)) ! one container of parameters per instance rewind(fileUnit) phase = 0_pInt From ccde78799ed638f6e10096f1034607549f8c5456 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 2 May 2018 17:33:42 +0200 Subject: [PATCH 10/79] using state pointers increases readability in postResults --- src/plastic_phenopowerlaw.f90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) mode change 100755 => 100644 src/plastic_phenopowerlaw.f90 diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 old mode 100755 new mode 100644 index d0452c04c..52fcf3ad3 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -982,7 +982,8 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - + nSlip= totalNslip(instance) + nTwin= totalNtwin(instance) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt @@ -990,11 +991,11 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) select case(plastic_phenopowerlaw_outputID(o,instance)) case (resistance_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%s_slip(of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%s_slip(1:nSlip,of) c = c + nSlip case (accumulatedshear_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%accshear_slip(of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%accshear_slip(1:nSlip,of) c = c + nSlip case (shearrate_slip_ID) @@ -1039,12 +1040,12 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (resistance_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state(instance)%s_twin(of) + state(instance)%s_twin(1:nTwin,of) c = c + nTwin case (accumulatedshear_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state(instance)%accshear_twin(of) + state(instance)%accshear_twin(1:nTwin,of) c = c + nTwin case (shearrate_twin_ID) j = 0_pInt From 804febe7f9ea954c2c66ddeec9f56331faab2007 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 May 2018 18:31:44 +0200 Subject: [PATCH 11/79] WIP: separate reading in and parsing --- src/math.f90 | 3 +- src/plastic_phenopowerlaw.f90 | 113 +++++++++++++++++++++------------- 2 files changed, 71 insertions(+), 45 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index f253a1b28..d53d80b40 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -160,8 +160,7 @@ module math math_rotate_forward33, & math_rotate_backward33, & math_rotate_forward3333, & - math_limit, & - math_expand + math_limit private :: & math_check, & halton diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 52fcf3ad3..c70d7220d 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -26,14 +26,11 @@ module plastic_phenopowerlaw totalNslip, & !< no. of slip system used in simulation totalNtwin !< no. of twin system used in simulation - - real(pReal), dimension(:,:,:), allocatable, private :: & - - interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) + interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) - interaction_TwinTwin !< interaction factors twin - twin (input parameter) + interaction_TwinTwin !< interaction factors twin - twin (input parameter) enum, bind(c) @@ -52,7 +49,16 @@ module plastic_phenopowerlaw integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & plastic_phenopowerlaw_outputID !< ID of each post result output + type :: tKeyValues + character(len=64) :: & + key = '' + character(len=65536) :: & + rawValues = '' + end type + type, private :: tParameters !< container type for internal constitutive parameters + type(tKeyValues) :: & + keyValues real(pReal) :: & gdot0_slip, & !< reference shear strain rate for slip gdot0_twin, & !< reference shear strain rate for twin @@ -172,6 +178,9 @@ subroutine plastic_phenopowerlaw_init(fileUnit) offset_slip, index_myFamily, index_otherFamily, & mySize=0_pInt,sizeState,sizeDotState, sizeDeltaState, & startIndex, endIndex + + type(tKeyValues) :: keyValuesTemp + character(len=65536) :: & tag = '', & line = '', & @@ -184,67 +193,85 @@ subroutine plastic_phenopowerlaw_init(fileUnit) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) + maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) ! ToDo: this does not happen if (maxNinstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(plastic_phenopowerlaw_sizePostResults(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),maxNinstance), & - source=0_pInt) + allocate(plastic_phenopowerlaw_sizePostResults(maxNinstance), source=0_pInt) + allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) + allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_output(maxval(phase_Noutput),maxNinstance)) - plastic_phenopowerlaw_output = '' - allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) - - allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) + plastic_phenopowerlaw_output = '' + allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) allocate(totalNslip(maxNinstance), source=0_pInt) allocate(totalNtwin(maxNinstance), source=0_pInt) allocate(param(maxNinstance)) ! one container of parameters per instance rewind(fileUnit) phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to + windForward: do while (IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + enddo windForward + getKeys: 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_isBlank(line) .or. phase == 0_pInt) cycle ! skip empty lines + if (IO_getTag(line,'[',']') /= '') phase = phase + 1_pInt ! next phase + phase = phase + 1_pInt ! advance phase section counter + instance = phase_plasticityInstance(phase) ! instance of present phase + cycle + endif + if (phase_plasticity(phase) /= PLASTICITY_PHENOPOWERLAW_ID) cycle 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_PHENOPOWERLAW_ID) then - instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase - Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase - 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) - if(allocated(tempPerSlip)) deallocate(tempPerSlip) - !allocate(param(instance)%H_int,source=tempPerSlip) gfortran 5 does not support this - allocate(param(instance)%H_int(Nchunks_SlipFamilies),source=0.0_pReal) - allocate(param(instance)%interaction_SlipSlip(Nchunks_SlipSlip),source=0.0_pReal) - allocate(param(instance)%interaction_SlipTwin(Nchunks_SlipTwin),source=0.0_pReal) - allocate(param(instance)%interaction_TwinSlip(Nchunks_TwinSlip),source=0.0_pReal) - allocate(param(instance)%interaction_TwinTwin(Nchunks_TwinTwin),source=0.0_pReal) - allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid),source=0.0_pReal) + chunkPos = IO_stringPos(line) + keyValuesTemp%key = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + if(chunkPos(1) > 1) keyValuesTemp%rawValues = IO_lc(line(chunkPos(4),:)) + param(instance)%keyValues = [(instance)%keyValues,keyValuesTemp] + enddo getKeys - allocate(tempPerSlip(Nchunks_SlipFamilies)) - endif - cycle ! skip to next line + parseString: do instance = 1_pInt, maxNinstance + do i = 1_pInt, size(param(instance)%keyValues); key = param(instance)%keyValues(i) + enddo + enddo parseStrings + + myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then + instance = phase_plasticityInstance(phase) + + ! if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then + ! instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + ! chunkPos = IO_stringPos(line) + ! configTemp%key = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + ! if(chunkPos(1) > 1) configTemp%rawValues = IO_lc(line(chunkPos(4),:)) + ! config = [config,configTemp] + + ! Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase + ! Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase + ! 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) + ! if(allocated(tempPerSlip)) deallocate(tempPerSlip) + ! !allocate(param(instance)%H_int,source=tempPerSlip) gfortran 5 does not support this + ! allocate(param(instance)%H_int(Nchunks_SlipFamilies),source=0.0_pReal) + ! allocate(param(instance)%interaction_SlipSlip(Nchunks_SlipSlip),source=0.0_pReal) + ! allocate(param(instance)%interaction_SlipTwin(Nchunks_SlipTwin),source=0.0_pReal) + ! allocate(param(instance)%interaction_TwinSlip(Nchunks_TwinSlip),source=0.0_pReal) + ! allocate(param(instance)%interaction_TwinTwin(Nchunks_TwinTwin),source=0.0_pReal) + ! allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid),source=0.0_pReal) + + ! allocate(tempPerSlip(Nchunks_SlipFamilies)) + ! endif + ! cycle ! skip to next line endif 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 - - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key select case(tag) case ('(output)') From 7db08f0a76b310e4328aca190a0160e71c3517cb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 22:56:20 +0200 Subject: [PATCH 12/79] using material.config values from main memory --- src/constitutive.f90 | 2 +- src/plastic_phenopowerlaw.f90 | 683 ++++++++++++---------------------- 2 files changed, 241 insertions(+), 444 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e2a3f0260..a7ca64506 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -157,7 +157,7 @@ subroutine constitutive_init() ! parse plasticities from config file if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init - if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(FILEUNIT) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index c70d7220d..3cc03ef1e 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -10,55 +10,27 @@ module plastic_phenopowerlaw implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_phenopowerlaw_sizePostResults !< cumulative size of post results - integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_phenopowerlaw_sizePostResult !< size of each post result output - + plastic_phenopowerlaw_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_phenopowerlaw_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - plastic_phenopowerlaw_Noutput !< number of outputs per instance of this constitution - - integer(pInt), dimension(:), allocatable, private :: & - totalNslip, & !< no. of slip system used in simulation - totalNtwin !< no. of twin system used in simulation - - real(pReal), dimension(:,:,:), allocatable, private :: & - interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) - interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) - interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) - interaction_TwinTwin !< interaction factors twin - twin (input parameter) - + plastic_phenopowerlaw_output !< name of each post result output enum, bind(c) - enumerator :: undefined_ID, & - resistance_slip_ID, & - accumulatedshear_slip_ID, & - shearrate_slip_ID, & - resolvedstress_slip_ID, & - totalshear_ID, & - resistance_twin_ID, & - accumulatedshear_twin_ID, & - shearrate_twin_ID, & - resolvedstress_twin_ID, & - totalvolfrac_twin_ID + enumerator :: & + undefined_ID, & + resistance_slip_ID, & + accumulatedshear_slip_ID, & + shearrate_slip_ID, & + resolvedstress_slip_ID, & + totalshear_ID, & + resistance_twin_ID, & + accumulatedshear_twin_ID, & + shearrate_twin_ID, & + resolvedstress_twin_ID, & + totalvolfrac_twin_ID end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - plastic_phenopowerlaw_outputID !< ID of each post result output - - type :: tKeyValues - character(len=64) :: & - key = '' - character(len=65536) :: & - rawValues = '' - end type type, private :: tParameters !< container type for internal constitutive parameters - type(tKeyValues) :: & - keyValues real(pReal) :: & gdot0_slip, & !< reference shear strain rate for slip gdot0_twin, & !< reference shear strain rate for twin @@ -73,9 +45,9 @@ module plastic_phenopowerlaw h0_TwinSlip, & !< reference hardening twin - slip h0_TwinTwin, & !< reference hardening twin - twin a_slip, & - aTolResistance = 1.0_pReal, & ! default absolute tolerance 1 Pa - aTolShear = 1.0e-6_pReal, & ! default absolute tolerance 1e-6 - aTolTwinfrac = 1.0e-6_pReal ! default absolute tolerance 1e-6 + aTolResistance, & ! default absolute tolerance 1 Pa + aTolShear, & ! default absolute tolerance 1e-6 + aTolTwinfrac ! default absolute tolerance 1e-6 integer(pInt), dimension(:), allocatable :: & Nslip, & !< active number of slip systems per family Ntwin !< active number of twin systems per family @@ -85,13 +57,21 @@ module plastic_phenopowerlaw tausat_slip, & !< maximum critical shear stress for slip nonSchmidCoeff, & H_int, & !< per family hardening activity (optional) - interaction_SlipSlip, & !< slip resistance from slip activity interaction_SlipTwin, & !< slip resistance from twin activity interaction_TwinSlip, & !< twin resistance from slip activity interaction_TwinTwin !< twin resistance from twin activity + real(pReal), dimension(:,:), allocatable :: & + matrix_SlipSlip, & !< slip resistance from slip activity + matrix_SlipTwin, & !< slip resistance from twin activity + matrix_TwinSlip, & !< twin resistance from slip activity + matrix_TwinTwin !< twin resistance from twin activity + + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID !< ID of each post result output end type - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + type(tParameters), dimension(:), allocatable, target, private :: param !< containers of constitutive parameters (len Ninstance) type, private :: tPhenopowerlawState real(pReal), pointer, dimension(:,:) :: & @@ -121,7 +101,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_init(fileUnit) +subroutine plastic_phenopowerlaw_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -158,387 +138,202 @@ subroutine plastic_phenopowerlaw_init(fileUnit) PLASTICITY_PHENOPOWERLAW_ID, & material_phase, & plasticState, & - MATERIAL_partPhase + MATERIAL_partPhase, & + phaseConfig + use lattice use numerics,only: & numerics_integrator implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & maxNinstance, & - instance,phase,j,k, f,o, & - Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, & - Nchunks_TwinSlip = 0_pInt, Nchunks_TwinTwin = 0_pInt, & - Nchunks_SlipFamilies = 0_pInt, Nchunks_TwinFamilies = 0_pInt, & - Nchunks_TransFamilies = 0_pInt, Nchunks_nonSchmid = 0_pInt, & - NipcMyPhase, & + instance,phase,j,k, f,o, i,& + NipcMyPhase, outputSize, & offset_slip, index_myFamily, index_otherFamily, & - mySize=0_pInt,sizeState,sizeDotState, sizeDeltaState, & + sizeState,sizeDotState, sizeDeltaState, & startIndex, endIndex + integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] + real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] - type(tKeyValues) :: keyValuesTemp + type(tParameters), pointer :: p + + integer(kind(undefined_ID)) :: & + outputID !< ID of each post result output character(len=65536) :: & - tag = '', & - line = '', & extmsg = '' - character(len=64) :: & - outputtag = '' - real(pReal), dimension(:), allocatable :: tempPerSlip + character(len=64), dimension(:), allocatable :: outputs write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) ! ToDo: this does not happen - if (maxNinstance == 0_pInt) return - + maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(plastic_phenopowerlaw_sizePostResults(maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) allocate(plastic_phenopowerlaw_output(maxval(phase_Noutput),maxNinstance)) plastic_phenopowerlaw_output = '' - allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) - allocate(totalNslip(maxNinstance), source=0_pInt) - allocate(totalNtwin(maxNinstance), source=0_pInt) allocate(param(maxNinstance)) ! one container of parameters per instance - - rewind(fileUnit) - phase = 0_pInt - windForward: do while (IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) - line = IO_read(fileUnit) - enddo windForward - getKeys: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line) .or. phase == 0_pInt) cycle ! skip empty lines - if (IO_getTag(line,'[',']') /= '') phase = phase + 1_pInt ! next phase - phase = phase + 1_pInt ! advance phase section counter - instance = phase_plasticityInstance(phase) ! instance of present phase - cycle - endif - if (phase_plasticity(phase) /= PLASTICITY_PHENOPOWERLAW_ID) cycle - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - chunkPos = IO_stringPos(line) - keyValuesTemp%key = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - if(chunkPos(1) > 1) keyValuesTemp%rawValues = IO_lc(line(chunkPos(4),:)) - param(instance)%keyValues = [(instance)%keyValues,keyValuesTemp] - enddo getKeys - - parseString: do instance = 1_pInt, maxNinstance - do i = 1_pInt, size(param(instance)%keyValues); key = param(instance)%keyValues(i) - enddo - enddo parseStrings - - myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then - instance = phase_plasticityInstance(phase) - - ! if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then - ! instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - ! chunkPos = IO_stringPos(line) - ! configTemp%key = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - ! if(chunkPos(1) > 1) configTemp%rawValues = IO_lc(line(chunkPos(4),:)) - ! config = [config,configTemp] - - ! Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase - ! Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase - ! 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) - ! if(allocated(tempPerSlip)) deallocate(tempPerSlip) - ! !allocate(param(instance)%H_int,source=tempPerSlip) gfortran 5 does not support this - ! allocate(param(instance)%H_int(Nchunks_SlipFamilies),source=0.0_pReal) - ! allocate(param(instance)%interaction_SlipSlip(Nchunks_SlipSlip),source=0.0_pReal) - ! allocate(param(instance)%interaction_SlipTwin(Nchunks_SlipTwin),source=0.0_pReal) - ! allocate(param(instance)%interaction_TwinSlip(Nchunks_TwinSlip),source=0.0_pReal) - ! allocate(param(instance)%interaction_TwinTwin(Nchunks_TwinTwin),source=0.0_pReal) - ! allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid),source=0.0_pReal) - - ! allocate(tempPerSlip(Nchunks_SlipFamilies)) - ! endif - ! cycle ! skip to next line - endif - 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 - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - - case ('(output)') - outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt ! assume valid output - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = outputtag ! assume valid output - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('resistance_slip') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_slip_ID - - case ('accumulatedshear_slip','accumulated_shear_slip') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_slip_ID - - case ('shearrate_slip') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_slip_ID - - case ('resolvedstress_slip') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_slip_ID - - case ('totalshear') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalshear_ID - - case ('resistance_twin') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_twin_ID - - case ('accumulatedshear_twin','accumulated_shear_twin') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_twin_ID - - case ('shearrate_twin') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_twin_ID - - case ('resolvedstress_twin') - - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_twin_ID - - case ('totalvolfrac_twin') - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalvolfrac_twin_ID - - case default - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) - 1_pInt ! correct for invalid - - end select - -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of slip families - case ('nslip') - if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) call IO_warning(50_pInt,ext_msg=extmsg) - if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) - allocate(param(instance)%Nslip(Nchunks_SlipFamilies),source=-1_pInt) - do j = 1_pInt, Nchunks_SlipFamilies - param(instance)%Nslip(j) = min(IO_intValue(line,chunkPos,1_pInt+j), & - lattice_NslipSystem(j,phase)) ! limit active slip systems per family to min of available and requested - enddo - totalNslip(instance) = sum(param(instance)%Nslip) ! how many slip systems altogether - - case ('tausat_slip','tau0_slip','h_int') - tempPerSlip = 0.0_pReal - do j = 1_pInt, Nchunks_SlipFamilies - if (param(instance)%Nslip(j) > 0_pInt) & - tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - select case(tag) ! here, all arrays are allocated automatically - case ('tausat_slip') - param(instance)%tausat_slip = tempPerSlip - case ('tau0_slip') - param(instance)%tau0_slip = tempPerSlip - case ('h_int') - param(instance)%H_int = tempPerSlip - end select - -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of twin families - case ('ntwin') - if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) call IO_warning(51_pInt,ext_msg=extmsg) - if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - Nchunks_TwinFamilies = chunkPos(1) - 1_pInt - allocate(param(instance)%Ntwin(Nchunks_TwinFamilies),source=-1_pInt) - do j = 1_pInt, Nchunks_TwinFamilies - param(instance)%Ntwin(j) = min(IO_intValue(line,chunkPos,1_pInt+j), & - lattice_NtwinSystem(j,phase)) ! limit active twin systems per family to min of available and requested - enddo - totalNtwin(instance) = sum(param(instance)%Ntwin) ! how many twin systems altogether - - case ('tau0_twin') - allocate(param(instance)%tau0_twin(Nchunks_TwinFamilies),source=0.0_pReal) - do j = 1_pInt, Nchunks_TwinFamilies - if (param(instance)%Ntwin(j) > 0_pInt) & - param(instance)%tau0_twin(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of interactions - case ('interaction_slipslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) call IO_warning(52_pInt,ext_msg=extmsg) - do j = 1_pInt, Nchunks_SlipSlip - param(instance)%interaction_SlipSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('interaction_sliptwin') - if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) call IO_warning(52_pInt,ext_msg=extmsg) - do j = 1_pInt, Nchunks_SlipTwin - param(instance)%interaction_SlipTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('interaction_twinslip') - if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) call IO_warning(52_pInt,ext_msg=extmsg) - do j = 1_pInt, Nchunks_TwinSlip - param(instance)%interaction_TwinSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('interaction_twintwin') - if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) call IO_warning(52_pInt,ext_msg=extmsg) - do j = 1_pInt, Nchunks_TwinTwin - param(instance)%interaction_TwinTwin(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - - case ('nonschmid_coefficients') - if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) call IO_warning(52_pInt,ext_msg=extmsg) - do j = 1_pInt,Nchunks_nonSchmid - param(instance)%nonSchmidCoeff(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - -!-------------------------------------------------------------------------------------------------- -! parameters independent of number of slip/twin systems - case ('gdot0_slip') - param(instance)%gdot0_slip = IO_floatValue(line,chunkPos,2_pInt) - case ('n_slip') - param(instance)%n_slip = IO_floatValue(line,chunkPos,2_pInt) - case ('a_slip', 'w0_slip') - param(instance)%a_slip = IO_floatValue(line,chunkPos,2_pInt) - case ('gdot0_twin') - param(instance)%gdot0_twin = IO_floatValue(line,chunkPos,2_pInt) - case ('n_twin') - param(instance)%n_twin = IO_floatValue(line,chunkPos,2_pInt) - case ('s_pr') - param(instance)%spr = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_b') - param(instance)%twinB = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_c') - param(instance)%twinC = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_d') - param(instance)%twinD = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_e') - param(instance)%twinE = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_slipslip') - param(instance)%h0_SlipSlip = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_twinslip') - param(instance)%h0_TwinSlip = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_twintwin') - param(instance)%h0_TwinTwin = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_resistance') - param(instance)%aTolResistance = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_shear') - param(instance)%aTolShear = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_twinfrac') - param(instance)%aTolTwinfrac = IO_floatValue(line,chunkPos,2_pInt) - case default - - end select - endif; endif - enddo parsingFile - - sanityChecks: do phase = 1_pInt, size(phase_plasticity) - myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then - instance = phase_plasticityInstance(phase) - totalNslip(instance) = sum(param(instance)%Nslip) ! how many slip systems altogether. ToDo: ok for unallocated Nslip - totalNtwin(instance) = sum(param(instance)%Ntwin) ! how many twin systems altogether. ToDo: ok for unallocated Ntwin - slipActive: if (allocated(param(instance)%Nslip)) then - if (any(param(instance)%tau0_slip < 0.0_pReal .and. & - param(instance)%Nslip(:) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%gdot0_slip <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%n_slip <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(param(instance)%tausat_slip <= 0.0_pReal .and. & - param(instance)%Nslip(:) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(dEq0(param(instance)%a_slip) .and. param(instance)%Nslip(:) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - endif slipActive - - twinActive: if (allocated(param(instance)%Ntwin)) then - ! if (any(param(instance)%tau0_twin < 0.0_pReal .and. & - ! param(instance)%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - ! if ( param(instance)%gdot0_twin <= 0.0_pReal .and. & - ! any(param(instance)%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - ! if ( param(instance)%n_twin <= 0.0_pReal .and. & - ! any(param(instance)%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - endif twinActive - - if (param(instance)%aTolResistance <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolResistance ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%aTolShear <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolShear ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (param(instance)%aTolTwinfrac <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') - endif myPhase - enddo sanityChecks - - - !-------------------------------------------------------------------------------------------------- -! allocation of variables whose size depends on the total number of active slip systems - allocate(interaction_SlipSlip(maxval(totalNslip),maxval(totalNslip),maxNinstance), source=0.0_pReal) - allocate(interaction_SlipTwin(maxval(totalNslip),maxval(totalNtwin),maxNinstance), source=0.0_pReal) - allocate(interaction_TwinSlip(maxval(totalNtwin),maxval(totalNslip),maxNinstance), source=0.0_pReal) - allocate(interaction_TwinTwin(maxval(totalNtwin),maxval(totalNtwin),maxNinstance), source=0.0_pReal) - - allocate(state(maxNinstance)) allocate(dotState(maxNinstance)) - initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop through all phases in material.config + do phase = 1_pInt, size(phase_plasticityInstance) + if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then + instance = phase_plasticityInstance(phase) + p => param(instance) - myPhase2: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then ! only consider my phase - NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase - instance = phase_plasticityInstance(phase) ! which instance of my phase + p%Nslip = phaseConfig(phase)%getIntArray('nslip',defaultVal=emptyInt) + !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) + if (sum(p%Nslip) > 0_pInt) then + p%tau0_slip = phaseConfig(phase)%getFloatArray('tau0_slip') + p%tausat_slip = phaseConfig(phase)%getFloatArray('tausat_slip') + p%H_int = phaseConfig(phase)%getFloatArray('h_int',defaultVal=[(0.0_pReal,i=1_pInt,size(p%Nslip))]) + print*, (shape(p%H_int)) + print*, (shape(p%Nslip)) + p%interaction_SlipSlip = phaseConfig(phase)%getFloatArray('interaction_slipslip') + p%nonSchmidCoeff = phaseConfig(phase)%getFloatArray('nonschmid_coefficients',& + defaultVal = [real(pReal)::1] ) + p%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') + p%n_slip = phaseConfig(phase)%getFloat('n_slip') + p%a_slip = phaseConfig(phase)%getFloat('a_slip') + p%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') + endif + + p%Ntwin = phaseConfig(phase)%getIntArray('ntwin', defaultVal=emptyInt) + !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) + if (sum(p%Ntwin) > 0_pInt) then + p%tau0_twin = phaseConfig(phase)%getFloatArray('tau0_twin') + p%interaction_TwinTwin = phaseConfig(phase)%getFloatArray('interaction_twintwin') + p%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') + p%n_twin = phaseConfig(phase)%getFloat('n_twin') + p%spr = phaseConfig(phase)%getFloat('s_pr') + p%twinB = phaseConfig(phase)%getFloat('twin_b') + p%twinC = phaseConfig(phase)%getFloat('twin_c') + p%twinD = phaseConfig(phase)%getFloat('twin_d') + p%twinE = phaseConfig(phase)%getFloat('twin_e') + p%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') + endif + if (sum(p%Nslip) > 0_pInt .and. sum(p%Ntwin) > 0_pInt) then + p%interaction_SlipTwin = phaseConfig(phase)%getFloatArray('interaction_sliptwin') + p%interaction_TwinSlip = phaseConfig(phase)%getFloatArray('interaction_twinslip') + p%h0_TwinSlip = phaseConfig(phase)%getFloat('h0_twinslip') + endif + + allocate(p%matrix_SlipSlip(sum(p%Nslip),sum(p%Nslip)),source =0.0_pReal) + allocate(p%matrix_SlipTwin(sum(p%Nslip),sum(p%Ntwin)),source =0.0_pReal) + allocate(p%matrix_TwinSlip(sum(p%Ntwin),sum(p%Nslip)),source =0.0_pReal) + allocate(p%matrix_TwinTwin(sum(p%Ntwin),sum(p%Ntwin)),source =0.0_pReal) + p%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) + p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + p%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + outputs = phaseConfig(phase)%getStrings('(output)') + allocate(p%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + case ('resistance_slip') + outputID = resistance_slip_ID + outputSize = sum(p%Nslip) + case ('acumulatedshear_slip','accumulated_shear_slip') + outputID = accumulatedshear_slip_ID + outputSize = sum(p%Nslip) + case ('shearrate_slip') + outputID = shearrate_slip_ID + outputSize = sum(p%Nslip) + case ('resolvedstress_slip') + outputID = resolvedstress_slip_ID + outputSize = sum(p%Nslip) + + case ('resistance_twin') + outputID = resistance_twin_ID + outputSize = sum(p%Ntwin) + case ('accumulatedshear_twin','accumulated_shear_twin') + outputID = accumulatedshear_twin_ID + outputSize = sum(p%Ntwin) + case ('shearrate_twin') + outputID = shearrate_twin_ID + outputSize = sum(p%Ntwin) + case ('resolvedstress_twin') + outputID = resolvedstress_twin_ID + outputSize = sum(p%Ntwin) + + case ('totalvolfrac_twin') + outputID = totalvolfrac_twin_ID + outputSize = 1_pInt + case ('totalshear') + outputID = totalshear_ID + outputSize = 1_pInt + end select + + if (outputID /= undefined_ID) then + plastic_phenopowerlaw_output(i,instance) = outputs(i) + plastic_phenopowerlaw_sizePostResult(i,instance) = outputSize + p%outputID = [p%outputID , outputID] + endif + + end do !-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) - select case(plastic_phenopowerlaw_outputID(o,instance)) - case(resistance_slip_ID, & - shearrate_slip_ID, & - accumulatedshear_slip_ID, & - resolvedstress_slip_ID & - ) - mySize = totalNslip(instance) - case(resistance_twin_ID, & - shearrate_twin_ID, & - accumulatedshear_twin_ID, & - resolvedstress_twin_ID & - ) - mySize = totalNtwin(instance) - case(totalshear_ID, & - totalvolfrac_twin_ID & - ) - mySize = 1_pInt - case default - end select +! parameters independent of number of slip/twin systems +extmsg = '' +if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " +if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " +if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " +if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " + if (extmsg /= '') call IO_error(211_pInt,ip=instance,& + ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') + +if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tau0_slip' " +if (any(p%tau0_slip < p%tausat_slip .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tausat_slip' " +if (any(p%gdot0_slip <= 0.0_pReal .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tausat_slip' " +if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " + + !if (any(dEq0(p%a_slip) .and. sum(p%Nslip) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + + ! if (any(p%tau0_twin < 0.0_pReal .and. & + ! p%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + ! if ( p%gdot0_twin <= 0.0_pReal .and. & + ! any(p%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + ! if ( p%n_twin <= 0.0_pReal .and. & + ! any(p%Ntwin(:) > 0)) & + ! call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + + if (p%aTolResistance <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolResistance ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (p%aTolShear <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolShear ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (p%aTolTwinfrac <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') + + + + + NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase - outputFound: if (mySize > 0_pInt) then - plastic_phenopowerlaw_sizePostResult(o,instance) = mySize - plastic_phenopowerlaw_sizePostResults(instance) = plastic_phenopowerlaw_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop !-------------------------------------------------------------------------------------------------- ! allocate state arrays - sizeState = totalNslip(instance) & ! s_slip - + totalNtwin(instance) & ! s_twin - + 2_pInt & ! sum(gamma) + sum(f) - + totalNslip(instance) & ! accshear_slip - + totalNtwin(instance) ! accshear_twin + sizeState = size(['tau_slip ','accshear_slip']) * sum(p%nslip) & + + size(['tau_twin ','accshear_twin']) * sum(p%ntwin) & + + size(['sum(gamma)', 'sum(f) ']) sizeDotState = sizeState sizeDeltaState = 0_pInt plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = plastic_phenopowerlaw_sizePostResults(instance) - plasticState(phase)%nSlip =totalNslip(instance) - plasticState(phase)%nTwin =totalNtwin(instance) - plasticState(phase)%nTrans=0_pInt + plasticState(phase)%nSlip = sum(p%Nslip) + plasticState(phase)%nTwin = sum(p%Ntwin) allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) @@ -562,26 +357,26 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) !-------------------------------------------------------------------------------------------------- -! calculate hardening matrices and extend intitial values (per family -> per system) - mySlipFamilies: do f = 1_pInt,size(param(instance)%Nslip,1) ! >>> interaction slip -- X - index_myFamily = sum(param(instance)%Nslip(1:f-1_pInt)) - - mySlipSystems: do j = 1_pInt,param(instance)%Nslip(f) - otherSlipFamilies: do o = 1_pInt,size(param(instance)%Nslip,1) - index_otherFamily = sum(param(instance)%Nslip(1:o-1_pInt)) - otherSlipSystems: do k = 1_pInt,param(instance)%Nslip(o) - interaction_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & - param(instance)%interaction_SlipSlip(lattice_interactionSlipSlip( & +! calculate hardening matrices + mySlipFamilies: do f = 1_pInt,size(p%Nslip,1) ! >>> interaction slip -- X + index_myFamily = sum(p%Nslip(1:f-1_pInt)) + + mySlipSystems: do j = 1_pInt,p%Nslip(f) + otherSlipFamilies: do o = 1_pInt,size(p%Nslip,1) + index_otherFamily = sum(p%Nslip(1:o-1_pInt)) + otherSlipSystems: do k = 1_pInt,p%Nslip(o) + p%matrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & + p%interaction_SlipSlip(lattice_interactionSlipSlip( & sum(lattice_NslipSystem(1:f-1,phase))+j, & sum(lattice_NslipSystem(1:o-1,phase))+k, & phase)) enddo otherSlipSystems; enddo otherSlipFamilies - twinFamilies: do o = 1_pInt,size(param(instance)%Ntwin,1) - index_otherFamily = sum(param(instance)%Ntwin(1:o-1_pInt)) - twinSystems: do k = 1_pInt,param(instance)%Ntwin(o) - interaction_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & - param(instance)%interaction_SlipTwin(lattice_interactionSlipTwin( & + twinFamilies: do o = 1_pInt,size(p%Ntwin,1) + index_otherFamily = sum(p%Ntwin(1:o-1_pInt)) + twinSystems: do k = 1_pInt,p%Ntwin(o) + p%matrix_SlipTwin(index_myFamily+j,index_otherFamily+k) = & + p%interaction_SlipTwin(lattice_interactionSlipTwin( & sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & phase)) @@ -589,24 +384,24 @@ subroutine plastic_phenopowerlaw_init(fileUnit) enddo mySlipSystems enddo mySlipFamilies - myTwinFamilies: do f = 1_pInt,size(param(instance)%Ntwin,1) ! >>> interaction twin -- X - index_myFamily = sum(param(instance)%Ntwin(1:f-1_pInt)) - myTwinSystems: do j = 1_pInt,param(instance)%Ntwin(f) - slipFamilies: do o = 1_pInt,size(param(instance)%Nslip,1) - index_otherFamily = sum(param(instance)%Nslip(1:o-1_pInt)) - slipSystems: do k = 1_pInt,param(instance)%Nslip(o) - interaction_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & - param(instance)%interaction_TwinSlip(lattice_interactionTwinSlip( & + myTwinFamilies: do f = 1_pInt,size(p%Ntwin,1) ! >>> interaction twin -- X + index_myFamily = sum(p%Ntwin(1:f-1_pInt)) + myTwinSystems: do j = 1_pInt,p%Ntwin(f) + slipFamilies: do o = 1_pInt,size(p%Nslip,1) + index_otherFamily = sum(p%Nslip(1:o-1_pInt)) + slipSystems: do k = 1_pInt,p%Nslip(o) + p%matrix_TwinSlip(index_myFamily+j,index_otherFamily+k) = & + p%interaction_TwinSlip(lattice_interactionTwinSlip( & sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & phase)) enddo slipSystems; enddo slipFamilies - otherTwinFamilies: do o = 1_pInt,size(param(instance)%Ntwin,1) - index_otherFamily = sum(param(instance)%Ntwin(1:o-1_pInt)) - otherTwinSystems: do k = 1_pInt,param(instance)%Ntwin(o) - interaction_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & - param(instance)%interaction_TwinTwin(lattice_interactionTwinTwin( & + otherTwinFamilies: do o = 1_pInt,size(p%Ntwin,1) + index_otherFamily = sum(p%Ntwin(1:o-1_pInt)) + otherTwinSystems: do k = 1_pInt,p%Ntwin(o) + p%matrix_TwinTwin(index_myFamily+j,index_otherFamily+k) = & + p%interaction_TwinTwin(lattice_interactionTwinTwin( & sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & phase)) @@ -617,51 +412,51 @@ subroutine plastic_phenopowerlaw_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState startIndex = 1_pInt - endIndex = totalNslip(instance) + endIndex = plasticState(phase)%nSlip state (instance)%s_slip=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%s_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%state0(startIndex:endIndex,:) = & - spread(math_expand(param(instance)%tau0_slip, param(instance)%Nslip), 2, NipcMyPhase) + spread(math_expand(p%tau0_slip, p%Nslip), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolResistance + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolResistance startIndex = endIndex + 1_pInt - endIndex = endIndex + totalNtwin(instance) + endIndex = endIndex + plasticState(phase)%nTwin state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%state0(startIndex:endIndex,:) = & - spread(math_expand(param(instance)%tau0_twin, param(instance)%Ntwin), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolResistance + spread(math_expand(p%tau0_twin, p%Ntwin), 2, NipcMyPhase) + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumGamma=>plasticState(phase)%state (startIndex,:) dotState(instance)%sumGamma=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumF=>plasticState(phase)%state (startIndex,:) dotState(instance)%sumF=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolTwinFrac + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolTwinFrac startIndex = endIndex + 1_pInt - endIndex = endIndex + totalNslip(instance) + endIndex = endIndex + plasticState(phase)%nSlip state (instance)%accshear_slip=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear ! global alias plasticState(phase)%slipRate =>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%accumulatedSlip =>plasticState(phase)%state(startIndex:endIndex,:) startIndex = endIndex + 1_pInt - endIndex = endIndex + totalNtwin(instance) + endIndex = endIndex + plasticState(phase)%nTwin state (instance)%accshear_twin=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = param(instance)%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear - endif myPhase2 - enddo initializeInstances + endif + enddo end subroutine plastic_phenopowerlaw_init @@ -740,7 +535,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, tau_slip_neg = tau_slip_pos nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) - do k = 1,lattice_NnonSchmid(ph) + do k = 1,size(param(instance)%nonSchmidCoeff) tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) tau_slip_neg = tau_slip_neg + param(instance)%nonSchmidCoeff(k)* & @@ -842,22 +637,24 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) integer(pInt) :: & instance,ph, & f,i,j,k, & - index_myFamily, & + index_myFamily, nslip,ntwin,& of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & ssat_offset, & tau_slip_pos,tau_slip_neg,tau_twin - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Nslip) :: & gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip - real(pReal), dimension(totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Ntwin) :: & gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) + nSlip= sum(param(instance)%nslip) + nTwin= sum(param(instance)%nTwin) plasticState(ph)%dotState(:,of) = 0.0_pReal @@ -936,9 +733,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) j = j+1_pInt dotState(instance)%s_slip(j,of) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & - dot_product(interaction_SlipSlip(j,1:totalNslip(instance),instance), & + dot_product(param(instance)%matrix_SlipSlip(j,1:nslip), & right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(interaction_SlipTwin(j,1:totalNtwin(instance),instance), & + dot_product(param(instance)%matrix_SlipTwin(j,1:ntwin), & right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + & abs(gdot_slip(j)) @@ -953,10 +750,10 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) j = j+1_pInt dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j c_TwinSlip * left_TwinSlip(j) * & - dot_product(interaction_TwinSlip(j,1:totalNslip(instance),instance), & + dot_product(param(instance)%matrix_TwinSlip(j,1:nslip), & right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * left_TwinTwin(j) * & - dot_product(interaction_TwinTwin(j,1:totalNtwin(instance),instance), & + dot_product(param(instance)%matrix_TwinTwin(j,1:ntwin), & right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (state(instance)%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 dotState(instance)%sumF(of) = dotState(instance)%sumF(of) + & @@ -994,7 +791,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) ip, & !< integration point el !< element !< microstructure state - real(pReal), dimension(plastic_phenopowerlaw_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & plastic_phenopowerlaw_postResults integer(pInt) :: & @@ -1009,14 +806,14 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) - nSlip= totalNslip(instance) - nTwin= totalNtwin(instance) - + nSlip= sum(param(instance)%nslip) + nTwin= sum(param(instance)%nTwin) + plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt - outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) - select case(plastic_phenopowerlaw_outputID(o,instance)) + outputsLoop: do o = 1_pInt,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) case (resistance_slip_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%s_slip(1:nSlip,of) c = c + nSlip From a0a5d4c549e9a348f3b62e4a10506527bc282618 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 05:38:45 +0200 Subject: [PATCH 13/79] only doing things that are required rely on default values where applicable --- src/plastic_none.f90 | 50 +++++++++++++------------------------------- 1 file changed, 14 insertions(+), 36 deletions(-) diff --git a/src/plastic_none.f90 b/src/plastic_none.f90 index 140754556..5470c4a43 100644 --- a/src/plastic_none.f90 +++ b/src/plastic_none.f90 @@ -4,16 +4,9 @@ !> @brief material subroutine for purely elastic material !-------------------------------------------------------------------------------------------------- module plastic_none - use prec, only: & - pInt implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_none_sizePostResults - - integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_none_sizePostResult !< size of each post result output public :: & plastic_none_init @@ -31,6 +24,8 @@ subroutine plastic_none_init compiler_version, & compiler_options #endif + use prec, only: & + pInt use debug, only: & debug_level, & debug_constitutive, & @@ -51,18 +46,13 @@ subroutine plastic_none_init integer(pInt) :: & maxNinstance, & phase, & - NofMyPhase, & - sizeState, & - sizeDotState, & - sizeDeltaState + NofMyPhase write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONE_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" maxNinstance = int(count(phase_plasticity == PLASTICITY_none_ID),pInt) - if (maxNinstance == 0_pInt) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance @@ -70,37 +60,25 @@ subroutine plastic_none_init if (phase_plasticity(phase) == PLASTICITY_none_ID) then NofMyPhase=count(material_phase==phase) - sizeState = 0_pInt - plasticState(phase)%sizeState = sizeState - sizeDotState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - sizeDeltaState = 0_pInt - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = 0_pInt - plasticState(phase)%nSlip = 0_pInt - plasticState(phase)%nTwin = 0_pInt - plasticState(phase)%nTrans = 0_pInt - allocate(plasticState(phase)%aTolState (sizeState)) - allocate(plasticState(phase)%state0 (sizeState,NofMyPhase)) - allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase)) - allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase)) - allocate(plasticState(phase)%state (sizeState,NofMyPhase)) + allocate(plasticState(phase)%aTolState (0_pInt)) + allocate(plasticState(phase)%state0 (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%partionedState0 (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%subState0 (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%state (0_pInt,NofMyPhase)) - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase)) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase)) + allocate(plasticState(phase)%dotState (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%deltaState (0_pInt,NofMyPhase)) if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase)) - allocate(plasticState(phase)%previousDotState2(sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%previousDotState (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%previousDotState2(0_pInt,NofMyPhase)) endif if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%RK4dotState (0_pInt,NofMyPhase)) if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%RKCK45dotState (6,0_pInt,NofMyPhase)) endif enddo initializeInstances - allocate(plastic_none_sizePostResults(maxNinstance), source=0_pInt) - end subroutine plastic_none_init end module plastic_none From 29a0ec280083e8eb4fe6f97bf38631be301108cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 05:39:40 +0200 Subject: [PATCH 14/79] polishing --- src/plastic_phenopowerlaw.f90 | 118 ++++++++++++++++------------------ 1 file changed, 55 insertions(+), 63 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 3cc03ef1e..a06a31a88 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -118,18 +118,9 @@ subroutine plastic_phenopowerlaw_init math_Voigt66to3333, & math_expand use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use material, only: & phase_plasticity, & phase_plasticityInstance, & @@ -152,17 +143,18 @@ subroutine plastic_phenopowerlaw_init instance,phase,j,k, f,o, i,& NipcMyPhase, outputSize, & offset_slip, index_myFamily, index_otherFamily, & - sizeState,sizeDotState, sizeDeltaState, & + sizeState,sizeDotState, & startIndex, endIndex + integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] - real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] + real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] type(tParameters), pointer :: p integer(kind(undefined_ID)) :: & outputID !< ID of each post result output - character(len=65536) :: & + character(len=512) :: & extmsg = '' character(len=64), dimension(:), allocatable :: outputs @@ -190,18 +182,18 @@ subroutine plastic_phenopowerlaw_init p%Nslip = phaseConfig(phase)%getIntArray('nslip',defaultVal=emptyInt) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) if (sum(p%Nslip) > 0_pInt) then - p%tau0_slip = phaseConfig(phase)%getFloatArray('tau0_slip') - p%tausat_slip = phaseConfig(phase)%getFloatArray('tausat_slip') - p%H_int = phaseConfig(phase)%getFloatArray('h_int',defaultVal=[(0.0_pReal,i=1_pInt,size(p%Nslip))]) - print*, (shape(p%H_int)) - print*, (shape(p%Nslip)) + p%tau0_slip = phaseConfig(phase)%getFloatArray('tau0_slip') + p%tausat_slip = phaseConfig(phase)%getFloatArray('tausat_slip') p%interaction_SlipSlip = phaseConfig(phase)%getFloatArray('interaction_slipslip') + p%H_int = phaseConfig(phase)%getFloatArray('h_int',& + defaultVal=[(0.0_pReal,i=1_pInt,size(p%Nslip))]) p%nonSchmidCoeff = phaseConfig(phase)%getFloatArray('nonschmid_coefficients',& - defaultVal = [real(pReal)::1] ) - p%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') - p%n_slip = phaseConfig(phase)%getFloat('n_slip') - p%a_slip = phaseConfig(phase)%getFloat('a_slip') - p%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') + defaultVal = [real(pReal)::1] ) + + p%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') + p%n_slip = phaseConfig(phase)%getFloat('n_slip') + p%a_slip = phaseConfig(phase)%getFloat('a_slip') + p%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') endif p%Ntwin = phaseConfig(phase)%getIntArray('ntwin', defaultVal=emptyInt) @@ -209,15 +201,17 @@ subroutine plastic_phenopowerlaw_init if (sum(p%Ntwin) > 0_pInt) then p%tau0_twin = phaseConfig(phase)%getFloatArray('tau0_twin') p%interaction_TwinTwin = phaseConfig(phase)%getFloatArray('interaction_twintwin') - p%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') - p%n_twin = phaseConfig(phase)%getFloat('n_twin') - p%spr = phaseConfig(phase)%getFloat('s_pr') - p%twinB = phaseConfig(phase)%getFloat('twin_b') - p%twinC = phaseConfig(phase)%getFloat('twin_c') - p%twinD = phaseConfig(phase)%getFloat('twin_d') - p%twinE = phaseConfig(phase)%getFloat('twin_e') - p%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') - endif + + p%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') + p%n_twin = phaseConfig(phase)%getFloat('n_twin') + p%spr = phaseConfig(phase)%getFloat('s_pr') + p%twinB = phaseConfig(phase)%getFloat('twin_b') + p%twinC = phaseConfig(phase)%getFloat('twin_c') + p%twinD = phaseConfig(phase)%getFloat('twin_d') + p%twinE = phaseConfig(phase)%getFloat('twin_e') + p%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') + endif + if (sum(p%Nslip) > 0_pInt .and. sum(p%Ntwin) > 0_pInt) then p%interaction_SlipTwin = phaseConfig(phase)%getFloatArray('interaction_sliptwin') p%interaction_TwinSlip = phaseConfig(phase)%getFloatArray('interaction_twinslip') @@ -228,9 +222,11 @@ subroutine plastic_phenopowerlaw_init allocate(p%matrix_SlipTwin(sum(p%Nslip),sum(p%Ntwin)),source =0.0_pReal) allocate(p%matrix_TwinSlip(sum(p%Ntwin),sum(p%Nslip)),source =0.0_pReal) allocate(p%matrix_TwinTwin(sum(p%Ntwin),sum(p%Ntwin)),source =0.0_pReal) - p%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) - p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - p%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + + p%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) + p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + p%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + outputs = phaseConfig(phase)%getStrings('(output)') allocate(p%outputID(0)) do i=1_pInt, size(outputs) @@ -280,21 +276,21 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! parameters independent of number of slip/twin systems -extmsg = '' -if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " -if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " -if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " -if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " - if (extmsg /= '') call IO_error(211_pInt,ip=instance,& - ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') - -if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tau0_slip' " -if (any(p%tau0_slip < p%tausat_slip .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tausat_slip' " -if (any(p%gdot0_slip <= 0.0_pReal .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tausat_slip' " -if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " + extmsg = '' + if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " + if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " + if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " + if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " + if (extmsg /= '') call IO_error(211_pInt,ip=instance,& + ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') + + if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tau0_slip' " + if (any(p%tau0_slip < p%tausat_slip .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tausat_slip' " + if (any(p%gdot0_slip <= 0.0_pReal .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tausat_slip' " + if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " !if (any(dEq0(p%a_slip) .and. sum(p%Nslip) > 0)) & ! call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') @@ -317,21 +313,16 @@ if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') - - - NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase - !-------------------------------------------------------------------------------------------------- ! allocate state arrays + NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase sizeState = size(['tau_slip ','accshear_slip']) * sum(p%nslip) & + size(['tau_twin ','accshear_twin']) * sum(p%ntwin) & + size(['sum(gamma)', 'sum(f) ']) sizeDotState = sizeState - sizeDeltaState = 0_pInt plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState plasticState(phase)%nSlip = sum(p%Nslip) plasticState(phase)%nTwin = sum(p%Ntwin) allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) @@ -339,8 +330,9 @@ if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (0_pInt,NipcMyPhase), source=0.0_pReal) if (any(numerics_integrator == 1_pInt)) then allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) @@ -350,12 +342,6 @@ if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " if (any(numerics_integrator == 5_pInt)) & allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) - offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt - plasticState(phase)%slipRate => & - plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - !-------------------------------------------------------------------------------------------------- ! calculate hardening matrices mySlipFamilies: do f = 1_pInt,size(p%Nslip,1) ! >>> interaction slip -- X @@ -455,6 +441,12 @@ if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear + offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt + plasticState(phase)%slipRate => & + plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + plasticState(phase)%accumulatedSlip => & + plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + endif enddo From 11383a2aca5005e082287a52d420835f91e8602c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 10:19:22 +0200 Subject: [PATCH 15/79] proper error checks --- src/plastic_phenopowerlaw.f90 | 67 ++++++++++++++++------------------- 1 file changed, 30 insertions(+), 37 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index a06a31a88..156fe29d0 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -272,46 +272,40 @@ subroutine plastic_phenopowerlaw_init p%outputID = [p%outputID , outputID] endif - end do + end do -!-------------------------------------------------------------------------------------------------- -! parameters independent of number of slip/twin systems - extmsg = '' - if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " - if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " - if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " - if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " - if (extmsg /= '') call IO_error(211_pInt,ip=instance,& - ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') - - if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tau0_slip' " - if (any(p%tau0_slip < p%tausat_slip .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tausat_slip' " - if (any(p%gdot0_slip <= 0.0_pReal .and. p%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tausat_slip' " - if (p%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'n_slip' " + extmsg = '' + if (sum(p%Nslip) > 0_pInt) then + if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " + if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " + if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " - !if (any(dEq0(p%a_slip) .and. sum(p%Nslip) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tau0_slip' " + if (any(p%tausat_slip < p%tau0_slip .and. p%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//" 'tausat_slip' " - ! if (any(p%tau0_twin < 0.0_pReal .and. & - ! p%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - ! if ( p%gdot0_twin <= 0.0_pReal .and. & - ! any(p%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - ! if ( p%n_twin <= 0.0_pReal .and. & - ! any(p%Ntwin(:) > 0)) & - ! call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (p%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_slip' " + if (dEq0(p%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? + if (dEq0(p%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? + endif - if (p%aTolResistance <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolResistance ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (p%aTolShear <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolShear ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (p%aTolTwinfrac <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolTwinfrac ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (sum(p%Ntwin) > 0_pInt) then + if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " + if (any(p%tau0_twin < 0.0_pReal .and. p%Ntwin > 0_pInt)) & + extmsg = trim(extmsg)//" 'tau0_twin' " + + if (p%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_twin' " + if (dEq0(p%n_twin)) extmsg = trim(extmsg)//" n_twin " ! ToDo: negative values ok? + endif + + if (p%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolresistance' " + if (p%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolShear' " + if (p%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//" 'atoltwinfrac' " + + if (extmsg /= '') call IO_error(211_pInt,ip=instance,& + ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') !-------------------------------------------------------------------------------------------------- ! allocate state arrays @@ -471,8 +465,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, lattice_maxNslipFamily, & lattice_maxNtwinFamily, & lattice_NslipSystem, & - lattice_NtwinSystem, & - lattice_NnonSchmid + lattice_NtwinSystem use material, only: & phaseAt, phasememberAt, & phase_plasticityInstance From 8aeb4a115ef455d5935a9b0b3d2428d014c3c4bc Mon Sep 17 00:00:00 2001 From: Jaeyong Jung Date: Mon, 18 Jun 2018 16:19:03 +0200 Subject: [PATCH 16/79] first commit. --- src/spectral_interface.f90 | 140 ++++++++++++++++++++++++++++++++++++- 1 file changed, 137 insertions(+), 3 deletions(-) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index d2adcf9ba..9b1808e0f 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -195,9 +195,17 @@ subroutine DAMASK_interface_init() call quit(1_pInt) endif - workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg),trim(geometryArg))) - geometryFile = getGeometryFile(geometryArg) - loadCaseFile = getLoadCaseFile(loadCaseArg) +! workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg),trim(geometryArg))) +! geometryFile = getGeometryFile(geometryArg) +! loadCaseFile = getLoadCaseFile(loadCaseArg) + + workingDirectory = trim(storeWorkingDirectory2(trim(workingDirArg),trim(geometryArg))) + geometryFile = getGeometryFile2(geometryArg,workingDirectory) + loadCaseFile = getLoadCaseFile2(loadCaseArg,workingDirectory) + + +! write(*,*) trim(workingDirectory) +! write(*,*) trim(workingDirectory)//'/' ! put '/' next to workingDirectory call get_environment_variable('USER',userName) error = getHostName(hostName) @@ -216,9 +224,135 @@ subroutine DAMASK_interface_init() write(6,'(a,i6.6)') ' Restart from increment: ', spectralRestartInc write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile + read(*,*) + end subroutine DAMASK_interface_init + +!-------------------------------------------------------------------------------------------------- +!> @brief extract working directory from given argument or from location of geometry file, +!! possibly converting relative arguments to absolut path +!> @todo change working directory with call chdir(storeWorkingDirectory)? +!-------------------------------------------------------------------------------------------------- +character(len=1024) function storeWorkingDirectory2(workingDirectoryArg,geometryArg) + use system_routines, only: & + isDirectory, & + getCWD + + implicit none + character(len=*), intent(in) :: workingDirectoryArg !< working directory argument + character(len=*), intent(in) :: geometryArg !< geometry argument + character(len=1024) :: cwd + logical :: error + external :: quit + + wdGiven: if (len(workingDirectoryArg)>0) then !< -d is given + absolutePath: if (workingDirectoryArg(1:1) == '/') then !< absolute path is given to workingDirectoryArg + storeWorkingDirectory2 = workingDirectoryArg + else absolutePath !< relative path is given + error = getCWD(cwd) + if (error) call quit(1_pInt) + storeWorkingDirectory2 = trim(cwd)//'/'//workingDirectoryArg !< add relative path to cwd + endif absolutePath + if (storeWorkingDirectory2(len(trim(storeWorkingDirectory2)):len(trim(storeWorkingDirectory2))) /= '/') & + storeWorkingDirectory2 = trim(storeWorkingDirectory2)//'/' ! if path seperator is not given, append it + else wdGiven !< -d is not given + error = getCWD(cwd) + if (error) call quit(1_pInt) + storeWorkingDirectory2 = trim(cwd)//'/' + +! if (geometryArg(1:1) == '/') then ! absolute path given as command line argument +! storeWorkingDirectory2 = geometryArg(1:scan(geometryArg,'/',back=.true.)) +! else +! error = getCWD(cwd) ! relative path given as command line argument +! if (error) call quit(1_pInt) +! storeWorkingDirectory2 = trim(cwd)//'/'//geometryArg(1:scan(geometryArg,'/',back=.true.)) !< workingDirectory should not depend on geometryArg +! endif + endif wdGiven + + storeWorkingDirectory2 = trim(rectifyPath(storeWorkingDirectory2)) + if(.not. isDirectory(trim(storeWorkingDirectory2))) then ! check if the directory exists + write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory2),'" does not exist' + call quit(1_pInt) + endif + +end function storeWorkingDirectory2 + + + +!-------------------------------------------------------------------------------------------------- +!> @brief basename of geometry file with extension from command line arguments +!-------------------------------------------------------------------------------------------------- +character(len=1024) function getGeometryFile2(geometryParameter,workingDirectory) + use system_routines, only: & + getCWD + + implicit none + character(len=1024), intent(in) :: & + geometryParameter + character(len=*), intent(in) :: workingDirectory !< working directory +! character(len=1024) :: & +! cwd + integer :: posExt, posSep + logical :: error + external :: quit + + getGeometryFile2 = geometryParameter + posExt = scan(getGeometryFile2,'.',back=.true.) + posSep = scan(getGeometryFile2,'/',back=.true.) + + if (posExt <= posSep) getGeometryFile2 = trim(getGeometryFile2)//('.geom') ! no extension present + if (scan(getGeometryFile2,'/') /= 1) then ! relative path given as command line argument +! error = getcwd(cwd) ! no more cwd +! cwd = workingDirectory + if (error) call quit(1_pInt) + getGeometryFile2 = rectifyPath(trim(workingDirectory)//'/'//getGeometryFile2) + else + getGeometryFile2 = rectifyPath(getGeometryFile2) + endif + + getGeometryFile2 = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile2) + +end function getGeometryFile2 + + +!-------------------------------------------------------------------------------------------------- +!> @brief relative path of loadcase from command line arguments +!-------------------------------------------------------------------------------------------------- +character(len=1024) function getLoadCaseFile2(loadCaseParameter,workingDirectory) + use system_routines, only: & + getCWD + + implicit none + character(len=1024), intent(in) :: & + loadCaseParameter + character(len=*), intent(in) :: workingDirectory !< working directory +! character(len=1024) :: & +! cwd + integer :: posExt, posSep + logical :: error + external :: quit + + getLoadCaseFile2 = loadcaseParameter + posExt = scan(getLoadCaseFile2,'.',back=.true.) + posSep = scan(getLoadCaseFile2,'/',back=.true.) + + if (posExt <= posSep) getLoadCaseFile2 = trim(getLoadCaseFile2)//('.load') ! no extension present + if (scan(getLoadCaseFile2,'/') /= 1) then ! relative path given as command line argument +! error = getcwd(cwd) +! cwd = workingDirectory + if (error) call quit(1_pInt) + getLoadCaseFile2 = rectifyPath(trim(workingDirectory)//'/'//getLoadCaseFile2) + else + getLoadCaseFile2 = rectifyPath(getLoadCaseFile2) + endif + + getLoadCaseFile2 = makeRelativePath(getSolverWorkingDirectoryName(), getLoadCaseFile2) + +end function getLoadCaseFile2 + + !-------------------------------------------------------------------------------------------------- !> @brief extract working directory from given argument or from location of geometry file, !! possibly converting relative arguments to absolut path From 13f280367e65027ef6fce4058741132a0b4b39d8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 19:43:41 +0200 Subject: [PATCH 17/79] using config module --- src/linked_list.f90 | 2 +- src/plastic_phenopowerlaw.f90 | 207 +++++++++++++++++----------------- 2 files changed, 105 insertions(+), 104 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index 6826a26da..142528fa1 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -431,7 +431,7 @@ function getFloats(this,key,defaultVal) real(pReal), dimension(:), allocatable :: getFloats class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key - integer(pInt), dimension(:), intent(in), optional :: defaultVal + real(pReal), dimension(:), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: item integer(pInt) :: i logical :: found, & diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 7800feb22..b5ddcc187 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -130,7 +130,8 @@ subroutine plastic_phenopowerlaw_init material_phase, & plasticState use config, only: & - MATERIAL_partPhase + MATERIAL_partPhase, & + phaseConfig use lattice use numerics,only: & numerics_integrator @@ -148,7 +149,7 @@ subroutine plastic_phenopowerlaw_init integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] - type(tParameters), pointer :: p + type(tParameters), pointer :: prm integer(kind(undefined_ID)) :: & outputID !< ID of each post result output @@ -176,86 +177,86 @@ subroutine plastic_phenopowerlaw_init do phase = 1_pInt, size(phase_plasticityInstance) if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then instance = phase_plasticityInstance(phase) - p => param(instance) + prm => param(instance) - p%Nslip = phaseConfig(phase)%getIntArray('nslip',defaultVal=emptyInt) + prm%Nslip = phaseConfig(phase)%getInts('nslip',defaultVal=emptyInt) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - if (sum(p%Nslip) > 0_pInt) then - p%tau0_slip = phaseConfig(phase)%getFloatArray('tau0_slip') - p%tausat_slip = phaseConfig(phase)%getFloatArray('tausat_slip') - p%interaction_SlipSlip = phaseConfig(phase)%getFloatArray('interaction_slipslip') - p%H_int = phaseConfig(phase)%getFloatArray('h_int',& - defaultVal=[(0.0_pReal,i=1_pInt,size(p%Nslip))]) - p%nonSchmidCoeff = phaseConfig(phase)%getFloatArray('nonschmid_coefficients',& + if (sum(prm%Nslip) > 0_pInt) then + prm%tau0_slip = phaseConfig(phase)%getFloats('tau0_slip') + prm%tausat_slip = phaseConfig(phase)%getFloats('tausat_slip') + prm%interaction_SlipSlip = phaseConfig(phase)%getFloats('interaction_slipslip') + prm%H_int = phaseConfig(phase)%getFloats('h_int',& + defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%nonSchmidCoeff = phaseConfig(phase)%getFloats('nonschmid_coefficients',& defaultVal = [real(pReal)::1] ) - p%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') - p%n_slip = phaseConfig(phase)%getFloat('n_slip') - p%a_slip = phaseConfig(phase)%getFloat('a_slip') - p%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') + prm%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') + prm%n_slip = phaseConfig(phase)%getFloat('n_slip') + prm%a_slip = phaseConfig(phase)%getFloat('a_slip') + prm%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') endif - p%Ntwin = phaseConfig(phase)%getIntArray('ntwin', defaultVal=emptyInt) + prm%Ntwin = phaseConfig(phase)%getInts('ntwin', defaultVal=emptyInt) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - if (sum(p%Ntwin) > 0_pInt) then - p%tau0_twin = phaseConfig(phase)%getFloatArray('tau0_twin') - p%interaction_TwinTwin = phaseConfig(phase)%getFloatArray('interaction_twintwin') + if (sum(prm%Ntwin) > 0_pInt) then + prm%tau0_twin = phaseConfig(phase)%getFloats('tau0_twin') + prm%interaction_TwinTwin = phaseConfig(phase)%getFloats('interaction_twintwin') - p%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') - p%n_twin = phaseConfig(phase)%getFloat('n_twin') - p%spr = phaseConfig(phase)%getFloat('s_pr') - p%twinB = phaseConfig(phase)%getFloat('twin_b') - p%twinC = phaseConfig(phase)%getFloat('twin_c') - p%twinD = phaseConfig(phase)%getFloat('twin_d') - p%twinE = phaseConfig(phase)%getFloat('twin_e') - p%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') + prm%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') + prm%n_twin = phaseConfig(phase)%getFloat('n_twin') + prm%spr = phaseConfig(phase)%getFloat('s_pr') + prm%twinB = phaseConfig(phase)%getFloat('twin_b') + prm%twinC = phaseConfig(phase)%getFloat('twin_c') + prm%twinD = phaseConfig(phase)%getFloat('twin_d') + prm%twinE = phaseConfig(phase)%getFloat('twin_e') + prm%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') endif - if (sum(p%Nslip) > 0_pInt .and. sum(p%Ntwin) > 0_pInt) then - p%interaction_SlipTwin = phaseConfig(phase)%getFloatArray('interaction_sliptwin') - p%interaction_TwinSlip = phaseConfig(phase)%getFloatArray('interaction_twinslip') - p%h0_TwinSlip = phaseConfig(phase)%getFloat('h0_twinslip') + if (sum(prm%Nslip) > 0_pInt .and. sum(prm%Ntwin) > 0_pInt) then + prm%interaction_SlipTwin = phaseConfig(phase)%getFloats('interaction_sliptwin') + prm%interaction_TwinSlip = phaseConfig(phase)%getFloats('interaction_twinslip') + prm%h0_TwinSlip = phaseConfig(phase)%getFloat('h0_twinslip') endif - allocate(p%matrix_SlipSlip(sum(p%Nslip),sum(p%Nslip)),source =0.0_pReal) - allocate(p%matrix_SlipTwin(sum(p%Nslip),sum(p%Ntwin)),source =0.0_pReal) - allocate(p%matrix_TwinSlip(sum(p%Ntwin),sum(p%Nslip)),source =0.0_pReal) - allocate(p%matrix_TwinTwin(sum(p%Ntwin),sum(p%Ntwin)),source =0.0_pReal) + allocate(prm%matrix_SlipSlip(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) + allocate(prm%matrix_SlipTwin(sum(prm%Nslip),sum(prm%Ntwin)),source =0.0_pReal) + allocate(prm%matrix_TwinSlip(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) + allocate(prm%matrix_TwinTwin(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) - p%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) - p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - p%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + prm%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) + prm%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + prm%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) outputs = phaseConfig(phase)%getStrings('(output)') - allocate(p%outputID(0)) + allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID select case(outputs(i)) case ('resistance_slip') outputID = resistance_slip_ID - outputSize = sum(p%Nslip) + outputSize = sum(prm%Nslip) case ('acumulatedshear_slip','accumulated_shear_slip') outputID = accumulatedshear_slip_ID - outputSize = sum(p%Nslip) + outputSize = sum(prm%Nslip) case ('shearrate_slip') outputID = shearrate_slip_ID - outputSize = sum(p%Nslip) + outputSize = sum(prm%Nslip) case ('resolvedstress_slip') outputID = resolvedstress_slip_ID - outputSize = sum(p%Nslip) + outputSize = sum(prm%Nslip) case ('resistance_twin') outputID = resistance_twin_ID - outputSize = sum(p%Ntwin) + outputSize = sum(prm%Ntwin) case ('accumulatedshear_twin','accumulated_shear_twin') outputID = accumulatedshear_twin_ID - outputSize = sum(p%Ntwin) + outputSize = sum(prm%Ntwin) case ('shearrate_twin') outputID = shearrate_twin_ID - outputSize = sum(p%Ntwin) + outputSize = sum(prm%Ntwin) case ('resolvedstress_twin') outputID = resolvedstress_twin_ID - outputSize = sum(p%Ntwin) + outputSize = sum(prm%Ntwin) case ('totalvolfrac_twin') outputID = totalvolfrac_twin_ID @@ -268,40 +269,40 @@ subroutine plastic_phenopowerlaw_init if (outputID /= undefined_ID) then plastic_phenopowerlaw_output(i,instance) = outputs(i) plastic_phenopowerlaw_sizePostResult(i,instance) = outputSize - p%outputID = [p%outputID , outputID] + prm%outputID = [prm%outputID , outputID] endif end do extmsg = '' - if (sum(p%Nslip) > 0_pInt) then - if (size(p%tau0_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " - if (size(p%tausat_slip) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " - if (size(p%H_int) /= size(p%nslip)) extmsg = trim(extmsg)//" shape(h_int) " + if (sum(prm%Nslip) > 0_pInt) then + if (size(prm%tau0_slip) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " + if (size(prm%tausat_slip) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " + if (size(prm%H_int) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(h_int) " - if (any(p%tau0_slip < 0.0_pReal .and. p%Nslip > 0_pInt)) & + if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & extmsg = trim(extmsg)//" 'tau0_slip' " - if (any(p%tausat_slip < p%tau0_slip .and. p%Nslip > 0_pInt)) & + if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & extmsg = trim(extmsg)//" 'tausat_slip' " - if (p%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_slip' " - if (dEq0(p%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? - if (dEq0(p%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? + if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_slip' " + if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? + if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? endif - if (sum(p%Ntwin) > 0_pInt) then - if (size(p%tau0_twin) /= size(p%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " + if (sum(prm%Ntwin) > 0_pInt) then + if (size(prm%tau0_twin) /= size(prm%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " - if (any(p%tau0_twin < 0.0_pReal .and. p%Ntwin > 0_pInt)) & + if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & extmsg = trim(extmsg)//" 'tau0_twin' " - if (p%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_twin' " - if (dEq0(p%n_twin)) extmsg = trim(extmsg)//" n_twin " ! ToDo: negative values ok? + if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_twin' " + if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//" n_twin " ! ToDo: negative values ok? endif - if (p%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolresistance' " - if (p%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolShear' " - if (p%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//" 'atoltwinfrac' " + if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolresistance' " + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolShear' " + if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//" 'atoltwinfrac' " if (extmsg /= '') call IO_error(211_pInt,ip=instance,& ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') @@ -309,15 +310,15 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase - sizeState = size(['tau_slip ','accshear_slip']) * sum(p%nslip) & - + size(['tau_twin ','accshear_twin']) * sum(p%ntwin) & + sizeState = size(['tau_slip ','accshear_slip']) * sum(prm%nslip) & + + size(['tau_twin ','accshear_twin']) * sum(prm%ntwin) & + size(['sum(gamma)', 'sum(f) ']) sizeDotState = sizeState plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%nSlip = sum(p%Nslip) - plasticState(phase)%nTwin = sum(p%Ntwin) + plasticState(phase)%nSlip = sum(prm%Nslip) + plasticState(phase)%nTwin = sum(prm%Ntwin) allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) @@ -337,25 +338,25 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! calculate hardening matrices - mySlipFamilies: do f = 1_pInt,size(p%Nslip,1) ! >>> interaction slip -- X - index_myFamily = sum(p%Nslip(1:f-1_pInt)) + mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) ! >>> interaction slip -- X + index_myFamily = sum(prm%Nslip(1:f-1_pInt)) - mySlipSystems: do j = 1_pInt,p%Nslip(f) - otherSlipFamilies: do o = 1_pInt,size(p%Nslip,1) - index_otherFamily = sum(p%Nslip(1:o-1_pInt)) - otherSlipSystems: do k = 1_pInt,p%Nslip(o) - p%matrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & - p%interaction_SlipSlip(lattice_interactionSlipSlip( & + mySlipSystems: do j = 1_pInt,prm%Nslip(f) + otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + otherSlipSystems: do k = 1_pInt,prm%Nslip(o) + prm%matrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_SlipSlip(lattice_interactionSlipSlip( & sum(lattice_NslipSystem(1:f-1,phase))+j, & sum(lattice_NslipSystem(1:o-1,phase))+k, & phase)) enddo otherSlipSystems; enddo otherSlipFamilies - twinFamilies: do o = 1_pInt,size(p%Ntwin,1) - index_otherFamily = sum(p%Ntwin(1:o-1_pInt)) - twinSystems: do k = 1_pInt,p%Ntwin(o) - p%matrix_SlipTwin(index_myFamily+j,index_otherFamily+k) = & - p%interaction_SlipTwin(lattice_interactionSlipTwin( & + twinFamilies: do o = 1_pInt,size(prm%Ntwin,1) + index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) + twinSystems: do k = 1_pInt,prm%Ntwin(o) + prm%matrix_SlipTwin(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_SlipTwin(lattice_interactionSlipTwin( & sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & phase)) @@ -363,24 +364,24 @@ subroutine plastic_phenopowerlaw_init enddo mySlipSystems enddo mySlipFamilies - myTwinFamilies: do f = 1_pInt,size(p%Ntwin,1) ! >>> interaction twin -- X - index_myFamily = sum(p%Ntwin(1:f-1_pInt)) - myTwinSystems: do j = 1_pInt,p%Ntwin(f) - slipFamilies: do o = 1_pInt,size(p%Nslip,1) - index_otherFamily = sum(p%Nslip(1:o-1_pInt)) - slipSystems: do k = 1_pInt,p%Nslip(o) - p%matrix_TwinSlip(index_myFamily+j,index_otherFamily+k) = & - p%interaction_TwinSlip(lattice_interactionTwinSlip( & + myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X + index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) + myTwinSystems: do j = 1_pInt,prm%Ntwin(f) + slipFamilies: do o = 1_pInt,size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + slipSystems: do k = 1_pInt,prm%Nslip(o) + prm%matrix_TwinSlip(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_TwinSlip(lattice_interactionTwinSlip( & sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & phase)) enddo slipSystems; enddo slipFamilies - otherTwinFamilies: do o = 1_pInt,size(p%Ntwin,1) - index_otherFamily = sum(p%Ntwin(1:o-1_pInt)) - otherTwinSystems: do k = 1_pInt,p%Ntwin(o) - p%matrix_TwinTwin(index_myFamily+j,index_otherFamily+k) = & - p%interaction_TwinTwin(lattice_interactionTwinTwin( & + otherTwinFamilies: do o = 1_pInt,size(prm%Ntwin,1) + index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) + otherTwinSystems: do k = 1_pInt,prm%Ntwin(o) + prm%matrix_TwinTwin(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_TwinTwin(lattice_interactionTwinTwin( & sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & phase)) @@ -395,35 +396,35 @@ subroutine plastic_phenopowerlaw_init state (instance)%s_slip=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%s_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%state0(startIndex:endIndex,:) = & - spread(math_expand(p%tau0_slip, p%Nslip), 2, NipcMyPhase) + spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolResistance + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + plasticState(phase)%nTwin state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%state0(startIndex:endIndex,:) = & - spread(math_expand(p%tau0_twin, p%Ntwin), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolResistance + spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumGamma=>plasticState(phase)%state (startIndex,:) dotState(instance)%sumGamma=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt state (instance)%sumF=>plasticState(phase)%state (startIndex,:) dotState(instance)%sumF=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolTwinFrac + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac startIndex = endIndex + 1_pInt endIndex = endIndex + plasticState(phase)%nSlip state (instance)%accshear_slip=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear ! global alias plasticState(phase)%slipRate =>plasticState(phase)%dotState(startIndex:endIndex,:) plasticState(phase)%accumulatedSlip =>plasticState(phase)%state(startIndex:endIndex,:) @@ -432,7 +433,7 @@ subroutine plastic_phenopowerlaw_init endIndex = endIndex + plasticState(phase)%nTwin state (instance)%accshear_twin=>plasticState(phase)%state (startIndex:endIndex,:) dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = p%aTolShear + plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt plasticState(phase)%slipRate => & From 7ccca899c6ad4813fc8062e5675de5f71d8d5eb9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 23:36:46 +0200 Subject: [PATCH 18/79] using branch 19 counterpart in PRIVATE to adjust parameter names --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index aead92902..89246b5ee 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit aead92902b3a0cf3404be9c552bfec918d7aaffb +Subproject commit 89246b5ee30a850a52df020c4770b685568ccbc2 From 0f3485c4a124e34ad3c869770f2214f0deeceae6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Jun 2018 23:14:30 +0200 Subject: [PATCH 19/79] using default value for when getting strings, setting correct size for post results --- src/plastic_phenopowerlaw.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index b5ddcc187..79aac355e 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -1,5 +1,6 @@ !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief material subroutine for phenomenological crystal plasticity formulation using a powerlaw !! fitting !-------------------------------------------------------------------------------------------------- @@ -227,7 +228,7 @@ subroutine plastic_phenopowerlaw_init prm%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) prm%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) - outputs = phaseConfig(phase)%getStrings('(output)') + outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=[character(len=65536)::]) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID @@ -317,6 +318,7 @@ subroutine plastic_phenopowerlaw_init sizeDotState = sizeState plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) plasticState(phase)%nSlip = sum(prm%Nslip) plasticState(phase)%nTwin = sum(prm%Ntwin) allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) From 74aec7bb71ec831ab02d3074376ac4369b4ab242 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Jun 2018 18:14:14 +0200 Subject: [PATCH 20/79] circumventing bug in Gfortran, tests use correct label (a_slip) --- PRIVATE | 2 +- src/plastic_phenopowerlaw.f90 | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index 89246b5ee..99433c5ca 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 89246b5ee30a850a52df020c4770b685568ccbc2 +Subproject commit 99433c5cadc8d568b94282834ce80ffc960fbed8 diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 79aac355e..4ee6cb3c9 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -157,7 +157,7 @@ subroutine plastic_phenopowerlaw_init character(len=512) :: & extmsg = '' - character(len=64), dimension(:), allocatable :: outputs + character(len=65536), dimension(:), allocatable :: outputs write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -228,7 +228,13 @@ subroutine plastic_phenopowerlaw_init prm%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) prm%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) +#if defined(__GFORTRAN__) + outputs = ['GfortranBug86277'] + outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=outputs) + if (outputs(1) == 'GfortranBug86277') outputs = [character(len=65536)::] +#else outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=[character(len=65536)::]) +#endif allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID From bd09bd91f911b1df3485b4dc4804db2b5e2f4049 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 23 Jun 2018 14:48:32 +0200 Subject: [PATCH 21/79] exit immediately if array size does not match Nslip/Ntwin otherwise, array acces out of bounds might happen for subsequent sanity checks --- src/plastic_phenopowerlaw.f90 | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 4ee6cb3c9..6979187ed 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -283,33 +283,37 @@ subroutine plastic_phenopowerlaw_init extmsg = '' if (sum(prm%Nslip) > 0_pInt) then - if (size(prm%tau0_slip) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(tau0_slip) " - if (size(prm%tausat_slip) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(tausat_slip) " - if (size(prm%H_int) /= size(prm%nslip)) extmsg = trim(extmsg)//" shape(h_int) " + if (size(prm%tau0_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(tau0_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (size(prm%tausat_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(tausat_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (size(prm%H_int) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(H_int) ('//PLASTICITY_PHENOPOWERLAW_label//')') if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tau0_slip' " + extmsg = trim(extmsg)//"tau0_slip " if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//" 'tausat_slip' " + extmsg = trim(extmsg)//"tausat_slip " - if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_slip' " + if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" gdot0_slip " if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? endif if (sum(prm%Ntwin) > 0_pInt) then - if (size(prm%tau0_twin) /= size(prm%ntwin)) extmsg = trim(extmsg)//" shape(tau0_twin) " + if (size(prm%tau0_twin) /= size(prm%ntwin)) call IO_error(211_pInt,ip=instance,& + ext_msg='shape(tau0_twin) ('//PLASTICITY_PHENOPOWERLAW_label//')') if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & - extmsg = trim(extmsg)//" 'tau0_twin' " + extmsg = trim(extmsg)//"tau0_twin " - if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//" 'gdot0_twin' " - if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//" n_twin " ! ToDo: negative values ok? + if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_twin " + if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//"n_twin " ! ToDo: negative values ok? endif - if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolresistance' " - if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//" 'aTolShear' " - if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//" 'atoltwinfrac' " + if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//"aTolresistance " + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"aTolShear " + if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//"atoltwinfrac " if (extmsg /= '') call IO_error(211_pInt,ip=instance,& ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') From d484d1b5bb919f8d58ec300f1c82e9398b7f439f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 25 Jun 2018 10:33:22 +0200 Subject: [PATCH 22/79] fixed typo and removed alias --- src/plastic_phenopowerlaw.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 6979187ed..d888e6c09 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -242,7 +242,7 @@ subroutine plastic_phenopowerlaw_init case ('resistance_slip') outputID = resistance_slip_ID outputSize = sum(prm%Nslip) - case ('acumulatedshear_slip','accumulated_shear_slip') + case ('accumulatedshear_slip') outputID = accumulatedshear_slip_ID outputSize = sum(prm%Nslip) case ('shearrate_slip') @@ -255,7 +255,7 @@ subroutine plastic_phenopowerlaw_init case ('resistance_twin') outputID = resistance_twin_ID outputSize = sum(prm%Ntwin) - case ('accumulatedshear_twin','accumulated_shear_twin') + case ('accumulatedshear_twin') outputID = accumulatedshear_twin_ID outputSize = sum(prm%Ntwin) case ('shearrate_twin') From feb69782556b8e963445fdd05dfb5a94e8ec07bd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 25 Jun 2018 10:33:36 +0200 Subject: [PATCH 23/79] test was broken --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 99433c5ca..c9eed7180 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 99433c5cadc8d568b94282834ce80ffc960fbed8 +Subproject commit c9eed718041d098d7695871c1b123eae950b141d From f63e8fe34ecd88c72c9bc2d1b3e7d6cb258cf6e5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 25 Jun 2018 13:43:34 +0200 Subject: [PATCH 24/79] avoid specifying per-family-values for inactive families --- PRIVATE | 2 +- lib/damask/config/material.py | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index c9eed7180..d8ab8056d 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c9eed718041d098d7695871c1b123eae950b141d +Subproject commit d8ab8056d6245ce42bec8953de9af1d7754867cf diff --git a/lib/damask/config/material.py b/lib/damask/config/material.py index a56c5d976..b070e986f 100644 --- a/lib/damask/config/material.py +++ b/lib/damask/config/material.py @@ -267,3 +267,14 @@ class Material(): if newlen is not oldlen: print('Length of value was changed from %i to %i!'%(oldlen,newlen)) + def add_value(self, part=None, + section=None, + key=None, + value=None): + if not isinstance(value,list): + if not isinstance(value,str): + value = '%s'%value + value = [value] + print('adding %s:%s:%s with value %s '%(part.lower(),section.lower(),key.lower(),value)) + self.data[part.lower()][section.lower()][key.lower()] = value + self.data[part.lower()][section.lower()]['__order__'] += [key.lower()] From 6cd08a38b17c7e660fd4aeec24ed4a7796d3ba7d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 25 Jun 2018 14:06:13 +0200 Subject: [PATCH 25/79] pre-defined variables seem to work for gfortran --- src/plastic_phenopowerlaw.f90 | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index d888e6c09..fe79f9ae8 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -149,6 +149,7 @@ subroutine plastic_phenopowerlaw_init integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] + character(len=65536), dimension(0), parameter :: emptyString = [character(len=65536)::] type(tParameters), pointer :: prm @@ -189,7 +190,7 @@ subroutine plastic_phenopowerlaw_init prm%H_int = phaseConfig(phase)%getFloats('h_int',& defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) prm%nonSchmidCoeff = phaseConfig(phase)%getFloats('nonschmid_coefficients',& - defaultVal = [real(pReal)::1] ) + defaultVal = emptyReal ) prm%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') prm%n_slip = phaseConfig(phase)%getFloat('n_slip') @@ -228,13 +229,7 @@ subroutine plastic_phenopowerlaw_init prm%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) prm%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) -#if defined(__GFORTRAN__) - outputs = ['GfortranBug86277'] - outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=outputs) - if (outputs(1) == 'GfortranBug86277') outputs = [character(len=65536)::] -#else - outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=[character(len=65536)::]) -#endif + outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=emptyString) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID @@ -615,8 +610,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) lattice_maxNtwinFamily, & lattice_NslipSystem, & lattice_NtwinSystem, & - lattice_shearTwin, & - lattice_NnonSchmid + lattice_shearTwin use material, only: & material_phase, & phaseAt, phasememberAt, & @@ -686,7 +680,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ! Calculation of dot gamma tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) + nonSchmidSystems: do k = 1,size(param(instance)%nonSchmidCoeff) tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) tau_slip_neg = tau_slip_neg +param(instance)%nonSchmidCoeff(k)* & From a8c69dfcadcbe3aa433364b011251e9c8f68dbb1 Mon Sep 17 00:00:00 2001 From: Jaeyong Jung Date: Tue, 26 Jun 2018 16:09:37 +0200 Subject: [PATCH 26/79] commit spectral_interface --- src/spectral_interface.f90 | 165 ++++--------------------------------- 1 file changed, 15 insertions(+), 150 deletions(-) mode change 100644 => 100755 src/spectral_interface.f90 diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 old mode 100644 new mode 100755 index 9b1808e0f..41d62a3a9 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -195,17 +195,9 @@ subroutine DAMASK_interface_init() call quit(1_pInt) endif -! workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg),trim(geometryArg))) -! geometryFile = getGeometryFile(geometryArg) -! loadCaseFile = getLoadCaseFile(loadCaseArg) - - workingDirectory = trim(storeWorkingDirectory2(trim(workingDirArg),trim(geometryArg))) - geometryFile = getGeometryFile2(geometryArg,workingDirectory) - loadCaseFile = getLoadCaseFile2(loadCaseArg,workingDirectory) - - -! write(*,*) trim(workingDirectory) -! write(*,*) trim(workingDirectory)//'/' ! put '/' next to workingDirectory + workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg))) + geometryFile = getGeometryFile(geometryArg) + loadCaseFile = getLoadCaseFile(loadCaseArg) call get_environment_variable('USER',userName) error = getHostName(hostName) @@ -224,148 +216,21 @@ subroutine DAMASK_interface_init() write(6,'(a,i6.6)') ' Restart from increment: ', spectralRestartInc write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile - read(*,*) - end subroutine DAMASK_interface_init - !-------------------------------------------------------------------------------------------------- !> @brief extract working directory from given argument or from location of geometry file, !! possibly converting relative arguments to absolut path !> @todo change working directory with call chdir(storeWorkingDirectory)? !-------------------------------------------------------------------------------------------------- -character(len=1024) function storeWorkingDirectory2(workingDirectoryArg,geometryArg) +character(len=1024) function storeWorkingDirectory(workingDirectoryArg) use system_routines, only: & isDirectory, & getCWD implicit none character(len=*), intent(in) :: workingDirectoryArg !< working directory argument - character(len=*), intent(in) :: geometryArg !< geometry argument - character(len=1024) :: cwd - logical :: error - external :: quit - - wdGiven: if (len(workingDirectoryArg)>0) then !< -d is given - absolutePath: if (workingDirectoryArg(1:1) == '/') then !< absolute path is given to workingDirectoryArg - storeWorkingDirectory2 = workingDirectoryArg - else absolutePath !< relative path is given - error = getCWD(cwd) - if (error) call quit(1_pInt) - storeWorkingDirectory2 = trim(cwd)//'/'//workingDirectoryArg !< add relative path to cwd - endif absolutePath - if (storeWorkingDirectory2(len(trim(storeWorkingDirectory2)):len(trim(storeWorkingDirectory2))) /= '/') & - storeWorkingDirectory2 = trim(storeWorkingDirectory2)//'/' ! if path seperator is not given, append it - else wdGiven !< -d is not given - error = getCWD(cwd) - if (error) call quit(1_pInt) - storeWorkingDirectory2 = trim(cwd)//'/' - -! if (geometryArg(1:1) == '/') then ! absolute path given as command line argument -! storeWorkingDirectory2 = geometryArg(1:scan(geometryArg,'/',back=.true.)) -! else -! error = getCWD(cwd) ! relative path given as command line argument -! if (error) call quit(1_pInt) -! storeWorkingDirectory2 = trim(cwd)//'/'//geometryArg(1:scan(geometryArg,'/',back=.true.)) !< workingDirectory should not depend on geometryArg -! endif - endif wdGiven - - storeWorkingDirectory2 = trim(rectifyPath(storeWorkingDirectory2)) - if(.not. isDirectory(trim(storeWorkingDirectory2))) then ! check if the directory exists - write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory2),'" does not exist' - call quit(1_pInt) - endif - -end function storeWorkingDirectory2 - - - -!-------------------------------------------------------------------------------------------------- -!> @brief basename of geometry file with extension from command line arguments -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getGeometryFile2(geometryParameter,workingDirectory) - use system_routines, only: & - getCWD - - implicit none - character(len=1024), intent(in) :: & - geometryParameter - character(len=*), intent(in) :: workingDirectory !< working directory -! character(len=1024) :: & -! cwd - integer :: posExt, posSep - logical :: error - external :: quit - - getGeometryFile2 = geometryParameter - posExt = scan(getGeometryFile2,'.',back=.true.) - posSep = scan(getGeometryFile2,'/',back=.true.) - - if (posExt <= posSep) getGeometryFile2 = trim(getGeometryFile2)//('.geom') ! no extension present - if (scan(getGeometryFile2,'/') /= 1) then ! relative path given as command line argument -! error = getcwd(cwd) ! no more cwd -! cwd = workingDirectory - if (error) call quit(1_pInt) - getGeometryFile2 = rectifyPath(trim(workingDirectory)//'/'//getGeometryFile2) - else - getGeometryFile2 = rectifyPath(getGeometryFile2) - endif - - getGeometryFile2 = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile2) - -end function getGeometryFile2 - - -!-------------------------------------------------------------------------------------------------- -!> @brief relative path of loadcase from command line arguments -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getLoadCaseFile2(loadCaseParameter,workingDirectory) - use system_routines, only: & - getCWD - - implicit none - character(len=1024), intent(in) :: & - loadCaseParameter - character(len=*), intent(in) :: workingDirectory !< working directory -! character(len=1024) :: & -! cwd - integer :: posExt, posSep - logical :: error - external :: quit - - getLoadCaseFile2 = loadcaseParameter - posExt = scan(getLoadCaseFile2,'.',back=.true.) - posSep = scan(getLoadCaseFile2,'/',back=.true.) - - if (posExt <= posSep) getLoadCaseFile2 = trim(getLoadCaseFile2)//('.load') ! no extension present - if (scan(getLoadCaseFile2,'/') /= 1) then ! relative path given as command line argument -! error = getcwd(cwd) -! cwd = workingDirectory - if (error) call quit(1_pInt) - getLoadCaseFile2 = rectifyPath(trim(workingDirectory)//'/'//getLoadCaseFile2) - else - getLoadCaseFile2 = rectifyPath(getLoadCaseFile2) - endif - - getLoadCaseFile2 = makeRelativePath(getSolverWorkingDirectoryName(), getLoadCaseFile2) - -end function getLoadCaseFile2 - - -!-------------------------------------------------------------------------------------------------- -!> @brief extract working directory from given argument or from location of geometry file, -!! possibly converting relative arguments to absolut path -!> @todo change working directory with call chdir(storeWorkingDirectory)? -!-------------------------------------------------------------------------------------------------- -character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryArg) - use system_routines, only: & - isDirectory, & - getCWD - - implicit none - character(len=*), intent(in) :: workingDirectoryArg !< working directory argument - character(len=*), intent(in) :: geometryArg !< geometry argument character(len=1024) :: cwd logical :: error external :: quit @@ -381,13 +246,9 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= '/') & storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it else wdGiven - if (geometryArg(1:1) == '/') then ! absolute path given as command line argument - storeWorkingDirectory = geometryArg(1:scan(geometryArg,'/',back=.true.)) - else error = getCWD(cwd) ! relative path given as command line argument if (error) call quit(1_pInt) - storeWorkingDirectory = trim(cwd)//'/'//geometryArg(1:scan(geometryArg,'/',back=.true.)) - endif + storeWorkingDirectory = trim(cwd)//'/' endif wdGiven storeWorkingDirectory = trim(rectifyPath(storeWorkingDirectory)) @@ -458,12 +319,15 @@ character(len=1024) function getGeometryFile(geometryParameter) if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present if (scan(getGeometryFile,'/') /= 1) then ! relative path given as command line argument - error = getcwd(cwd) - if (error) call quit(1_pInt) - getGeometryFile = rectifyPath(trim(cwd)//'/'//getGeometryFile) +! error = getcwd(cwd) +! if (error) call quit(1_pInt) +! getGeometryFile = rectifyPath(trim(workingDirectory)//'/'//getGeometryFile) + getGeometryFile = rectifyPath(trim(getSolverWorkingDirectoryName())//trim(getGeometryFile)) else getGeometryFile = rectifyPath(getGeometryFile) endif + write(*,*) 'getsolv.. ', (getSolverWorkingDirectoryName()) + write(*,*) 'getGeometryFile.. ', (getGeometryFile) getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile) @@ -492,9 +356,10 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present if (scan(getLoadCaseFile,'/') /= 1) then ! relative path given as command line argument - error = getcwd(cwd) - if (error) call quit(1_pInt) - getLoadCaseFile = rectifyPath(trim(cwd)//'/'//getLoadCaseFile) +! error = getcwd(cwd) +! if (error) call quit(1_pInt) +! getLoadCaseFile = rectifyPath(trim(workingDirectory)//'/'//getLoadCaseFile) + getLoadCaseFile = rectifyPath(trim(getSolverWorkingDirectoryName())//trim(getLoadCaseFile)) else getLoadCaseFile = rectifyPath(getLoadCaseFile) endif From 96e5175f41a28d81bb836a45a1cf0b168dbb5327 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 21:08:13 +0200 Subject: [PATCH 27/79] updated rename --- src/plastic_phenopowerlaw.f90 | 58 +++++++++++++++++------------------ 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index fe79f9ae8..9e03d8737 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -132,7 +132,7 @@ subroutine plastic_phenopowerlaw_init plasticState use config, only: & MATERIAL_partPhase, & - phaseConfig + config_phase use lattice use numerics,only: & numerics_integrator @@ -181,43 +181,43 @@ subroutine plastic_phenopowerlaw_init instance = phase_plasticityInstance(phase) prm => param(instance) - prm%Nslip = phaseConfig(phase)%getInts('nslip',defaultVal=emptyInt) + prm%Nslip = config_phase(phase)%getInts('nslip',defaultVal=emptyInt) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) if (sum(prm%Nslip) > 0_pInt) then - prm%tau0_slip = phaseConfig(phase)%getFloats('tau0_slip') - prm%tausat_slip = phaseConfig(phase)%getFloats('tausat_slip') - prm%interaction_SlipSlip = phaseConfig(phase)%getFloats('interaction_slipslip') - prm%H_int = phaseConfig(phase)%getFloats('h_int',& + prm%tau0_slip = config_phase(phase)%getFloats('tau0_slip') + prm%tausat_slip = config_phase(phase)%getFloats('tausat_slip') + prm%interaction_SlipSlip = config_phase(phase)%getFloats('interaction_slipslip') + prm%H_int = config_phase(phase)%getFloats('h_int',& defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%nonSchmidCoeff = phaseConfig(phase)%getFloats('nonschmid_coefficients',& + prm%nonSchmidCoeff = config_phase(phase)%getFloats('nonschmid_coefficients',& defaultVal = emptyReal ) - prm%gdot0_slip = phaseConfig(phase)%getFloat('gdot0_slip') - prm%n_slip = phaseConfig(phase)%getFloat('n_slip') - prm%a_slip = phaseConfig(phase)%getFloat('a_slip') - prm%h0_SlipSlip = phaseConfig(phase)%getFloat('h0_slipslip') + prm%gdot0_slip = config_phase(phase)%getFloat('gdot0_slip') + prm%n_slip = config_phase(phase)%getFloat('n_slip') + prm%a_slip = config_phase(phase)%getFloat('a_slip') + prm%h0_SlipSlip = config_phase(phase)%getFloat('h0_slipslip') endif - prm%Ntwin = phaseConfig(phase)%getInts('ntwin', defaultVal=emptyInt) + prm%Ntwin = config_phase(phase)%getInts('ntwin', defaultVal=emptyInt) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) if (sum(prm%Ntwin) > 0_pInt) then - prm%tau0_twin = phaseConfig(phase)%getFloats('tau0_twin') - prm%interaction_TwinTwin = phaseConfig(phase)%getFloats('interaction_twintwin') + prm%tau0_twin = config_phase(phase)%getFloats('tau0_twin') + prm%interaction_TwinTwin = config_phase(phase)%getFloats('interaction_twintwin') - prm%gdot0_twin = phaseConfig(phase)%getFloat('gdot0_twin') - prm%n_twin = phaseConfig(phase)%getFloat('n_twin') - prm%spr = phaseConfig(phase)%getFloat('s_pr') - prm%twinB = phaseConfig(phase)%getFloat('twin_b') - prm%twinC = phaseConfig(phase)%getFloat('twin_c') - prm%twinD = phaseConfig(phase)%getFloat('twin_d') - prm%twinE = phaseConfig(phase)%getFloat('twin_e') - prm%h0_TwinTwin = phaseConfig(phase)%getFloat('h0_twintwin') + prm%gdot0_twin = config_phase(phase)%getFloat('gdot0_twin') + prm%n_twin = config_phase(phase)%getFloat('n_twin') + prm%spr = config_phase(phase)%getFloat('s_pr') + prm%twinB = config_phase(phase)%getFloat('twin_b') + prm%twinC = config_phase(phase)%getFloat('twin_c') + prm%twinD = config_phase(phase)%getFloat('twin_d') + prm%twinE = config_phase(phase)%getFloat('twin_e') + prm%h0_TwinTwin = config_phase(phase)%getFloat('h0_twintwin') endif if (sum(prm%Nslip) > 0_pInt .and. sum(prm%Ntwin) > 0_pInt) then - prm%interaction_SlipTwin = phaseConfig(phase)%getFloats('interaction_sliptwin') - prm%interaction_TwinSlip = phaseConfig(phase)%getFloats('interaction_twinslip') - prm%h0_TwinSlip = phaseConfig(phase)%getFloat('h0_twinslip') + prm%interaction_SlipTwin = config_phase(phase)%getFloats('interaction_sliptwin') + prm%interaction_TwinSlip = config_phase(phase)%getFloats('interaction_twinslip') + prm%h0_TwinSlip = config_phase(phase)%getFloat('h0_twinslip') endif allocate(prm%matrix_SlipSlip(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) @@ -225,11 +225,11 @@ subroutine plastic_phenopowerlaw_init allocate(prm%matrix_TwinSlip(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) allocate(prm%matrix_TwinTwin(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) - prm%aTolResistance = phaseConfig(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) - prm%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - prm%aTolTwinfrac = phaseConfig(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + prm%aTolResistance = config_phase(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) + prm%aTolShear = config_phase(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + prm%aTolTwinfrac = config_phase(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) - outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=emptyString) + outputs = config_phase(phase)%getStrings('(output)',defaultVal=emptyString) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID From 00f34363dc4c3707b22bae24b756f6ab5771fc71 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 27 Jun 2018 09:12:33 +0200 Subject: [PATCH 28/79] adjusted naming convention --- src/plastic_phenopowerlaw.f90 | 192 +++++++++++++++++----------------- 1 file changed, 96 insertions(+), 96 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 9e03d8737..0b7efd472 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -141,15 +141,15 @@ subroutine plastic_phenopowerlaw_init integer(pInt) :: & maxNinstance, & - instance,phase,j,k, f,o, i,& + instance,p,j,k, f,o, i,& NipcMyPhase, outputSize, & offset_slip, index_myFamily, index_otherFamily, & sizeState,sizeDotState, & startIndex, endIndex - integer(pInt), dimension(0), parameter :: emptyInt = [integer(pInt)::] - real(pReal), dimension(0), parameter :: emptyReal = [real(pReal)::] - character(len=65536), dimension(0), parameter :: emptyString = [character(len=65536)::] + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] + real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] type(tParameters), pointer :: prm @@ -176,48 +176,48 @@ subroutine plastic_phenopowerlaw_init allocate(state(maxNinstance)) allocate(dotState(maxNinstance)) - do phase = 1_pInt, size(phase_plasticityInstance) - if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then - instance = phase_plasticityInstance(phase) + do p = 1_pInt, size(phase_plasticityInstance) + if (phase_plasticity(p) == PLASTICITY_PHENOPOWERLAW_ID) then + instance = phase_plasticityInstance(p) prm => param(instance) - prm%Nslip = config_phase(phase)%getInts('nslip',defaultVal=emptyInt) + prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) if (sum(prm%Nslip) > 0_pInt) then - prm%tau0_slip = config_phase(phase)%getFloats('tau0_slip') - prm%tausat_slip = config_phase(phase)%getFloats('tausat_slip') - prm%interaction_SlipSlip = config_phase(phase)%getFloats('interaction_slipslip') - prm%H_int = config_phase(phase)%getFloats('h_int',& + prm%tau0_slip = config_phase(p)%getFloats('tau0_slip') + prm%tausat_slip = config_phase(p)%getFloats('tausat_slip') + prm%interaction_SlipSlip = config_phase(p)%getFloats('interaction_slipslip') + prm%H_int = config_phase(p)%getFloats('h_int',& defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%nonSchmidCoeff = config_phase(phase)%getFloats('nonschmid_coefficients',& - defaultVal = emptyReal ) + prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray ) - prm%gdot0_slip = config_phase(phase)%getFloat('gdot0_slip') - prm%n_slip = config_phase(phase)%getFloat('n_slip') - prm%a_slip = config_phase(phase)%getFloat('a_slip') - prm%h0_SlipSlip = config_phase(phase)%getFloat('h0_slipslip') + prm%gdot0_slip = config_phase(p)%getFloat('gdot0_slip') + prm%n_slip = config_phase(p)%getFloat('n_slip') + prm%a_slip = config_phase(p)%getFloat('a_slip') + prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip') endif - prm%Ntwin = config_phase(phase)%getInts('ntwin', defaultVal=emptyInt) + prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) if (sum(prm%Ntwin) > 0_pInt) then - prm%tau0_twin = config_phase(phase)%getFloats('tau0_twin') - prm%interaction_TwinTwin = config_phase(phase)%getFloats('interaction_twintwin') + prm%tau0_twin = config_phase(p)%getFloats('tau0_twin') + prm%interaction_TwinTwin = config_phase(p)%getFloats('interaction_twintwin') - prm%gdot0_twin = config_phase(phase)%getFloat('gdot0_twin') - prm%n_twin = config_phase(phase)%getFloat('n_twin') - prm%spr = config_phase(phase)%getFloat('s_pr') - prm%twinB = config_phase(phase)%getFloat('twin_b') - prm%twinC = config_phase(phase)%getFloat('twin_c') - prm%twinD = config_phase(phase)%getFloat('twin_d') - prm%twinE = config_phase(phase)%getFloat('twin_e') - prm%h0_TwinTwin = config_phase(phase)%getFloat('h0_twintwin') + prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin') + prm%n_twin = config_phase(p)%getFloat('n_twin') + prm%spr = config_phase(p)%getFloat('s_pr') + prm%twinB = config_phase(p)%getFloat('twin_b') + prm%twinC = config_phase(p)%getFloat('twin_c') + prm%twinD = config_phase(p)%getFloat('twin_d') + prm%twinE = config_phase(p)%getFloat('twin_e') + prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin') endif if (sum(prm%Nslip) > 0_pInt .and. sum(prm%Ntwin) > 0_pInt) then - prm%interaction_SlipTwin = config_phase(phase)%getFloats('interaction_sliptwin') - prm%interaction_TwinSlip = config_phase(phase)%getFloats('interaction_twinslip') - prm%h0_TwinSlip = config_phase(phase)%getFloat('h0_twinslip') + prm%interaction_SlipTwin = config_phase(p)%getFloats('interaction_sliptwin') + prm%interaction_TwinSlip = config_phase(p)%getFloats('interaction_twinslip') + prm%h0_TwinSlip = config_phase(p)%getFloat('h0_twinslip') endif allocate(prm%matrix_SlipSlip(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) @@ -225,11 +225,11 @@ subroutine plastic_phenopowerlaw_init allocate(prm%matrix_TwinSlip(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) allocate(prm%matrix_TwinTwin(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) - prm%aTolResistance = config_phase(phase)%getFloat('atol_resistance',defaultVal=1.0_pReal) - prm%aTolShear = config_phase(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - prm%aTolTwinfrac = config_phase(phase)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal) + prm%aTolShear = config_phase(p)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) - outputs = config_phase(phase)%getStrings('(output)',defaultVal=emptyString) + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID @@ -315,33 +315,33 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase + NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase sizeState = size(['tau_slip ','accshear_slip']) * sum(prm%nslip) & + size(['tau_twin ','accshear_twin']) * sum(prm%ntwin) & + size(['sum(gamma)', 'sum(f) ']) sizeDotState = sizeState - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) - plasticState(phase)%nSlip = sum(prm%Nslip) - plasticState(phase)%nTwin = sum(prm%Ntwin) - allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) - allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + plasticState(p)%sizeState = sizeState + plasticState(p)%sizeDotState = sizeDotState + plasticState(p)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) + plasticState(p)%nSlip = sum(prm%Nslip) + plasticState(p)%nTwin = sum(prm%Ntwin) + allocate(plasticState(p)%aTolState ( sizeState), source=0.0_pReal) + allocate(plasticState(p)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%state ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (0_pInt,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%deltaState (0_pInt,NipcMyPhase), source=0.0_pReal) if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(p)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(p)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) endif if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) !-------------------------------------------------------------------------------------------------- ! calculate hardening matrices @@ -354,9 +354,9 @@ subroutine plastic_phenopowerlaw_init otherSlipSystems: do k = 1_pInt,prm%Nslip(o) prm%matrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & prm%interaction_SlipSlip(lattice_interactionSlipSlip( & - sum(lattice_NslipSystem(1:f-1,phase))+j, & - sum(lattice_NslipSystem(1:o-1,phase))+k, & - phase)) + sum(lattice_NslipSystem(1:f-1,p))+j, & + sum(lattice_NslipSystem(1:o-1,p))+k, & + p)) enddo otherSlipSystems; enddo otherSlipFamilies twinFamilies: do o = 1_pInt,size(prm%Ntwin,1) @@ -364,9 +364,9 @@ subroutine plastic_phenopowerlaw_init twinSystems: do k = 1_pInt,prm%Ntwin(o) prm%matrix_SlipTwin(index_myFamily+j,index_otherFamily+k) = & prm%interaction_SlipTwin(lattice_interactionSlipTwin( & - sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & - phase)) + sum(lattice_NslipSystem(1:f-1_pInt,p))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & + p)) enddo twinSystems; enddo twinFamilies enddo mySlipSystems enddo mySlipFamilies @@ -379,9 +379,9 @@ subroutine plastic_phenopowerlaw_init slipSystems: do k = 1_pInt,prm%Nslip(o) prm%matrix_TwinSlip(index_myFamily+j,index_otherFamily+k) = & prm%interaction_TwinSlip(lattice_interactionTwinSlip( & - sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & - phase)) + sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,p))+k, & + p)) enddo slipSystems; enddo slipFamilies otherTwinFamilies: do o = 1_pInt,size(prm%Ntwin,1) @@ -389,9 +389,9 @@ subroutine plastic_phenopowerlaw_init otherTwinSystems: do k = 1_pInt,prm%Ntwin(o) prm%matrix_TwinTwin(index_myFamily+j,index_otherFamily+k) = & prm%interaction_TwinTwin(lattice_interactionTwinTwin( & - sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & - phase)) + sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & + p)) enddo otherTwinSystems; enddo otherTwinFamilies enddo myTwinSystems enddo myTwinFamilies @@ -399,54 +399,54 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState startIndex = 1_pInt - endIndex = plasticState(phase)%nSlip - state (instance)%s_slip=>plasticState(phase)%state (startIndex:endIndex,:) - dotState(instance)%s_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%state0(startIndex:endIndex,:) = & + endIndex = plasticState(p)%nSlip + state (instance)%s_slip=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%state0(startIndex:endIndex,:) = & spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolResistance + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(phase)%nTwin - state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) - dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%state0(startIndex:endIndex,:) = & + endIndex = endIndex + plasticState(p)%nTwin + state (instance)%s_twin=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%state0(startIndex:endIndex,:) = & spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolResistance + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt - state (instance)%sumGamma=>plasticState(phase)%state (startIndex,:) - dotState(instance)%sumGamma=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear + state (instance)%sumGamma=>plasticState(p)%state (startIndex,:) + dotState(instance)%sumGamma=>plasticState(p)%dotState(startIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear startIndex = endIndex + 1_pInt endIndex = endIndex + 1_pInt - state (instance)%sumF=>plasticState(phase)%state (startIndex,:) - dotState(instance)%sumF=>plasticState(phase)%dotState(startIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac + state (instance)%sumF=>plasticState(p)%state (startIndex,:) + dotState(instance)%sumF=>plasticState(p)%dotState(startIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(phase)%nSlip - state (instance)%accshear_slip=>plasticState(phase)%state (startIndex:endIndex,:) - dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear + endIndex = endIndex + plasticState(p)%nSlip + state (instance)%accshear_slip=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear ! global alias - plasticState(phase)%slipRate =>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%accumulatedSlip =>plasticState(phase)%state(startIndex:endIndex,:) + plasticState(p)%slipRate =>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%accumulatedSlip =>plasticState(p)%state(startIndex:endIndex,:) startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(phase)%nTwin - state (instance)%accshear_twin=>plasticState(phase)%state (startIndex:endIndex,:) - dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) - plasticState(phase)%aTolState(startIndex:endIndex) = prm%aTolShear + endIndex = endIndex + plasticState(p)%nTwin + state (instance)%accshear_twin=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt - plasticState(phase)%slipRate => & - plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + offset_slip = plasticState(p)%nSlip+plasticState(p)%nTwin+2_pInt + plasticState(p)%slipRate => & + plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) + plasticState(p)%accumulatedSlip => & + plasticState(p)%state(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) endif enddo From ddf7584f4d58b5368b462a1f3663209884131d4c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 27 Jun 2018 10:01:36 +0200 Subject: [PATCH 29/79] following ideas implemented by Philip in disloUCLA prm and stt are pointers to instance of parameter and state interaction_xxYY is a matrix, gets shape assigned during calculation totalNslip and totalNslip are defined as derived parameter --- src/plastic_phenopowerlaw.f90 | 634 +++++++++++++++++----------------- 1 file changed, 322 insertions(+), 312 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 0b7efd472..e8e092807 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -32,6 +32,9 @@ module plastic_phenopowerlaw end enum type, private :: tParameters !< container type for internal constitutive parameters + integer(pInt) :: & + totalNslip, & + totalNtwin real(pReal) :: & gdot0_slip, & !< reference shear strain rate for slip gdot0_twin, & !< reference shear strain rate for twin @@ -57,16 +60,12 @@ module plastic_phenopowerlaw tau0_twin, & !< initial critical shear stress for twin tausat_slip, & !< maximum critical shear stress for slip nonSchmidCoeff, & - H_int, & !< per family hardening activity (optional) + H_int !< per family hardening activity (optional) + real(pReal), dimension(:,:), allocatable :: & interaction_SlipSlip, & !< slip resistance from slip activity interaction_SlipTwin, & !< slip resistance from twin activity interaction_TwinSlip, & !< twin resistance from slip activity interaction_TwinTwin !< twin resistance from twin activity - real(pReal), dimension(:,:), allocatable :: & - matrix_SlipSlip, & !< slip resistance from slip activity - matrix_SlipTwin, & !< slip resistance from twin activity - matrix_TwinSlip, & !< twin resistance from slip activity - matrix_TwinTwin !< twin resistance from twin activity integer(kind(undefined_ID)), dimension(:), allocatable :: & outputID !< ID of each post result output @@ -85,7 +84,7 @@ module plastic_phenopowerlaw sumF end type - type(tPhenopowerlawState), allocatable, dimension(:), private :: & + type(tPhenopowerlawState), allocatable, dimension(:), target, private :: & dotState, & state @@ -147,6 +146,8 @@ subroutine plastic_phenopowerlaw_init sizeState,sizeDotState, & startIndex, endIndex + real(pReal), dimension(:,:), allocatable :: temp1, temp2 + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] @@ -177,278 +178,289 @@ subroutine plastic_phenopowerlaw_init allocate(dotState(maxNinstance)) do p = 1_pInt, size(phase_plasticityInstance) - if (phase_plasticity(p) == PLASTICITY_PHENOPOWERLAW_ID) then - instance = phase_plasticityInstance(p) - prm => param(instance) + if (phase_plasticity(p) /= PLASTICITY_PHENOPOWERLAW_ID) cycle + instance = phase_plasticityInstance(p) + prm => param(instance) - prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) - !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - if (sum(prm%Nslip) > 0_pInt) then - prm%tau0_slip = config_phase(p)%getFloats('tau0_slip') - prm%tausat_slip = config_phase(p)%getFloats('tausat_slip') - prm%interaction_SlipSlip = config_phase(p)%getFloats('interaction_slipslip') - prm%H_int = config_phase(p)%getFloats('h_int',& - defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',& - defaultVal = emptyRealArray ) + prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) + if (size(prm%Nslip) > count(lattice_NslipSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') + if (any(lattice_NslipSystem(1:size(prm%Nslip),p)-prm%Nslip < 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') + prm%totalNslip = sum(prm%Nslip) - prm%gdot0_slip = config_phase(p)%getFloat('gdot0_slip') - prm%n_slip = config_phase(p)%getFloat('n_slip') - prm%a_slip = config_phase(p)%getFloat('a_slip') - prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip') - endif + if (prm%totalNslip > 0_pInt) then + prm%tau0_slip = config_phase(p)%getFloats('tau0_slip') + prm%tausat_slip = config_phase(p)%getFloats('tausat_slip') + prm%interaction_SlipSlip = spread(config_phase(p)%getFloats('interaction_slipslip'),2,1) + prm%H_int = config_phase(p)%getFloats('h_int',& + defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray ) - prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) - !if (size > Nchunks_SlipFamilies + 1_pInt) call IO_error(150_pInt,ext_msg=extmsg) - if (sum(prm%Ntwin) > 0_pInt) then - prm%tau0_twin = config_phase(p)%getFloats('tau0_twin') - prm%interaction_TwinTwin = config_phase(p)%getFloats('interaction_twintwin') + prm%gdot0_slip = config_phase(p)%getFloat('gdot0_slip') + prm%n_slip = config_phase(p)%getFloat('n_slip') + prm%a_slip = config_phase(p)%getFloat('a_slip') + prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip') + endif - prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin') - prm%n_twin = config_phase(p)%getFloat('n_twin') - prm%spr = config_phase(p)%getFloat('s_pr') - prm%twinB = config_phase(p)%getFloat('twin_b') - prm%twinC = config_phase(p)%getFloat('twin_c') - prm%twinD = config_phase(p)%getFloat('twin_d') - prm%twinE = config_phase(p)%getFloat('twin_e') - prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin') - endif + prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) + if (size(prm%Ntwin) > count(lattice_NtwinSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Ntwin') + if (any(lattice_NtwinSystem(1:size(prm%Ntwin),p)-prm%Ntwin < 0_pInt)) call IO_error(150_pInt,ext_msg='Ntwin') + prm%totalNtwin = sum(prm%Ntwin) - if (sum(prm%Nslip) > 0_pInt .and. sum(prm%Ntwin) > 0_pInt) then - prm%interaction_SlipTwin = config_phase(p)%getFloats('interaction_sliptwin') - prm%interaction_TwinSlip = config_phase(p)%getFloats('interaction_twinslip') - prm%h0_TwinSlip = config_phase(p)%getFloat('h0_twinslip') - endif + if (prm%totalNtwin > 0_pInt) then + prm%tau0_twin = config_phase(p)%getFloats('tau0_twin') + prm%interaction_TwinTwin = spread(config_phase(p)%getFloats('interaction_twintwin'),2,1) - allocate(prm%matrix_SlipSlip(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) - allocate(prm%matrix_SlipTwin(sum(prm%Nslip),sum(prm%Ntwin)),source =0.0_pReal) - allocate(prm%matrix_TwinSlip(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) - allocate(prm%matrix_TwinTwin(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) + prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin') + prm%n_twin = config_phase(p)%getFloat('n_twin') + prm%spr = config_phase(p)%getFloat('s_pr') + prm%twinB = config_phase(p)%getFloat('twin_b') + prm%twinC = config_phase(p)%getFloat('twin_c') + prm%twinD = config_phase(p)%getFloat('twin_d') + prm%twinE = config_phase(p)%getFloat('twin_e') + prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin') + endif - prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal) - prm%aTolShear = config_phase(p)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then + prm%interaction_SlipTwin = spread(config_phase(p)%getFloats('interaction_sliptwin'),2,1) + prm%interaction_TwinSlip = spread(config_phase(p)%getFloats('interaction_twinslip'),2,1) + prm%h0_TwinSlip = config_phase(p)%getFloat('h0_twinslip') + endif - outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) - allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) - outputID = undefined_ID - select case(outputs(i)) - case ('resistance_slip') - outputID = resistance_slip_ID - outputSize = sum(prm%Nslip) - case ('accumulatedshear_slip') - outputID = accumulatedshear_slip_ID - outputSize = sum(prm%Nslip) - case ('shearrate_slip') - outputID = shearrate_slip_ID - outputSize = sum(prm%Nslip) - case ('resolvedstress_slip') - outputID = resolvedstress_slip_ID - outputSize = sum(prm%Nslip) - case ('resistance_twin') - outputID = resistance_twin_ID - outputSize = sum(prm%Ntwin) - case ('accumulatedshear_twin') - outputID = accumulatedshear_twin_ID - outputSize = sum(prm%Ntwin) - case ('shearrate_twin') - outputID = shearrate_twin_ID - outputSize = sum(prm%Ntwin) - case ('resolvedstress_twin') - outputID = resolvedstress_twin_ID - outputSize = sum(prm%Ntwin) + prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal) + prm%aTolShear = config_phase(p)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) - case ('totalvolfrac_twin') - outputID = totalvolfrac_twin_ID - outputSize = 1_pInt - case ('totalshear') - outputID = totalshear_ID - outputSize = 1_pInt - end select + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + case ('resistance_slip') + outputID = resistance_slip_ID + outputSize = sum(prm%Nslip) + case ('accumulatedshear_slip') + outputID = accumulatedshear_slip_ID + outputSize = sum(prm%Nslip) + case ('shearrate_slip') + outputID = shearrate_slip_ID + outputSize = sum(prm%Nslip) + case ('resolvedstress_slip') + outputID = resolvedstress_slip_ID + outputSize = sum(prm%Nslip) - if (outputID /= undefined_ID) then - plastic_phenopowerlaw_output(i,instance) = outputs(i) - plastic_phenopowerlaw_sizePostResult(i,instance) = outputSize - prm%outputID = [prm%outputID , outputID] - endif + case ('resistance_twin') + outputID = resistance_twin_ID + outputSize = sum(prm%Ntwin) + case ('accumulatedshear_twin') + outputID = accumulatedshear_twin_ID + outputSize = sum(prm%Ntwin) + case ('shearrate_twin') + outputID = shearrate_twin_ID + outputSize = sum(prm%Ntwin) + case ('resolvedstress_twin') + outputID = resolvedstress_twin_ID + outputSize = sum(prm%Ntwin) - end do + case ('totalvolfrac_twin') + outputID = totalvolfrac_twin_ID + outputSize = 1_pInt + case ('totalshear') + outputID = totalshear_ID + outputSize = 1_pInt + end select - extmsg = '' - if (sum(prm%Nslip) > 0_pInt) then - if (size(prm%tau0_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & - ext_msg='shape(tau0_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (size(prm%tausat_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & - ext_msg='shape(tausat_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (size(prm%H_int) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & - ext_msg='shape(H_int) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (outputID /= undefined_ID) then + plastic_phenopowerlaw_output(i,instance) = outputs(i) + plastic_phenopowerlaw_sizePostResult(i,instance) = outputSize + prm%outputID = [prm%outputID , outputID] + endif - if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//"tau0_slip " - if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & - extmsg = trim(extmsg)//"tausat_slip " + end do - if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" gdot0_slip " - if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? - if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? - endif + extmsg = '' + if (sum(prm%Nslip) > 0_pInt) then + if (size(prm%tau0_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(tau0_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (size(prm%tausat_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(tausat_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (size(prm%H_int) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(H_int) ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (sum(prm%Ntwin) > 0_pInt) then - if (size(prm%tau0_twin) /= size(prm%ntwin)) call IO_error(211_pInt,ip=instance,& - ext_msg='shape(tau0_twin) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//"tau0_slip " + if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//"tausat_slip " - if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & - extmsg = trim(extmsg)//"tau0_twin " + if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" gdot0_slip " + if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? + if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? + endif - if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_twin " - if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//"n_twin " ! ToDo: negative values ok? - endif + if (sum(prm%Ntwin) > 0_pInt) then + if (size(prm%tau0_twin) /= size(prm%ntwin)) call IO_error(211_pInt,ip=instance,& + ext_msg='shape(tau0_twin) ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//"aTolresistance " - if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"aTolShear " - if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//"atoltwinfrac " + if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & + extmsg = trim(extmsg)//"tau0_twin " - if (extmsg /= '') call IO_error(211_pInt,ip=instance,& - ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') + if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_twin " + if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//"n_twin " ! ToDo: negative values ok? + endif + + if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//"aTolresistance " + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"aTolShear " + if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//"atoltwinfrac " + + if (extmsg /= '') call IO_error(211_pInt,ip=instance,& + ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase - sizeState = size(['tau_slip ','accshear_slip']) * sum(prm%nslip) & - + size(['tau_twin ','accshear_twin']) * sum(prm%ntwin) & - + size(['sum(gamma)', 'sum(f) ']) + NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase + sizeState = size(['tau_slip ','accshear_slip']) * sum(prm%nslip) & + + size(['tau_twin ','accshear_twin']) * sum(prm%ntwin) & + + size(['sum(gamma)', 'sum(f) ']) - sizeDotState = sizeState - plasticState(p)%sizeState = sizeState - plasticState(p)%sizeDotState = sizeDotState - plasticState(p)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) - plasticState(p)%nSlip = sum(prm%Nslip) - plasticState(p)%nTwin = sum(prm%Ntwin) - allocate(plasticState(p)%aTolState ( sizeState), source=0.0_pReal) - allocate(plasticState(p)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(p)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(p)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(p)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + sizeDotState = sizeState + plasticState(p)%sizeState = sizeState + plasticState(p)%sizeDotState = sizeDotState + plasticState(p)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) + plasticState(p)%nSlip = sum(prm%Nslip) + plasticState(p)%nTwin = sum(prm%Ntwin) + allocate(plasticState(p)%aTolState ( sizeState), source=0.0_pReal) + allocate(plasticState(p)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + + allocate(plasticState(p)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%deltaState (0_pInt,NipcMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(p)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(p)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(p)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(p)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(p)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(p)%deltaState (0_pInt,NipcMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(p)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(p)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(p)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(p)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) !-------------------------------------------------------------------------------------------------- ! calculate hardening matrices - mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) ! >>> interaction slip -- X - index_myFamily = sum(prm%Nslip(1:f-1_pInt)) + allocate(temp1(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) + allocate(temp2(sum(prm%Nslip),sum(prm%Ntwin)),source =0.0_pReal) + mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) ! >>> interaction slip -- X + index_myFamily = sum(prm%Nslip(1:f-1_pInt)) - mySlipSystems: do j = 1_pInt,prm%Nslip(f) - otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) - index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) - otherSlipSystems: do k = 1_pInt,prm%Nslip(o) - prm%matrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_SlipSlip(lattice_interactionSlipSlip( & - sum(lattice_NslipSystem(1:f-1,p))+j, & - sum(lattice_NslipSystem(1:o-1,p))+k, & - p)) - enddo otherSlipSystems; enddo otherSlipFamilies + mySlipSystems: do j = 1_pInt,prm%Nslip(f) + otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + otherSlipSystems: do k = 1_pInt,prm%Nslip(o) + temp1(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_SlipSlip(lattice_interactionSlipSlip( & + sum(lattice_NslipSystem(1:f-1,p))+j, & + sum(lattice_NslipSystem(1:o-1,p))+k, & + p),1) + enddo otherSlipSystems; enddo otherSlipFamilies - twinFamilies: do o = 1_pInt,size(prm%Ntwin,1) - index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) - twinSystems: do k = 1_pInt,prm%Ntwin(o) - prm%matrix_SlipTwin(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_SlipTwin(lattice_interactionSlipTwin( & - sum(lattice_NslipSystem(1:f-1_pInt,p))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & - p)) - enddo twinSystems; enddo twinFamilies - enddo mySlipSystems - enddo mySlipFamilies + twinFamilies: do o = 1_pInt,size(prm%Ntwin,1) + index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) + twinSystems: do k = 1_pInt,prm%Ntwin(o) + temp2(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_SlipTwin(lattice_interactionSlipTwin( & + sum(lattice_NslipSystem(1:f-1_pInt,p))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & + p),1) + enddo twinSystems; enddo twinFamilies + enddo mySlipSystems + enddo mySlipFamilies + prm%interaction_SlipSlip = temp1; deallocate(temp1) + prm%interaction_SlipTwin = temp2; deallocate(temp2) + - myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X - index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) - myTwinSystems: do j = 1_pInt,prm%Ntwin(f) - slipFamilies: do o = 1_pInt,size(prm%Nslip,1) - index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) - slipSystems: do k = 1_pInt,prm%Nslip(o) - prm%matrix_TwinSlip(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_TwinSlip(lattice_interactionTwinSlip( & - sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & - sum(lattice_NslipSystem(1:o-1_pInt,p))+k, & - p)) - enddo slipSystems; enddo slipFamilies + allocate(temp1(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) + allocate(temp2(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) + myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X + index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) + myTwinSystems: do j = 1_pInt,prm%Ntwin(f) + slipFamilies: do o = 1_pInt,size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + slipSystems: do k = 1_pInt,prm%Nslip(o) + temp1(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_TwinSlip(lattice_interactionTwinSlip( & + sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,p))+k, & + p),1) + enddo slipSystems; enddo slipFamilies - otherTwinFamilies: do o = 1_pInt,size(prm%Ntwin,1) - index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) - otherTwinSystems: do k = 1_pInt,prm%Ntwin(o) - prm%matrix_TwinTwin(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_TwinTwin(lattice_interactionTwinTwin( & - sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & - p)) - enddo otherTwinSystems; enddo otherTwinFamilies - enddo myTwinSystems - enddo myTwinFamilies + otherTwinFamilies: do o = 1_pInt,size(prm%Ntwin,1) + index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) + otherTwinSystems: do k = 1_pInt,prm%Ntwin(o) + temp2(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_TwinTwin(lattice_interactionTwinTwin( & + sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & + p),1) + enddo otherTwinSystems; enddo otherTwinFamilies + enddo myTwinSystems + enddo myTwinFamilies + prm%interaction_TwinSlip = temp1; deallocate(temp1) + prm%interaction_TwinTwin = temp2; deallocate(temp2) !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState - startIndex = 1_pInt - endIndex = plasticState(p)%nSlip - state (instance)%s_slip=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%s_slip=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%state0(startIndex:endIndex,:) = & - spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) + startIndex = 1_pInt + endIndex = plasticState(p)%nSlip + state (instance)%s_slip=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%state0(startIndex:endIndex,:) = & + spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance - startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(p)%nTwin - state (instance)%s_twin=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%s_twin=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%state0(startIndex:endIndex,:) = & - spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance + startIndex = endIndex + 1_pInt + endIndex = endIndex + plasticState(p)%nTwin + state (instance)%s_twin=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%state0(startIndex:endIndex,:) = & + spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance - startIndex = endIndex + 1_pInt - endIndex = endIndex + 1_pInt - state (instance)%sumGamma=>plasticState(p)%state (startIndex,:) - dotState(instance)%sumGamma=>plasticState(p)%dotState(startIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear + startIndex = endIndex + 1_pInt + endIndex = endIndex + 1_pInt + state (instance)%sumGamma=>plasticState(p)%state (startIndex,:) + dotState(instance)%sumGamma=>plasticState(p)%dotState(startIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - startIndex = endIndex + 1_pInt - endIndex = endIndex + 1_pInt - state (instance)%sumF=>plasticState(p)%state (startIndex,:) - dotState(instance)%sumF=>plasticState(p)%dotState(startIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac + startIndex = endIndex + 1_pInt + endIndex = endIndex + 1_pInt + state (instance)%sumF=>plasticState(p)%state (startIndex,:) + dotState(instance)%sumF=>plasticState(p)%dotState(startIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac - startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(p)%nSlip - state (instance)%accshear_slip=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - ! global alias - plasticState(p)%slipRate =>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%accumulatedSlip =>plasticState(p)%state(startIndex:endIndex,:) + startIndex = endIndex + 1_pInt + endIndex = endIndex + plasticState(p)%nSlip + state (instance)%accshear_slip=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear + ! global alias + plasticState(p)%slipRate =>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%accumulatedSlip =>plasticState(p)%state(startIndex:endIndex,:) - startIndex = endIndex + 1_pInt - endIndex = endIndex + plasticState(p)%nTwin - state (instance)%accshear_twin=>plasticState(p)%state (startIndex:endIndex,:) - dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear + startIndex = endIndex + 1_pInt + endIndex = endIndex + plasticState(p)%nTwin + state (instance)%accshear_twin=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - offset_slip = plasticState(p)%nSlip+plasticState(p)%nTwin+2_pInt - plasticState(p)%slipRate => & - plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) - plasticState(p)%accumulatedSlip => & - plasticState(p)%state(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) + offset_slip = plasticState(p)%nSlip+plasticState(p)%nTwin+2_pInt + plasticState(p)%slipRate => & + plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) + plasticState(p)%accumulatedSlip => & + plasticState(p)%state(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) - endif enddo @@ -505,11 +517,14 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor real(pReal), dimension(3,3,2) :: & nonSchmid_tensor + type(tParameters), pointer :: prm of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) + prm => param(instance) + Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal dLp_dTstar99 = 0.0_pReal @@ -517,9 +532,9 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, !-------------------------------------------------------------------------------------------------- ! Slip part j = 0_pInt - slipFamilies: do f = 1_pInt,size(param(instance)%Nslip,1) + slipFamilies: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,param(instance)%Nslip(f) + slipSystems: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt ! Calculation of Lp @@ -527,30 +542,30 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, tau_slip_neg = tau_slip_pos nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) - do k = 1,size(param(instance)%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & + do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + param(instance)%nonSchmidCoeff(k)* & + tau_slip_neg = tau_slip_neg + prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + param(instance)%nonSchmidCoeff(k)*& + nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + prm%nonSchmidCoeff(k)*& lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + param(instance)%nonSchmidCoeff(k)*& + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + prm%nonSchmidCoeff(k)*& lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo - gdot_slip_pos = 0.5_pReal*param(instance)%gdot0_slip* & + gdot_slip_pos = 0.5_pReal*prm%gdot0_slip* & ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of))) & - **param(instance)%n_slip)*sign(1.0_pReal,tau_slip_pos) + **prm%n_slip)*sign(1.0_pReal,tau_slip_pos) - gdot_slip_neg = 0.5_pReal*param(instance)%gdot0_slip* & + gdot_slip_neg = 0.5_pReal*prm%gdot0_slip* & ((abs(tau_slip_neg)/(state(instance)%s_slip(j,of))) & - **param(instance)%n_slip)*sign(1.0_pReal,tau_slip_neg) + **prm%n_slip)*sign(1.0_pReal,tau_slip_neg) Lp = Lp + (1.0_pReal-state(instance)%sumF(of))*& ! 1-F (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! Calculation of the tangent of Lp if (dNeq0(gdot_slip_pos)) then - dgdot_dtauslip_pos = gdot_slip_pos*param(instance)%n_slip/tau_slip_pos + dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos 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*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & @@ -558,7 +573,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, endif if (dNeq0(gdot_slip_neg)) then - dgdot_dtauslip_neg = gdot_slip_neg*param(instance)%n_slip/tau_slip_neg + dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg 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*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & @@ -570,22 +585,22 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, !-------------------------------------------------------------------------------------------------- ! Twinning part j = 0_pInt - twinFamilies: do f = 1_pInt,size(param(instance)%Ntwin,1) + twinFamilies: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems: do i = 1_pInt,param(instance)%Ntwin(f) + twinSystems: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt ! Calculation of Lp tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) gdot_twin = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F - param(instance)%gdot0_twin*& + prm%gdot0_twin*& (abs(tau_twin)/state(instance)%s_twin(j,of))**& - param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) ! Calculation of the tangent of Lp if (dNeq0(gdot_twin)) then - dgdot_dtautwin = gdot_twin*param(instance)%n_twin/tau_twin + dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin 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*lattice_Stwin(k,l,index_myFamily+i,ph)* & @@ -628,7 +643,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) integer(pInt) :: & instance,ph, & f,i,j,k, & - index_myFamily, nslip,ntwin,& + index_myFamily, & of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & @@ -639,67 +654,63 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Ntwin) :: & gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin + type(tParameters), pointer :: prm + type(tPhenopowerlawState), pointer :: stt of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) + prm => param(instance) + stt => state(instance) - nSlip= sum(param(instance)%nslip) - nTwin= sum(param(instance)%nTwin) plasticState(ph)%dotState(:,of) = 0.0_pReal !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices - c_SlipSlip = param(instance)%h0_slipslip*& - (1.0_pReal + param(instance)%twinC*state(instance)%sumF(of)**& - param(instance)%twinB) - c_TwinSlip = param(instance)%h0_TwinSlip*& - state(instance)%sumGamma(of)**param(instance)%twinE - c_TwinTwin = param(instance)%h0_TwinTwin*& - state(instance)%sumF(of)**param(instance)%twinD + c_SlipSlip = prm%h0_slipslip*(1.0_pReal + prm%twinC*stt%sumF(of)** prm%twinB) + c_TwinSlip = prm%h0_TwinSlip*stt%sumGamma(of)**prm%twinE + c_TwinTwin = prm%h0_TwinTwin*stt%sumF(of)**prm%twinD !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors and calculate dot gammas - ssat_offset = param(instance)%spr*sqrt(state(instance)%sumF(of)) + ssat_offset = prm%spr*sqrt(stt%sumF(of)) j = 0_pInt - slipFamilies1: do f =1_pInt,size(param(instance)%Nslip,1) + slipFamilies1: do f =1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,param(instance)%Nslip(f) + slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt - left_SlipSlip(j) = 1.0_pReal + param(instance)%H_int(f) ! modified no system-dependent left part + left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part - right_SlipSlip(j) = abs(1.0_pReal-state(instance)%s_slip(j,of) / & - (param(instance)%tausat_slip(f)+ssat_offset)) & - **param(instance)%a_slip& - *sign(1.0_pReal,1.0_pReal-state(instance)%s_slip(j,of) / & - (param(instance)%tausat_slip(f)+ssat_offset)) + right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / & + (prm%tausat_slip(f)+ssat_offset)) & + **prm%a_slip& + *sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / & + (prm%tausat_slip(f)+ssat_offset)) right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- ! Calculation of dot gamma tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,size(param(instance)%nonSchmidCoeff) - tau_slip_pos = tau_slip_pos + param(instance)%nonSchmidCoeff(k)* & + nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg +param(instance)%nonSchmidCoeff(k)* & + tau_slip_neg = tau_slip_neg +prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems - gdot_slip(j) = param(instance)%gdot0_slip*0.5_pReal* & - ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & - *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & - *sign(1.0_pReal,tau_slip_neg)) + gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & + ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & + +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 j = 0_pInt - twinFamilies1: do f = 1_pInt,size(param(instance)%Ntwin,1) + twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,param(instance)%Ntwin(f) + twinSystems1: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt left_TwinSlip(j) = 1.0_pReal ! no system-dependent left part left_TwinTwin(j) = 1.0_pReal ! no system-dependent left part @@ -709,24 +720,24 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! Calculation of dot vol frac tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - gdot_twin(j) = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F - param(instance)%gdot0_twin*& - (abs(tau_twin)/state(instance)%s_twin(j,of))**& - param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + gdot_twin(j) = (1.0_pReal-stt%sumF(of))*& ! 1-F + prm%gdot0_twin*& + (abs(tau_twin)/stt%s_twin(j,of))**& + prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) enddo twinSystems1 enddo twinFamilies1 !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above j = 0_pInt - slipFamilies2: do f = 1_pInt,size(param(instance)%Nslip,1) - slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) + slipFamilies2: do f = 1_pInt,size(prm%Nslip,1) + slipSystems2: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt dotState(instance)%s_slip(j,of) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & - dot_product(param(instance)%matrix_SlipSlip(j,1:nslip), & + dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip), & right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(param(instance)%matrix_SlipTwin(j,1:ntwin), & + dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin), & right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + & abs(gdot_slip(j)) @@ -735,16 +746,16 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) enddo slipFamilies2 j = 0_pInt - twinFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) + twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,param(instance)%Ntwin(f) + twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j c_TwinSlip * left_TwinSlip(j) * & - dot_product(param(instance)%matrix_TwinSlip(j,1:nslip), & + dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip), & right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * left_TwinTwin(j) * & - dot_product(param(instance)%matrix_TwinTwin(j,1:ntwin), & + dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin), & right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (state(instance)%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 dotState(instance)%sumF(of) = dotState(instance)%sumF(of) + & @@ -787,18 +798,17 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) integer(pInt) :: & instance,ph, of, & - nSlip,nTwin, & o,f,i,c,j,k, & index_myFamily real(pReal) :: & tau_slip_pos,tau_slip_neg,tau + type(tParameters), pointer :: prm of = phasememberAt(ipc,ip,el) ph = phaseAt(ipc,ip,el) instance = phase_plasticityInstance(ph) + prm => param(instance) - nSlip= sum(param(instance)%nslip) - nTwin= sum(param(instance)%nTwin) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt @@ -806,12 +816,12 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) outputsLoop: do o = 1_pInt,size(param(instance)%outputID) select case(param(instance)%outputID(o)) case (resistance_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%s_slip(1:nSlip,of) - c = c + nSlip + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = state(instance)%s_slip(1:prm%totalNslip,of) + c = c + prm%totalNslip case (accumulatedshear_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = state(instance)%accshear_slip(1:nSlip,of) - c = c + nSlip + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = state(instance)%accshear_slip(1:prm%totalNslip,of) + c = c + prm%totalNslip case (shearrate_slip_ID) j = 0_pInt @@ -834,7 +844,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 - c = c + nSlip + c = c + prm%totalNslip case (resolvedstress_slip_ID) j = 0_pInt @@ -846,7 +856,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) enddo slipSystems2 enddo slipFamilies2 - c = c + nSlip + c = c + prm%totalNslip case (totalshear_ID) plastic_phenopowerlaw_postResults(c+1_pInt) = & @@ -854,14 +864,14 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + 1_pInt case (resistance_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state(instance)%s_twin(1:nTwin,of) - c = c + nTwin + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & + state(instance)%s_twin(1:prm%totalNtwin,of) + c = c + prm%totalNtwin case (accumulatedshear_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - state(instance)%accshear_twin(1:nTwin,of) - c = c + nTwin + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & + state(instance)%accshear_twin(1:prm%totalNtwin,of) + c = c + prm%totalNtwin case (shearrate_twin_ID) j = 0_pInt twinFamilies1: do f = 1_pInt,size(param(instance)%Ntwin,1) @@ -875,7 +885,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) enddo twinSystems1 enddo twinFamilies1 - c = c + nTwin + c = c + prm%totalNtwin case (resolvedstress_twin_ID) j = 0_pInt @@ -887,7 +897,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) enddo twinSystems2 enddo twinFamilies2 - c = c + nTwin + c = c + prm%totalNtwin case (totalvolfrac_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt) = state(instance)%sumF(of) From 0f05565fd53ede29009b448f54debb27b23ce078 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 27 Jun 2018 10:09:19 +0200 Subject: [PATCH 30/79] don't complicate code with potential enhancements --- src/plastic_phenopowerlaw.f90 | 30 +++++++++--------------------- 1 file changed, 9 insertions(+), 21 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index e8e092807..3eba30606 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -319,8 +319,8 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase - sizeState = size(['tau_slip ','accshear_slip']) * sum(prm%nslip) & - + size(['tau_twin ','accshear_twin']) * sum(prm%ntwin) & + sizeState = size(['tau_slip ','accshear_slip']) * prm%TotalNslip & + + size(['tau_twin ','accshear_twin']) * prm%TotalNtwin & + size(['sum(gamma)', 'sum(f) ']) sizeDotState = sizeState @@ -651,9 +651,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) tau_slip_pos,tau_slip_neg,tau_twin real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Nslip) :: & - gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip + gdot_slip,left_SlipSlip,right_SlipSlip real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Ntwin) :: & - gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin + gdot_twin type(tParameters), pointer :: prm type(tPhenopowerlawState), pointer :: stt @@ -681,13 +681,11 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part - left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / & (prm%tausat_slip(f)+ssat_offset)) & **prm%a_slip& *sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / & (prm%tausat_slip(f)+ssat_offset)) - right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- ! Calculation of dot gamma @@ -712,10 +710,6 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystems1: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt - left_TwinSlip(j) = 1.0_pReal ! no system-dependent left part - left_TwinTwin(j) = 1.0_pReal ! no system-dependent left part - right_SlipTwin(j) = 1.0_pReal ! no system-dependent right part - right_TwinTwin(j) = 1.0_pReal ! no system-dependent right part !-------------------------------------------------------------------------------------------------- ! Calculation of dot vol frac @@ -735,10 +729,8 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) j = j+1_pInt dotState(instance)%s_slip(j,of) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & - dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip), & - right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin), & - right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor + dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + & abs(gdot_slip(j)) dotState(instance)%accshear_slip(j,of) = abs(gdot_slip(j)) @@ -750,13 +742,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt - dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j - c_TwinSlip * left_TwinSlip(j) * & - dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip), & - right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - c_TwinTwin * left_TwinTwin(j) * & - dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin), & - right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor + dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j + c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (state(instance)%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 dotState(instance)%sumF(of) = dotState(instance)%sumF(of) + & gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) From 49126d2f6f378ab3cd0b0c07e004ed8b324ca678 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 27 Jun 2018 10:19:50 +0200 Subject: [PATCH 31/79] further simplified --- src/plastic_phenopowerlaw.f90 | 60 ++++++++++++++++------------------- 1 file changed, 27 insertions(+), 33 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 3eba30606..ee0702215 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -668,9 +668,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices - c_SlipSlip = prm%h0_slipslip*(1.0_pReal + prm%twinC*stt%sumF(of)** prm%twinB) - c_TwinSlip = prm%h0_TwinSlip*stt%sumGamma(of)**prm%twinE - c_TwinTwin = prm%h0_TwinTwin*stt%sumF(of)**prm%twinD + c_SlipSlip = prm%h0_slipslip * (1.0_pReal + prm%twinC*stt%sumF(of)** prm%twinB) + c_TwinSlip = prm%h0_TwinSlip * stt%sumGamma(of)**prm%twinE + c_TwinTwin = prm%h0_TwinTwin * stt%sumF(of)**prm%twinD !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors and calculate dot gammas @@ -723,19 +723,13 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above - j = 0_pInt - slipFamilies2: do f = 1_pInt,size(prm%Nslip,1) - slipSystems2: do i = 1_pInt,prm%Nslip(f) - j = j+1_pInt - dotState(instance)%s_slip(j,of) = & ! evolution of slip resistance j - c_SlipSlip * left_SlipSlip(j) * & - dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor - dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + & - abs(gdot_slip(j)) - dotState(instance)%accshear_slip(j,of) = abs(gdot_slip(j)) - enddo slipSystems2 - enddo slipFamilies2 + do j = 1_pInt,prm%totalNslip + dotState(instance)%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j + dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor + enddo + dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + sum(abs(gdot_slip)) + dotState(instance)%accshear_slip(1:prm%totalNslip,of) = abs(gdot_slip) j = 0_pInt twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) @@ -801,8 +795,8 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt - outputsLoop: do o = 1_pInt,size(param(instance)%outputID) - select case(param(instance)%outputID(o)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) case (resistance_slip_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = state(instance)%s_slip(1:prm%totalNslip,of) c = c + prm%totalNslip @@ -813,22 +807,22 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (shearrate_slip_ID) j = 0_pInt - slipFamilies1: do f = 1_pInt,size(param(instance)%Nslip,1) + slipFamilies1: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,param(instance)%Nslip(f) + slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j + 1_pInt tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos +param(instance)%nonSchmidCoeff(k)* & + tau_slip_pos = tau_slip_pos +prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg +param(instance)%nonSchmidCoeff(k)* & + tau_slip_neg = tau_slip_neg +prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo - plastic_phenopowerlaw_postResults(c+j) = param(instance)%gdot0_slip*0.5_pReal* & - ((abs(tau_slip_pos)/state(instance)%s_slip(j,of))**param(instance)%n_slip & + plastic_phenopowerlaw_postResults(c+j) = prm%gdot0_slip*0.5_pReal* & + ((abs(tau_slip_pos)/state(instance)%s_slip(j,of))**prm%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**param(instance)%n_slip & + +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**prm%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -836,9 +830,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) case (resolvedstress_slip_ID) j = 0_pInt - slipFamilies2: do f = 1_pInt,size(param(instance)%Nslip,1) + slipFamilies2: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems2: do i = 1_pInt,param(instance)%Nslip(f) + slipSystems2: do i = 1_pInt,prm%Nslip(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) @@ -862,24 +856,24 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + prm%totalNtwin case (shearrate_twin_ID) j = 0_pInt - twinFamilies1: do f = 1_pInt,size(param(instance)%Ntwin,1) + twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,param(instance)%Ntwin(f) + twinSystems1: do i = 1_pInt,prm%Ntwin(f) j = j + 1_pInt tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F - param(instance)%gdot0_twin*& + prm%gdot0_twin*& (abs(tau)/state(instance)%s_twin(j,of))**& - param(instance)%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) + prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) enddo twinSystems1 enddo twinFamilies1 c = c + prm%totalNtwin case (resolvedstress_twin_ID) j = 0_pInt - twinFamilies2: do f = 1_pInt,size(param(instance)%Ntwin,1) + twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,param(instance)%Ntwin(f) + twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) From 94d4f271864f16f92017924e145502ddf6c2cfdd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 28 Jun 2018 15:15:48 +0200 Subject: [PATCH 32/79] incorporating changes from master branch of PRIVATE update of sns changed synta --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index d8ab8056d..43db3725c 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit d8ab8056d6245ce42bec8953de9af1d7754867cf +Subproject commit 43db3725cfe635806444a90f7f2c555537bbc801 From 613e976a86a02522d19de0e47fdc58d1f77cc8a5 Mon Sep 17 00:00:00 2001 From: Jaeyong Jung Date: Fri, 29 Jun 2018 15:36:12 +0200 Subject: [PATCH 33/79] the working directory and pathes of load and geometry files are now consistent. --- PRIVATE | 2 +- src/spectral_interface.f90 | 70 +++++++++++++------------------------- 2 files changed, 24 insertions(+), 48 deletions(-) diff --git a/PRIVATE b/PRIVATE index cd02f6c1a..798facf8e 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit cd02f6c1a481491eb4517651516b8311348b4777 +Subproject commit 798facf8e983c26dd635aca6a4b2c0b7ae3568fc diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index 41d62a3a9..88fbd2dae 100755 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -222,7 +222,6 @@ end subroutine DAMASK_interface_init !-------------------------------------------------------------------------------------------------- !> @brief extract working directory from given argument or from location of geometry file, !! possibly converting relative arguments to absolut path -!> @todo change working directory with call chdir(storeWorkingDirectory)? !-------------------------------------------------------------------------------------------------- character(len=1024) function storeWorkingDirectory(workingDirectoryArg) use system_routines, only: & @@ -231,7 +230,6 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg) implicit none character(len=*), intent(in) :: workingDirectoryArg !< working directory argument - character(len=1024) :: cwd logical :: error external :: quit @@ -239,16 +237,13 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg) absolutePath: if (workingDirectoryArg(1:1) == '/') then storeWorkingDirectory = workingDirectoryArg else absolutePath - error = getCWD(cwd) + error = getCWD(storeWorkingDirectory) if (error) call quit(1_pInt) - storeWorkingDirectory = trim(cwd)//'/'//workingDirectoryArg + storeWorkingDirectory = trim(storeWorkingDirectory)//'/'//workingDirectoryArg endif absolutePath - if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= '/') & - storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it else wdGiven - error = getCWD(cwd) ! relative path given as command line argument - if (error) call quit(1_pInt) - storeWorkingDirectory = trim(cwd)//'/' + error = getCWD(storeWorkingDirectory) ! relative path given as command line argument + if (error) call quit(1_pInt) endif wdGiven storeWorkingDirectory = trim(rectifyPath(storeWorkingDirectory)) @@ -257,6 +252,9 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg) call quit(1_pInt) endif + if (storeWorkingDirectory(len_trim(storeWorkingDirectory):len_trim(storeWorkingDirectory)) /= '/') & + storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it + end function storeWorkingDirectory @@ -301,35 +299,23 @@ end function getSolverJobName !> @brief basename of geometry file with extension from command line arguments !-------------------------------------------------------------------------------------------------- character(len=1024) function getGeometryFile(geometryParameter) - use system_routines, only: & - getCWD implicit none character(len=1024), intent(in) :: & geometryParameter - character(len=1024) :: & - cwd integer :: posExt, posSep - logical :: error external :: quit - getGeometryFile = geometryParameter + getGeometryFile = trim(geometryParameter) posExt = scan(getGeometryFile,'.',back=.true.) posSep = scan(getGeometryFile,'/',back=.true.) - if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present - if (scan(getGeometryFile,'/') /= 1) then ! relative path given as command line argument -! error = getcwd(cwd) -! if (error) call quit(1_pInt) -! getGeometryFile = rectifyPath(trim(workingDirectory)//'/'//getGeometryFile) - getGeometryFile = rectifyPath(trim(getSolverWorkingDirectoryName())//trim(getGeometryFile)) - else - getGeometryFile = rectifyPath(getGeometryFile) - endif - write(*,*) 'getsolv.. ', (getSolverWorkingDirectoryName()) - write(*,*) 'getGeometryFile.. ', (getGeometryFile) + if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') + if (scan(getGeometryFile,'/') /= 1) & + getGeometryFile = trim(getSolverWorkingDirectoryName())//trim(getGeometryFile) + + getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), rectifyPath(getGeometryFile)) - getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile) end function getGeometryFile @@ -338,39 +324,29 @@ end function getGeometryFile !> @brief relative path of loadcase from command line arguments !-------------------------------------------------------------------------------------------------- character(len=1024) function getLoadCaseFile(loadCaseParameter) - use system_routines, only: & - getCWD implicit none character(len=1024), intent(in) :: & loadCaseParameter - character(len=1024) :: & - cwd integer :: posExt, posSep - logical :: error external :: quit - getLoadCaseFile = loadcaseParameter + getLoadCaseFile = trim(loadCaseParameter) posExt = scan(getLoadCaseFile,'.',back=.true.) posSep = scan(getLoadCaseFile,'/',back=.true.) - if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present - if (scan(getLoadCaseFile,'/') /= 1) then ! relative path given as command line argument -! error = getcwd(cwd) -! if (error) call quit(1_pInt) -! getLoadCaseFile = rectifyPath(trim(workingDirectory)//'/'//getLoadCaseFile) - getLoadCaseFile = rectifyPath(trim(getSolverWorkingDirectoryName())//trim(getLoadCaseFile)) - else - getLoadCaseFile = rectifyPath(getLoadCaseFile) - endif + if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') + if (scan(getLoadCaseFile,'/') /= 1) & + getLoadCaseFile = trim(getSolverWorkingDirectoryName())//trim(getLoadCaseFile) - getLoadCaseFile = makeRelativePath(getSolverWorkingDirectoryName(), getLoadCaseFile) + getLoadCaseFile = makeRelativePath(getSolverWorkingDirectoryName(), rectifyPath(getLoadCaseFile)) end function getLoadCaseFile !-------------------------------------------------------------------------------------------------- -!> @brief remove ../ and /./ from path +!> @brief remove ../ and /./ from path. +!> @details works only if absolute path is given !-------------------------------------------------------------------------------------------------- function rectifyPath(path) @@ -384,14 +360,14 @@ function rectifyPath(path) l = len_trim(path) rectifyPath = path do i = l,3,-1 - if (rectifyPath(i-2:i) == '/'//'.'//'/') & + if (rectifyPath(i-2:i) == '/./') & rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' enddo !-------------------------------------------------------------------------------------------------- ! remove ../ and corresponding directory from rectifyPath l = len_trim(rectifyPath) - i = index(rectifyPath(i:l),'..'//'/') + i = index(rectifyPath(i:l),'../') j = 0 do while (i > j) j = scan(rectifyPath(1:i-2),'/',back=.true.) @@ -401,7 +377,7 @@ function rectifyPath(path) rectifyPath(j+1:k-1) = rectifyPath(j+2:k) rectifyPath(k:k) = ' ' endif - i = j+index(rectifyPath(j+1:l),'..'//'/') + i = j+index(rectifyPath(j+1:l),'../') enddo if(len_trim(rectifyPath) == 0) rectifyPath = '/' From 8c727eb4ff243ef56a25b8e699cbacc4a8802194 Mon Sep 17 00:00:00 2001 From: Yang Su Date: Fri, 29 Jun 2018 18:07:32 -0400 Subject: [PATCH 34/79] removed obsolete second assignment of slipRate and accSlip pointers --- src/plastic_phenopowerlaw.f90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index ee0702215..4f95bf292 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -455,11 +455,6 @@ subroutine plastic_phenopowerlaw_init dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - offset_slip = plasticState(p)%nSlip+plasticState(p)%nTwin+2_pInt - plasticState(p)%slipRate => & - plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) - plasticState(p)%accumulatedSlip => & - plasticState(p)%state(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) enddo From 980e34f7285ffa74d4b3ae5b6ecac03ff495f416 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 30 Jun 2018 13:37:13 +0200 Subject: [PATCH 35/79] state pointer as shortcut, variables not used --- src/plastic_phenopowerlaw.f90 | 45 ++++++++++++++++------------------- 1 file changed, 21 insertions(+), 24 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 4f95bf292..a387bad6d 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -1,3 +1,4 @@ +!-------------------------------------------------------------------------------------------------- !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH @@ -78,7 +79,8 @@ module plastic_phenopowerlaw s_slip, & s_twin, & accshear_slip, & - accshear_twin + accshear_twin, & + whole real(pReal), pointer, dimension(:) :: & sumGamma, & sumF @@ -142,7 +144,7 @@ subroutine plastic_phenopowerlaw_init maxNinstance, & instance,p,j,k, f,o, i,& NipcMyPhase, outputSize, & - offset_slip, index_myFamily, index_otherFamily, & + index_myFamily, index_otherFamily, & sizeState,sizeDotState, & startIndex, endIndex @@ -417,7 +419,6 @@ subroutine plastic_phenopowerlaw_init dotState(instance)%s_slip=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%state0(startIndex:endIndex,:) = & spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance startIndex = endIndex + 1_pInt @@ -454,11 +455,11 @@ subroutine plastic_phenopowerlaw_init state (instance)%accshear_twin=>plasticState(p)%state (startIndex:endIndex,:) dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - + + dotState(instance)%whole =>plasticState(p)%dotState enddo - end subroutine plastic_phenopowerlaw_init @@ -476,12 +477,11 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, lattice_Sslip_v, & lattice_Stwin, & lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & lattice_NslipSystem, & lattice_NtwinSystem use material, only: & - phaseAt, phasememberAt, & + phasememberAt, & + material_phase, & phase_plasticityInstance implicit none @@ -498,7 +498,6 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation integer(pInt) :: & - instance, & index_myFamily, & f,i,j,k,l,m,n, & of, & @@ -512,13 +511,14 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor real(pReal), dimension(3,3,2) :: & nonSchmid_tensor - type(tParameters), pointer :: prm + type(tParameters), pointer :: prm + type(tPhenopowerlawState), pointer :: stt of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) + ph = material_phase(ipc,ip,el) - prm => param(instance) + prm => param(phase_plasticityInstance(ph)) + stt => state(phase_plasticityInstance(ph)) Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal @@ -548,18 +548,16 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo gdot_slip_pos = 0.5_pReal*prm%gdot0_slip* & - ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of))) & - **prm%n_slip)*sign(1.0_pReal,tau_slip_pos) + ((abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_pos) gdot_slip_neg = 0.5_pReal*prm%gdot0_slip* & - ((abs(tau_slip_neg)/(state(instance)%s_slip(j,of))) & - **prm%n_slip)*sign(1.0_pReal,tau_slip_neg) + ((abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_neg) - Lp = Lp + (1.0_pReal-state(instance)%sumF(of))*& ! 1-F + Lp = Lp + (1.0_pReal-stt%sumF(of))*& (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! Calculation of the tangent of Lp - if (dNeq0(gdot_slip_pos)) then + if (dNeq0(gdot_slip_pos)) then !@ Philip: Needed? No division dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos 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) + & @@ -567,7 +565,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, nonSchmid_tensor(m,n,1) endif - if (dNeq0(gdot_slip_neg)) then + if (dNeq0(gdot_slip_neg)) then !@ Philip: Needed? No division dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg 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) + & @@ -587,14 +585,13 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, ! Calculation of Lp tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - gdot_twin = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F - prm%gdot0_twin*& - (abs(tau_twin)/state(instance)%s_twin(j,of))**& + gdot_twin = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin*& + (abs(tau_twin)/stt%s_twin(j,of))**& prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) ! Calculation of the tangent of Lp - if (dNeq0(gdot_twin)) then + if (dNeq0(gdot_twin)) then !@ Philip: Needed? No division dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin 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) + & From c50f32b0d82f419a5de4200e5da26dd41b33278e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 30 Jun 2018 14:11:05 +0200 Subject: [PATCH 36/79] shorthand names improve readability for dotstate and LpAnd... --- src/plastic_phenopowerlaw.f90 | 52 +++++++++++++++-------------------- 1 file changed, 22 insertions(+), 30 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index a387bad6d..858e09564 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -613,15 +613,12 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) use lattice, only: & lattice_Sslip_v, & lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & lattice_NslipSystem, & lattice_NtwinSystem, & lattice_shearTwin use material, only: & material_phase, & - phaseAt, phasememberAt, & - plasticState, & + phasememberAt, & phase_plasticityInstance implicit none @@ -633,7 +630,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) el !< element !< microstructure state integer(pInt) :: & - instance,ph, & + ph, & f,i,j,k, & index_myFamily, & of @@ -642,21 +639,22 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) ssat_offset, & tau_slip_pos,tau_slip_neg,tau_twin - real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Nslip) :: & + real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & gdot_slip,left_SlipSlip,right_SlipSlip - real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%Ntwin) :: & + real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & gdot_twin - type(tParameters), pointer :: prm - type(tPhenopowerlawState), pointer :: stt + + type(tParameters), pointer :: prm + type(tPhenopowerlawState), pointer :: dst,stt of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - prm => param(instance) - stt => state(instance) + ph = material_phase(ipc,ip,el) + prm => param(phase_plasticityInstance(ph)) + stt => state(phase_plasticityInstance(ph)) + dst => dotState(phase_plasticityInstance(ph)) - plasticState(ph)%dotState(:,of) = 0.0_pReal + dst%whole(:,of) = 0.0_pReal !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices @@ -673,11 +671,8 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part - right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / & - (prm%tausat_slip(f)+ssat_offset)) & - **prm%a_slip& - *sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / & - (prm%tausat_slip(f)+ssat_offset)) + right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) **prm%a_slip & + * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) !-------------------------------------------------------------------------------------------------- ! Calculation of dot gamma @@ -695,8 +690,6 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) enddo slipSystems1 enddo slipFamilies1 - - j = 0_pInt twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family @@ -716,31 +709,30 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above do j = 1_pInt,prm%totalNslip - dotState(instance)%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j + dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor enddo - dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + sum(abs(gdot_slip)) - dotState(instance)%accshear_slip(1:prm%totalNslip,of) = abs(gdot_slip) + dst%sumGamma(of) = dst%sumGamma(of) + sum(abs(gdot_slip)) + dst%accshear_slip(1:prm%totalNslip,of) = abs(gdot_slip) j = 0_pInt twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt - dotState(instance)%s_twin(j,of) = & ! evolution of twin resistance j + dst%s_twin(j,of) = & ! evolution of twin resistance j c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor - if (state(instance)%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 - dotState(instance)%sumF(of) = dotState(instance)%sumF(of) + & - gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) - dotState(instance)%accshear_twin(j,of) = abs(gdot_twin(j)) + if (stt%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 + dst%sumF(of) = dst%sumF(of) + gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) + dst%accshear_twin(j,of) = abs(gdot_twin(j)) enddo twinSystems2 enddo twinFamilies2 - end subroutine plastic_phenopowerlaw_dotState + !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- From b1c37996d349a11b6f7cf32cc6515b36771f0cf0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 30 Jun 2018 14:35:58 +0200 Subject: [PATCH 37/79] also using short names for state and dotstate in postResults --- src/plastic_phenopowerlaw.f90 | 39 ++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 858e09564..e7981c6d1 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -740,13 +740,11 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) use material, only: & material_phase, & plasticState, & - phaseAt, phasememberAt, & + phasememberAt, & phase_plasticityInstance use lattice, only: & lattice_Sslip_v, & lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & lattice_NslipSystem, & lattice_NtwinSystem, & lattice_NnonSchmid @@ -763,17 +761,21 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) plastic_phenopowerlaw_postResults integer(pInt) :: & - instance,ph, of, & + ph, of, & o,f,i,c,j,k, & index_myFamily real(pReal) :: & tau_slip_pos,tau_slip_neg,tau - type(tParameters), pointer :: prm + + type(tParameters), pointer :: prm + type(tPhenopowerlawState), pointer :: stt, dst of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - prm => param(instance) + ph = material_phase(ipc,ip,el) + + stt => state(phase_plasticityInstance(ph)) + dst => dotstate(phase_plasticityInstance(ph)) + prm => param(phase_plasticityInstance(ph)) plastic_phenopowerlaw_postResults = 0.0_pReal @@ -782,11 +784,11 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) case (resistance_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = state(instance)%s_slip(1:prm%totalNslip,of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = stt%s_slip(1:prm%totalNslip,of) c = c + prm%totalNslip case (accumulatedshear_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = state(instance)%accshear_slip(1:prm%totalNslip,of) + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1:prm%totalNslip,of) c = c + prm%totalNslip case (shearrate_slip_ID) @@ -804,9 +806,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo plastic_phenopowerlaw_postResults(c+j) = prm%gdot0_slip*0.5_pReal* & - ((abs(tau_slip_pos)/state(instance)%s_slip(j,of))**prm%n_slip & + ((abs(tau_slip_pos)/stt%s_slip(j,of))**prm%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(state(instance)%s_slip(j,of)))**prm%n_slip & + +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 @@ -825,18 +827,17 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + prm%totalNslip case (totalshear_ID) - plastic_phenopowerlaw_postResults(c+1_pInt) = & - state(instance)%sumGamma(of) + plastic_phenopowerlaw_postResults(c+1_pInt) = stt%sumGamma(of) c = c + 1_pInt case (resistance_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & - state(instance)%s_twin(1:prm%totalNtwin,of) + stt%s_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (accumulatedshear_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & - state(instance)%accshear_twin(1:prm%totalNtwin,of) + stt%accshear_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (shearrate_twin_ID) j = 0_pInt @@ -845,9 +846,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) twinSystems1: do i = 1_pInt,prm%Ntwin(f) j = j + 1_pInt tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F + plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-stt%sumF(of))*& ! 1-F prm%gdot0_twin*& - (abs(tau)/state(instance)%s_twin(j,of))**& + (abs(tau)/stt%s_twin(j,of))**& prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) enddo twinSystems1 enddo twinFamilies1 @@ -866,7 +867,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) c = c + prm%totalNtwin case (totalvolfrac_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt) = state(instance)%sumF(of) + plastic_phenopowerlaw_postResults(c+1_pInt) = stt%sumF(of) c = c + 1_pInt end select From 7ca005d237684a378a5973a68353ad5d9df7fe98 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 5 Jul 2018 15:44:25 +0200 Subject: [PATCH 38/79] avoiding division by zero --- src/plastic_phenopowerlaw.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index e7981c6d1..d7be6a44b 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -557,7 +557,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! Calculation of the tangent of Lp - if (dNeq0(gdot_slip_pos)) then !@ Philip: Needed? No division + if (dNeq0(tau_slip_pos)) then dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos 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) + & @@ -565,7 +565,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, nonSchmid_tensor(m,n,1) endif - if (dNeq0(gdot_slip_neg)) then !@ Philip: Needed? No division + if (dNeq0(tau_slip_neg)) then dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg 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) + & From ac7bc4b9ed1a74cb1c4c145b3e4ea22f8bb25f72 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 08:24:45 +0200 Subject: [PATCH 39/79] dont' store the working directory but set it centrally makes life easier, writing and reading always to CWD unless absolute path is given Spectral: using --wd argrument and C code MSC.Marc: using directory of input deck and Intel extension Abaqus: using function and Intel extension --- src/DAMASK_abaqus.f | 59 +++++++++++++++--------------- src/DAMASK_marc.f90 | 73 ++++++++++++++------------------------ src/DAMASK_spectral.f90 | 19 +++++----- src/IO.f90 | 57 ++++++++++------------------- src/debug.f90 | 2 -- src/spectral_interface.f90 | 57 +++++++++++++---------------- 6 files changed, 110 insertions(+), 157 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index e91cbb0bb..e0045a2eb 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -3,38 +3,42 @@ !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Koen Janssens, Paul Scherrer Institut !> @author Arun Prakash, Fraunhofer IWM +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief interfaces DAMASK with Abaqus/Standard !> @details put the included file abaqus_v6.env in either your home or model directory, !> it is a minimum Abaqus environment file containing all changes necessary to use the !> DAMASK subroutine (see Abaqus documentation for more information on the use of abaqus_v6.env) !-------------------------------------------------------------------------------------------------- - -#ifndef INT -#define INT 4 -#endif - -#ifndef FLOAT -#define FLOAT 8 -#endif - #define Abaqus #include "prec.f90" module DAMASK_interface -implicit none -character(len=4), dimension(2), parameter :: INPUTFILEEXTENSION = ['.pes','.inp'] -character(len=4), parameter :: LOGFILEEXTENSION = '.log' + implicit none + private + character(len=4), dimension(2), parameter, public :: INPUTFILEEXTENSION = ['.pes','.inp'] + character(len=4), parameter, public :: LOGFILEEXTENSION = '.log' + + public :: & + DAMASK_interface_init, & + getSolverJobName contains !-------------------------------------------------------------------------------------------------- -!> @brief just reporting +!> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init + use ifport, only: & + CHDIR + + implicit none integer, dimension(8) :: & dateAndTime ! type default integer + integer :: lenOutDir,ierr + character(len=256) :: wd + call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>' write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' @@ -46,26 +50,16 @@ subroutine DAMASK_interface_init dateAndTime(6),':',& dateAndTime(7) write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' + + call getoutdir(wd, lenOutDir) + ierr = CHDIR(wd) + if (ierr /= 0) call quit(0) + #include "compilation_info.f90" end subroutine DAMASK_interface_init -!-------------------------------------------------------------------------------------------------- -!> @brief using Abaqus/Standard function to get working directory name -!-------------------------------------------------------------------------------------------------- -character(1024) function getSolverWorkingDirectoryName() - - implicit none - integer :: lenOutDir - - getSolverWorkingDirectoryName='' - call getoutdir(getSolverWorkingDirectoryName, lenOutDir) - getSolverWorkingDirectoryName=trim(getSolverWorkingDirectoryName)//'/' - -end function getSolverWorkingDirectoryName - - !-------------------------------------------------------------------------------------------------- !> @brief using Abaqus/Standard function to get solver job name !-------------------------------------------------------------------------------------------------- @@ -79,10 +73,17 @@ character(1024) function getSolverJobName() end function getSolverJobName + end module DAMASK_interface -#include "commercialFEM_fileList.f90" + + +#include "commercialFEM_fileList.f90" + +!-------------------------------------------------------------------------------------------------- +!> @brief This is the Abaqus std user subroutine for defining material behavior +!-------------------------------------------------------------------------------------------------- subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,& RPL,DDSDDT,DRPLDE,DRPLDT,STRAN,DSTRAN,& TIME,DTIME,TEMP,DTEMP,PREDEF,DPRED,CMNAME,NDI,NSHR,NTENS,& diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 81465350c..51006de72 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -1,15 +1,3 @@ -#define QUOTE(x) #x -#define PASTE(x,y) x ## y - -#ifndef INT -#define INT 4 -#endif - -#ifndef FLOAT -#define FLOAT 8 -#endif - -#include "prec.f90" !-------------------------------------------------------------------------------------------------- !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH @@ -17,13 +5,12 @@ !> @author W.A. Counts !> @author Denny Tjahjanto, Max-Planck-Institut für Eisenforschung GmbH !> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Material subroutine for MSC.Marc +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Interfaces DAMASK with MSC.Marc !> @details Usage: !> @details - choose material as hypela2 !> @details - set statevariable 2 to index of homogenization !> @details - set statevariable 3 to index of microstructure -!> @details - make sure the file "material.config" exists in the working directory -!> @details - make sure the file "numerics.config" exists in the working directory !> @details - use nonsymmetric option for solver (e.g. direct profile or multifrontal sparse, the latter seems to be faster!) !> @details - in case of ddm (domain decomposition) a SYMMETRIC solver has to be used, i.e uncheck "non-symmetric" !> @details Marc subroutines used: @@ -34,23 +21,36 @@ !> @details - concom: lovl, inc !> @details - creeps: timinc !-------------------------------------------------------------------------------------------------- +#define QUOTE(x) #x +#define PASTE(x,y) x ## y + +#include "prec.f90" + module DAMASK_interface implicit none - character(len=4), parameter :: InputFileExtension = '.dat' - character(len=4), parameter :: LogFileExtension = '.log' + private + character(len=4), parameter, public :: InputFileExtension = '.dat' + character(len=4), parameter, public :: LogFileExtension = '.log' + + public :: & + DAMASK_interface_init, & + getSolverJobName contains - !-------------------------------------------------------------------------------------------------- -!> @brief only output of current version +!> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init + use ifport, only: & + CHDIR implicit none integer, dimension(8) :: & dateAndTime ! type default integer + integer :: ierr + character(len=1024) :: wd call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>' @@ -64,27 +64,14 @@ subroutine DAMASK_interface_init dateAndTime(7) write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' #include "compilation_info.f90" + inquire(5, name=wd) ! determine inputputfile + wd = wd(1:scan(wd,'/',back=.true.)) + ierr = CHDIR(wd) + if (ierr /= 0) call quit(0) end subroutine DAMASK_interface_init -!-------------------------------------------------------------------------------------------------- -!> @brief returns the current workingDir -!-------------------------------------------------------------------------------------------------- -function getSolverWorkingDirectoryName() - - implicit none - character(1024) getSolverWorkingDirectoryName, inputName - character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash - - getSolverWorkingDirectoryName='' - inputName='' - inquire(5, name=inputName) ! determine inputputfile - getSolverWorkingDirectoryName=inputName(1:scan(inputName,pathSep,back=.true.)) - -end function getSolverWorkingDirectoryName - - !-------------------------------------------------------------------------------------------------- !> @brief solver job name (no extension) as combination of geometry and load case name !-------------------------------------------------------------------------------------------------- @@ -109,6 +96,9 @@ end function getSolverJobName end module DAMASK_interface + + + #include "commercialFEM_fileList.f90" !-------------------------------------------------------------------------------------------------- @@ -118,17 +108,6 @@ end module DAMASK_interface !> @details !> @details (2) Use the -> 'Plasticity,3' card(=update+finite+large disp+constant d) !> @details in the parameter section of input deck (updated Lagrangian formulation). -!> @details -!> @details The following operation obtains U (stretch tensor) at t=n+1 : -!> @details -!> @details call scla(un1,0.d0,itel,itel,1) -!> @details do k=1,3 -!> @details do i=1,3 -!> @details do j=1,3 -!> @details un1(i,j)=un1(i,j)+dsqrt(strechn1(k))*eigvn1(i,k)*eigvn1(j,k) -!> @details enddo -!> @details enddo -!> @details enddo !-------------------------------------------------------------------------------------------------- subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, & diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 0d77c57f5..2ed94d06a 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -20,11 +20,12 @@ program DAMASK_spectral pReal, & tol_math_check, & dNeq + use system_routines, only: & + getCWD use DAMASK_interface, only: & DAMASK_interface_init, & loadCaseFile, & geometryFile, & - getSolverWorkingDirectoryName, & getSolverJobName, & appendToOutFile use IO, only: & @@ -133,7 +134,9 @@ program DAMASK_spectral lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written stagIter character(len=6) :: loadcase_string - character(len=1024) :: incInfo !< string parsed to solution with information about current load case + character(len=1024) :: & + incInfo, & !< string parsed to solution with information about current load case + workingDir type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases type(tSolutionState), allocatable, dimension(:) :: solres integer(MPI_OFFSET_KIND) :: fileOffset @@ -381,10 +384,11 @@ program DAMASK_spectral ! write header of output file if (worldrank == 0) then if (.not. appendToOutFile) then ! after restart, append to existing results file - open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& + if (getCWD(workingDir)) call IO_error(106_pInt,ext_msg=trim(workingDir)) + open(newunit=resUnit,file=trim(getSolverJobName())//& '.spectralOut',form='UNFORMATTED',status='REPLACE') write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header - write(resUnit) 'workingdir:', trim(getSolverWorkingDirectoryName()) + write(resUnit) 'workingdir:', trim(workingDir) write(resUnit) 'geometry:', trim(geometryFile) write(resUnit) 'grid:', grid write(resUnit) 'size:', geomSize @@ -397,14 +401,14 @@ program DAMASK_spectral write(resUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc write(resUnit) 'eoh' close(resUnit) ! end of header - open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& + open(newunit=statUnit,file=trim(getSolverJobName())//& '.sta',form='FORMATTED',status='REPLACE') write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) & write(6,'(/,a)') ' header of result and statistics file written out' flush(6) else ! open new files ... - open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& + open(newunit=statUnit,file=trim(getSolverJobName())//& '.sta',form='FORMATTED', position='APPEND', status='OLD') endif endif @@ -415,8 +419,7 @@ program DAMASK_spectral outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND) call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce') - call MPI_file_open(PETSC_COMM_WORLD, & - trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.spectralOut', & + call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', & MPI_MODE_WRONLY + MPI_MODE_APPEND, & MPI_INFO_NULL, & resUnit, & diff --git a/src/IO.f90 b/src/IO.f90 index a7e77f0f4..fd1a36339 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -195,18 +195,14 @@ end subroutine IO_checkAndRewind !> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return !! value !-------------------------------------------------------------------------------------------------- -subroutine IO_open_file(fileUnit,relPath) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName +subroutine IO_open_file(fileUnit,path) implicit none integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: relPath !< relative path from working directory + character(len=*), intent(in) :: path !< relative path from working directory integer(pInt) :: myStat - character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//relPath open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -218,18 +214,14 @@ end subroutine IO_open_file !! directory !> @details Like IO_open_file, but error is handled via return value and not via call to IO_error !-------------------------------------------------------------------------------------------------- -logical function IO_open_file_stat(fileUnit,relPath) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName +logical function IO_open_file_stat(fileUnit,path) implicit none integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: relPath !< relative path from working directory + character(len=*), intent(in) :: path !< relative path from working directory integer(pInt) :: myStat - character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//relPath open(fileUnit,status='old',iostat=myStat,file=path) IO_open_file_stat = (myStat == 0_pInt) @@ -244,7 +236,6 @@ end function IO_open_file_stat !-------------------------------------------------------------------------------------------------- subroutine IO_open_jobFile(fileUnit,ext) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -254,7 +245,7 @@ subroutine IO_open_jobFile(fileUnit,ext) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -269,7 +260,6 @@ end subroutine IO_open_jobFile !-------------------------------------------------------------------------------------------------- logical function IO_open_jobFile_stat(fileUnit,ext) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -279,7 +269,7 @@ logical function IO_open_jobFile_stat(fileUnit,ext) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext open(fileUnit,status='old',iostat=myStat,file=path) IO_open_jobFile_stat = (myStat == 0_pInt) @@ -292,7 +282,6 @@ end function IO_open_JobFile_stat !-------------------------------------------------------------------------------------------------- subroutine IO_open_inputFile(fileUnit,modelName) use DAMASK_interface, only: & - getSolverWorkingDirectoryName,& getSolverJobName, & inputFileExtension @@ -306,23 +295,23 @@ subroutine IO_open_inputFile(fileUnit,modelName) integer(pInt) :: fileType fileType = 1_pInt ! assume .pes - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used + path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used open(fileUnit+1,status='old',iostat=myStat,file=path) if(myStat /= 0_pInt) then ! if .pes does not work / exist; use conventional extension, i.e.".inp" fileType = 2_pInt - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) + path = trim(modelName)//inputFileExtension(fileType) open(fileUnit+1,status='old',iostat=myStat,file=path) endif if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)//'_assembly' + path = trim(modelName)//inputFileExtension(fileType)//'_assembly' open(fileUnit,iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s close(fileUnit+1_pInt) #endif #ifdef Marc4DAMASK - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension + path = trim(modelName)//inputFileExtension open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) #endif @@ -336,7 +325,6 @@ end subroutine IO_open_inputFile !-------------------------------------------------------------------------------------------------- subroutine IO_open_logFile(fileUnit) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName, & LogFileExtension @@ -346,7 +334,7 @@ subroutine IO_open_logFile(fileUnit) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//LogFileExtension + path = trim(getSolverJobName())//LogFileExtension open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -360,7 +348,6 @@ end subroutine IO_open_logFile !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobFile(fileUnit,ext) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -370,7 +357,7 @@ subroutine IO_write_jobFile(fileUnit,ext) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext open(fileUnit,status='replace',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -383,7 +370,6 @@ end subroutine IO_write_jobFile !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -394,7 +380,7 @@ subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='replace',form='unformatted',access='direct', & recl=pReal*recMultiplier,iostat=myStat,file=path) @@ -414,7 +400,6 @@ end subroutine IO_write_jobRealFile !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -425,7 +410,7 @@ subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='replace',form='unformatted',access='direct', & recl=pInt*recMultiplier,iostat=myStat,file=path) @@ -444,8 +429,6 @@ end subroutine IO_write_jobIntFile !! located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: fileUnit !< file unit @@ -456,7 +439,7 @@ subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext + path = trim(modelName)//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='old',form='unformatted',access='direct', & recl=pReal*recMultiplier,iostat=myStat,file=path) @@ -474,8 +457,6 @@ end subroutine IO_read_realFile !! located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: fileUnit !< file unit @@ -486,7 +467,7 @@ subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext + path = trim(modelName)//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='old',form='unformatted',access='direct', & recl=pInt*recMultiplier,iostat=myStat,file=path) @@ -1534,6 +1515,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = '{input} recursion limit reached' case (105_pInt) msg = 'unknown output:' + case (106_pInt) + msg = 'working directory does not exist:' !-------------------------------------------------------------------------------------------------- ! lattice error messages @@ -1905,8 +1888,6 @@ end function IO_verifyFloatValue !> including "include"s !-------------------------------------------------------------------------------------------------- recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: unit1, & @@ -1923,7 +1904,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) chunkPos = IO_stringPos(line) if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then - fname = trim(getSolverWorkingDirectoryName())//trim(line(9+scan(line(9:),'='):)) + fname = trim(line(9+scan(line(9:),'='):)) inquire(file=fname, exist=fexist) if (.not.(fexist)) then !$OMP CRITICAL (write2out) diff --git a/src/debug.f90 b/src/debug.f90 index ea2b659a1..e5079bff2 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -283,8 +283,6 @@ end subroutine debug_reset subroutine debug_info implicit none - character(len=1) :: exceed - !$OMP CRITICAL (write2out) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index 88fbd2dae..b1b536a7c 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -19,14 +19,13 @@ module DAMASK_interface character(len=1024), public, protected :: & geometryFile = '', & !< parameter given for geometry file loadCaseFile = '' !< parameter given for load case file - character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons + character(len=1024), private :: workingDirectory public :: & - getSolverWorkingDirectoryName, & getSolverJobName, & DAMASK_interface_init private :: & - storeWorkingDirectory, & + setWorkingDirectory, & getGeometryFile, & getLoadCaseFile, & rectifyPath, & @@ -195,7 +194,7 @@ subroutine DAMASK_interface_init() call quit(1_pInt) endif - workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg))) + workingDirectory = trim(setWorkingDirectory(trim(workingDirArg))) geometryFile = getGeometryFile(geometryArg) loadCaseFile = getLoadCaseFile(loadCaseArg) @@ -208,7 +207,7 @@ subroutine DAMASK_interface_init() write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg) - write(6,'(a,a)') ' Working directory: ', trim(getSolverWorkingDirectoryName()) + write(6,'(a,a)') ' Working directory: ', trim(workingDirectory) write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) @@ -223,10 +222,11 @@ end subroutine DAMASK_interface_init !> @brief extract working directory from given argument or from location of geometry file, !! possibly converting relative arguments to absolut path !-------------------------------------------------------------------------------------------------- -character(len=1024) function storeWorkingDirectory(workingDirectoryArg) +character(len=1024) function setWorkingDirectory(workingDirectoryArg) use system_routines, only: & isDirectory, & - getCWD + getCWD, & + setCWD implicit none character(len=*), intent(in) :: workingDirectoryArg !< working directory argument @@ -235,39 +235,30 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg) wdGiven: if (len(workingDirectoryArg)>0) then absolutePath: if (workingDirectoryArg(1:1) == '/') then - storeWorkingDirectory = workingDirectoryArg + setWorkingDirectory = workingDirectoryArg else absolutePath - error = getCWD(storeWorkingDirectory) + error = getCWD(setWorkingDirectory) if (error) call quit(1_pInt) - storeWorkingDirectory = trim(storeWorkingDirectory)//'/'//workingDirectoryArg + setWorkingDirectory = trim(setWorkingDirectory)//'/'//workingDirectoryArg endif absolutePath else wdGiven - error = getCWD(storeWorkingDirectory) ! relative path given as command line argument + error = getCWD(setWorkingDirectory) ! relative path given as command line argument if (error) call quit(1_pInt) endif wdGiven - storeWorkingDirectory = trim(rectifyPath(storeWorkingDirectory)) - if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists - write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist' + setWorkingDirectory = trim(rectifyPath(setWorkingDirectory)) + if(.not. isDirectory(trim(setWorkingDirectory))) then ! check if the directory exists + write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist' call quit(1_pInt) endif - if (storeWorkingDirectory(len_trim(storeWorkingDirectory):len_trim(storeWorkingDirectory)) /= '/') & - storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it + if (setWorkingDirectory(len_trim(setWorkingDirectory):len_trim(setWorkingDirectory)) /= '/') & + setWorkingDirectory = trim(setWorkingDirectory)//'/' ! if path seperator is not given, append it + + error = setCWD(setWorkingDirectory(1:len_trim(setWorkingDirectory)-1)) ! path seperator at end causes problems + if (error) call quit(1_pInt) -end function storeWorkingDirectory - - -!-------------------------------------------------------------------------------------------------- -!> @brief simply returns the private string workingDir -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getSolverWorkingDirectoryName() - - implicit none - - getSolverWorkingDirectoryName = workingDirectory - -end function getSolverWorkingDirectoryName +end function setWorkingDirectory !-------------------------------------------------------------------------------------------------- @@ -312,9 +303,9 @@ character(len=1024) function getGeometryFile(geometryParameter) if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') if (scan(getGeometryFile,'/') /= 1) & - getGeometryFile = trim(getSolverWorkingDirectoryName())//trim(getGeometryFile) + getGeometryFile = trim(workingDirectory)//trim(getGeometryFile) - getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), rectifyPath(getGeometryFile)) + getGeometryFile = makeRelativePath(workingDirectory, rectifyPath(getGeometryFile)) end function getGeometryFile @@ -337,9 +328,9 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') if (scan(getLoadCaseFile,'/') /= 1) & - getLoadCaseFile = trim(getSolverWorkingDirectoryName())//trim(getLoadCaseFile) + getLoadCaseFile = trim(workingDirectory)//trim(getLoadCaseFile) - getLoadCaseFile = makeRelativePath(getSolverWorkingDirectoryName(), rectifyPath(getLoadCaseFile)) + getLoadCaseFile = makeRelativePath(workingDirectory, rectifyPath(getLoadCaseFile)) end function getLoadCaseFile From 70a3db275a8bb3b896ab5967b8bfdda71bad4ccf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 09:53:20 +0200 Subject: [PATCH 40/79] verbose error message --- src/DAMASK_abaqus.f | 5 ++++- src/DAMASK_marc.f90 | 5 ++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index e0045a2eb..69f6fba4b 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -53,7 +53,10 @@ subroutine DAMASK_interface_init call getoutdir(wd, lenOutDir) ierr = CHDIR(wd) - if (ierr /= 0) call quit(0) + if (ierr /= 0) then + write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist' + call quit(1) + endif #include "compilation_info.f90" diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 51006de72..0f3be66d0 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -67,7 +67,10 @@ subroutine DAMASK_interface_init inquire(5, name=wd) ! determine inputputfile wd = wd(1:scan(wd,'/',back=.true.)) ierr = CHDIR(wd) - if (ierr /= 0) call quit(0) + if (ierr /= 0) then + write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist' + call quit(1) + endif end subroutine DAMASK_interface_init From 1336f8f129155e6dbd3279c26790837e7d10634b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 10:23:21 +0200 Subject: [PATCH 41/79] cleanding and simplifying 1) arguments are case sensitive, i.e. -H is NOT -h 2) don't rely on trailing '/' for working dir 3) when adding '/' to working dir, rectify path should take care of '//' --- src/spectral_interface.f90 | 87 +++++++++++++++----------------------- 1 file changed, 33 insertions(+), 54 deletions(-) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index b1b536a7c..c38f32723 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -32,7 +32,6 @@ module DAMASK_interface makeRelativePath, & IIO_stringValue, & IIO_intValue, & - IIO_lc, & IIO_stringPos contains @@ -128,7 +127,7 @@ subroutine DAMASK_interface_init() call get_command(commandLine) chunkPos = IIO_stringPos(commandLine) do i = 1, chunkPos(1) - tag = IIO_lc(IIO_stringValue(commandLine,chunkPos,i)) ! extract key + tag = IIO_stringValue(commandLine,chunkPos,i) ! extract key select case(tag) case ('-h','--help') write(6,'(a)') ' #######################################################################' @@ -224,7 +223,6 @@ end subroutine DAMASK_interface_init !-------------------------------------------------------------------------------------------------- character(len=1024) function setWorkingDirectory(workingDirectoryArg) use system_routines, only: & - isDirectory, & getCWD, & setCWD @@ -247,16 +245,12 @@ character(len=1024) function setWorkingDirectory(workingDirectoryArg) endif wdGiven setWorkingDirectory = trim(rectifyPath(setWorkingDirectory)) - if(.not. isDirectory(trim(setWorkingDirectory))) then ! check if the directory exists - write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist' - call quit(1_pInt) - endif - if (setWorkingDirectory(len_trim(setWorkingDirectory):len_trim(setWorkingDirectory)) /= '/') & - setWorkingDirectory = trim(setWorkingDirectory)//'/' ! if path seperator is not given, append it - - error = setCWD(setWorkingDirectory(1:len_trim(setWorkingDirectory)-1)) ! path seperator at end causes problems - if (error) call quit(1_pInt) + error = setCWD(trim(setWorkingDirectory)) + if(error) then + write(6,'(a20,a,a16)') ' working directory "',trim(setWorkingDirectory),'" does not exist' + call quit(1_pInt) + endif end function setWorkingDirectory @@ -303,9 +297,9 @@ character(len=1024) function getGeometryFile(geometryParameter) if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') if (scan(getGeometryFile,'/') /= 1) & - getGeometryFile = trim(workingDirectory)//trim(getGeometryFile) + getGeometryFile = trim(workingDirectory)//'/'//trim(getGeometryFile) - getGeometryFile = makeRelativePath(workingDirectory, rectifyPath(getGeometryFile)) + getGeometryFile = makeRelativePath(workingDirectory, getGeometryFile) end function getGeometryFile @@ -328,15 +322,15 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') if (scan(getLoadCaseFile,'/') /= 1) & - getLoadCaseFile = trim(workingDirectory)//trim(getLoadCaseFile) + getLoadCaseFile = trim(workingDirectory)//'/'//trim(getLoadCaseFile) - getLoadCaseFile = makeRelativePath(workingDirectory, rectifyPath(getLoadCaseFile)) + getLoadCaseFile = makeRelativePath(workingDirectory, getLoadCaseFile) end function getLoadCaseFile !-------------------------------------------------------------------------------------------------- -!> @brief remove ../ and /./ from path. +!> @brief remove ../, /./, and // from path. !> @details works only if absolute path is given !-------------------------------------------------------------------------------------------------- function rectifyPath(path) @@ -351,8 +345,15 @@ function rectifyPath(path) l = len_trim(path) rectifyPath = path do i = l,3,-1 - if (rectifyPath(i-2:i) == '/./') & - rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' + if (rectifyPath(i-2:i) == '/./') rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' + enddo + +!-------------------------------------------------------------------------------------------------- +! remove // from path + l = len_trim(path) + rectifyPath = path + do i = l,2,-1 + if (rectifyPath(i-1:i) == '//') rectifyPath(i-1:l) = rectifyPath(i:l)//' ' enddo !-------------------------------------------------------------------------------------------------- @@ -381,20 +382,24 @@ end function rectifyPath character(len=1024) function makeRelativePath(a,b) implicit none - character (len=*) :: a,b + character (len=*), intent(in) :: a,b + character (len=1024) :: a_cleaned,b_cleaned integer :: i,posLastCommonSlash,remainingSlashes !no pInt posLastCommonSlash = 0 remainingSlashes = 0 + a_cleaned = rectifyPath(trim(a)//'/') + b_cleaned = rectifyPath(b) - do i = 1, min(1024,len_trim(a),len_trim(b)) - if (a(i:i) /= b(i:i)) exit - if (a(i:i) == '/') posLastCommonSlash = i + do i = 1, min(1024,len_trim(a_cleaned),len_trim(rectifyPath(b_cleaned))) + if (a_cleaned(i:i) /= b_cleaned(i:i)) exit + if (a_cleaned(i:i) == '/') posLastCommonSlash = i enddo - do i = posLastCommonSlash+1,len_trim(a) - if (a(i:i) == '/') remainingSlashes = remainingSlashes + 1 + do i = posLastCommonSlash+1,len_trim(a_cleaned) + if (a_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1 enddo - makeRelativePath = repeat('..'//'/',remainingSlashes)//b(posLastCommonSlash+1:len_trim(b)) + + makeRelativePath = repeat('..'//'/',remainingSlashes)//b_cleaned(posLastCommonSlash+1:len_trim(b_cleaned)) end function makeRelativePath @@ -411,11 +416,8 @@ pure function IIO_stringValue(string,chunkPos,myChunk) character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then - IIO_stringValue = '' - else valuePresent - IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) - endif valuePresent + IIO_stringValue = merge('',string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) + (myChunk > chunkPos(1) .or. myChunk < 1_pInt)) end function IIO_stringValue @@ -442,29 +444,6 @@ integer(pInt) pure function IIO_intValue(string,chunkPos,myChunk) end function IIO_intValue -!-------------------------------------------------------------------------------------------------- -!> @brief taken from IO, check IO_lc for documentation -!-------------------------------------------------------------------------------------------------- -pure function IIO_lc(string) - - implicit none - character(len=*), intent(in) :: string !< string to convert - character(len=len(string)) :: IIO_lc - - character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' - character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - - integer :: i,n ! no pInt (len returns default integer) - - IIO_lc = string - do i=1,len(string) - n = index(UPPER,IIO_lc(i:i)) - if (n/=0) IIO_lc(i:i) = LOWER(n:n) - enddo - -end function IIO_lc - - !-------------------------------------------------------------------------------------------------- !> @brief taken from IO, check IO_stringPos for documentation !-------------------------------------------------------------------------------------------------- From 5fbe43053f23acf2b7bfce32b8970f8311a2aafa Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 10:26:07 +0200 Subject: [PATCH 42/79] more logical names in test --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 114f2bd9c..14b60c558 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 114f2bd9c2025b30c0c6200709bd4b3b0cc1963a +Subproject commit 14b60c558375731e80db8e5fa49cba753f0d0939 From f493a5419be0a2bf64afdfe7216399d18ad7211d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 10:39:24 +0200 Subject: [PATCH 43/79] forgot line continuation --- src/spectral_interface.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index c38f32723..02d4dc0d8 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -416,7 +416,7 @@ pure function IIO_stringValue(string,chunkPos,myChunk) character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - IIO_stringValue = merge('',string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) + IIO_stringValue = merge('',string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)),& (myChunk > chunkPos(1) .or. myChunk < 1_pInt)) end function IIO_stringValue From a4e4a9c4ab25da60011c7db76b7fbac29ac6ed87 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 10 Jul 2018 21:40:01 +0200 Subject: [PATCH 44/79] merge does not work for strings of different length fixed possible out of bounds access --- src/IO.f90 | 6 +----- src/spectral_interface.f90 | 41 +++++++++++++++++++------------------- 2 files changed, 21 insertions(+), 26 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index fd1a36339..807686e86 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -988,11 +988,7 @@ function IO_stringValue(string,chunkPos,myChunk,silent) logical :: warn - if (.not. present(silent)) then - warn = .false. - else - warn = silent - endif + warn = merge(silent,.false.,present(silent)) IO_stringValue = '' valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index 02d4dc0d8..1ab92a178 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -55,9 +55,9 @@ subroutine DAMASK_interface_init() implicit none character(len=1024) :: & commandLine, & !< command line call as string - loadCaseArg ='', & !< -l argument given to DAMASK_spectral.exe - geometryArg ='', & !< -g argument given to DAMASK_spectral.exe - workingDirArg ='', & !< -w argument given to DAMASK_spectral.exe + loadcaseArg = '', & !< -l argument given to DAMASK_spectral.exe + geometryArg = '', & !< -g argument given to DAMASK_spectral.exe + workingDirArg = '', & !< -w argument given to DAMASK_spectral.exe hostName, & !< name of machine on which DAMASK_spectral.exe is execute (might require export HOSTNAME) userName, & !< name of user calling DAMASK_spectral.exe tag @@ -112,7 +112,7 @@ subroutine DAMASK_interface_init() call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' + write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& @@ -126,9 +126,8 @@ subroutine DAMASK_interface_init() call get_command(commandLine) chunkPos = IIO_stringPos(commandLine) - do i = 1, chunkPos(1) - tag = IIO_stringValue(commandLine,chunkPos,i) ! extract key - select case(tag) + do i = 2_pInt, chunkPos(1) + select case(IIO_stringValue(commandLine,chunkPos,i)) ! extract key case ('-h','--help') write(6,'(a)') ' #######################################################################' write(6,'(a)') ' DAMASK_spectral:' @@ -177,18 +176,20 @@ subroutine DAMASK_interface_init() write(6,'(a,/)')' Prints this message and exits' call quit(0_pInt) ! normal Termination case ('-l', '--load', '--loadcase') - loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) + if ( i < chunkPos(1)) loadcaseArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) case ('-g', '--geom', '--geometry') - geometryArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) + if (i < chunkPos(1)) geometryArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory') - workingDirArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) + if (i < chunkPos(1)) workingDirArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) case ('-r', '--rs', '--restart') - spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) - appendToOutFile = .true. + if (i < chunkPos(1)) then + spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) + appendToOutFile = .true. + endif end select enddo - - if (len(trim(loadcaseArg)) == 0 .or. len(trim(geometryArg)) == 0) then + + if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0) then write(6,'(a)') ' Please specify geometry AND load case (-h for help)' call quit(1_pInt) endif @@ -410,14 +411,12 @@ end function makeRelativePath pure function IIO_stringValue(string,chunkPos,myChunk) implicit none - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - character(len=1+chunkPos(myChunk*2+1)-chunkPos(myChunk*2)) :: IIO_stringValue - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + integer(pInt), intent(in) :: myChunk !< position number of desired chunk + character(len=chunkPos(myChunk*2+1)-chunkPos(myChunk*2)+1) :: IIO_stringValue + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - - IIO_stringValue = merge('',string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)),& - (myChunk > chunkPos(1) .or. myChunk < 1_pInt)) + IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) end function IIO_stringValue From 28414490c818eb696ee5a3d234c9fb587c13ebfc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 11 Jul 2018 05:12:49 +0200 Subject: [PATCH 45/79] following https://packaging.python.org/tutorials/packaging-projects --- lib/damask/__init__.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/damask/__init__.py b/lib/damask/__init__.py index 379b23547..9809ce5b2 100644 --- a/lib/damask/__init__.py +++ b/lib/damask/__init__.py @@ -6,6 +6,8 @@ import os with open(os.path.join(os.path.dirname(__file__),'../../VERSION')) as f: version = f.readline()[:-1] +name = 'damask' + from .environment import Environment # noqa from .asciitable import ASCIItable # noqa From bc5fcf2c1426e63e4d24b7c08f387de72479ec95 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 10:51:42 +0200 Subject: [PATCH 46/79] leftover variable from cleaning --- src/debug.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/debug.f90 b/src/debug.f90 index ea2b659a1..55cc62ca0 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -283,11 +283,8 @@ end subroutine debug_reset subroutine debug_info implicit none - character(len=1) :: exceed - !$OMP CRITICAL (write2out) - debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 & .and. any(debug_stressMinLocation /= 0_pInt) & .and. any(debug_stressMaxLocation /= 0_pInt) ) then From 7f05bf9c0a49d22de2a1f2cafa7a5ccbf905f291 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 11:54:46 +0200 Subject: [PATCH 47/79] leftover variables not needed anymore --- PRIVATE | 2 +- src/crystallite.f90 | 8 +------- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/PRIVATE b/PRIVATE index d1d465808..4d3d6d517 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit d1d46580823d2896059b9514ddc975f9fe5f6b1f +Subproject commit 4d3d6d517171b7c22295896c1c4358238fe6d05d diff --git a/src/crystallite.f90 b/src/crystallite.f90 index aea4fb993..0ee71b5de 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -494,7 +494,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) subStepMinCryst, & subStepSizeCryst, & stepIncreaseCryst, & - nCryst, & numerics_integrator, & numerics_integrationMode, & numerics_timeSyncing @@ -1215,8 +1214,6 @@ end subroutine crystallite_stressAndItsTangent subroutine crystallite_integrateStateRK4() use, intrinsic :: & IEEE_arithmetic - use numerics, only: & - numerics_integrationMode use debug, only: & #ifdef DEBUG debug_e, & @@ -1517,8 +1514,7 @@ subroutine crystallite_integrateStateRKCK45() debug_levelExtensive, & debug_levelSelective use numerics, only: & - rTol_crystalliteState, & - numerics_integrationMode + rTol_crystalliteState use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -2581,7 +2577,6 @@ subroutine crystallite_integrateStateFPI() debug_levelSelective use numerics, only: & nState, & - numerics_integrationMode, & rTol_crystalliteState use FEsolving, only: & FEsolving_execElem, & @@ -3156,7 +3151,6 @@ logical function crystallite_integrateStress(& aTol_crystalliteStress, & rTol_crystalliteStress, & iJacoLpresiduum, & - numerics_integrationMode, & subStepSizeLp, & subStepSizeLi use debug, only: debug_level, & From edcf97ea59204cdde9a35eeb495b4d7bd5b44ffa Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 22:02:31 +0200 Subject: [PATCH 48/79] associate: clearer code and no performance drawbacks --- src/plastic_phenopowerlaw.f90 | 46 ++++++++++++++++------------------- 1 file changed, 21 insertions(+), 25 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index d7be6a44b..f854e7b00 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -61,7 +61,7 @@ module plastic_phenopowerlaw tau0_twin, & !< initial critical shear stress for twin tausat_slip, & !< maximum critical shear stress for slip nonSchmidCoeff, & - H_int !< per family hardening activity (optional) + H_int !< per family hardening activity (optional) real(pReal), dimension(:,:), allocatable :: & interaction_SlipSlip, & !< slip resistance from slip activity interaction_SlipTwin, & !< slip resistance from twin activity @@ -69,10 +69,10 @@ module plastic_phenopowerlaw interaction_TwinTwin !< twin resistance from twin activity integer(kind(undefined_ID)), dimension(:), allocatable :: & - outputID !< ID of each post result output + outputID !< ID of each post result output end type - type(tParameters), dimension(:), allocatable, target, private :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) type, private :: tPhenopowerlawState real(pReal), pointer, dimension(:,:) :: & @@ -154,7 +154,7 @@ subroutine plastic_phenopowerlaw_init real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - type(tParameters), pointer :: prm + type(tParameters) :: prm integer(kind(undefined_ID)) :: & outputID !< ID of each post result output @@ -182,7 +182,7 @@ subroutine plastic_phenopowerlaw_init do p = 1_pInt, size(phase_plasticityInstance) if (phase_plasticity(p) /= PLASTICITY_PHENOPOWERLAW_ID) cycle instance = phase_plasticityInstance(p) - prm => param(instance) + associate(prm => param(instance)) prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) if (size(prm%Nslip) > count(lattice_NslipSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') @@ -457,7 +457,8 @@ subroutine plastic_phenopowerlaw_init plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear dotState(instance)%whole =>plasticState(p)%dotState - + + end associate enddo end subroutine plastic_phenopowerlaw_init @@ -511,14 +512,13 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor real(pReal), dimension(3,3,2) :: & nonSchmid_tensor - type(tParameters), pointer :: prm - type(tPhenopowerlawState), pointer :: stt + type(tParameters) :: prm + type(tPhenopowerlawState) :: stt of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - prm => param(phase_plasticityInstance(ph)) - stt => state(phase_plasticityInstance(ph)) + associate(prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph))) Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal @@ -603,7 +603,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) - + end associate end subroutine plastic_phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- @@ -644,15 +644,13 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & gdot_twin - type(tParameters), pointer :: prm - type(tPhenopowerlawState), pointer :: dst,stt + type(tParameters) :: prm + type(tPhenopowerlawState) :: dst,stt of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - - prm => param(phase_plasticityInstance(ph)) - stt => state(phase_plasticityInstance(ph)) - dst => dotState(phase_plasticityInstance(ph)) + associate( prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph)), dst => & +dotState(phase_plasticityInstance(ph))) dst%whole(:,of) = 0.0_pReal @@ -729,7 +727,7 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) dst%accshear_twin(j,of) = abs(gdot_twin(j)) enddo twinSystems2 enddo twinFamilies2 - + end associate end subroutine plastic_phenopowerlaw_dotState @@ -767,16 +765,14 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) real(pReal) :: & tau_slip_pos,tau_slip_neg,tau - type(tParameters), pointer :: prm - type(tPhenopowerlawState), pointer :: stt, dst + type(tParameters) :: prm + type(tPhenopowerlawState) :: stt, dst of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - stt => state(phase_plasticityInstance(ph)) - dst => dotstate(phase_plasticityInstance(ph)) - prm => param(phase_plasticityInstance(ph)) - + associate( prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph)), dst => & +dotState(phase_plasticityInstance(ph))) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt @@ -872,7 +868,7 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) end select enddo outputsLoop - + end associate end function plastic_phenopowerlaw_postResults end module plastic_phenopowerlaw From e7fd445816807e870aa3affbdb1cfd1f82b97f65 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 20 Jul 2018 14:13:13 +0200 Subject: [PATCH 49/79] WIP: Simplifying using maxval gives inherently correct values and a consistency check is not needed any more using config_phase capabilities to read in lattice related data --- src/lattice.f90 | 468 +++++++++++++++++++----------------------------- 1 file changed, 180 insertions(+), 288 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 386001c76..3064c363e 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -88,11 +88,11 @@ module lattice LATTICE_fcc_NcleavageSystem = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc integer(pInt), parameter, private :: & - LATTICE_fcc_Nslip = 12_pInt, & !sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc - LATTICE_fcc_Ntwin = 12_pInt, & !sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc + LATTICE_fcc_Nslip = sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc + LATTICE_fcc_Ntwin = sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc LATTICE_fcc_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for fcc - LATTICE_fcc_Ntrans = 12_pInt, & !sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc - LATTICE_fcc_Ncleavage = 7_pInt !sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc + LATTICE_fcc_Ntrans = sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc + LATTICE_fcc_Ncleavage = sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc real(pReal), dimension(3+3,LATTICE_fcc_Nslip), parameter, private :: & LATTICE_fcc_systemSlip = reshape(real([& @@ -371,11 +371,11 @@ module lattice LATTICE_bcc_NcleavageSystem = int([3,6,0],pInt) !< # of cleavage systems per family for bcc integer(pInt), parameter, private :: & - LATTICE_bcc_Nslip = 24_pInt, & !sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc - LATTICE_bcc_Ntwin = 12_pInt, & !sum(lattice_bcc_NtwinSystem), & !< total # of twin systems for bcc + LATTICE_bcc_Nslip = sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc + LATTICE_bcc_Ntwin = sum(lattice_bcc_NtwinSystem), & !< total # of twin systems for bcc LATTICE_bcc_NnonSchmid = 6_pInt, & !< total # of non-Schmid contributions for bcc (A. Koester, A. Ma, A. Hartmaier 2012) - LATTICE_bcc_Ntrans = 0_pInt, & !sum(lattice_bcc_NtransSystem), & !< total # of transformation systems for bcc - LATTICE_bcc_Ncleavage = 9_pInt !sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc + LATTICE_bcc_Ntrans = sum(lattice_bcc_NtransSystem), & !< total # of transformation systems for bcc + LATTICE_bcc_Ncleavage = sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc real(pReal), dimension(3+3,LATTICE_bcc_Nslip), parameter, private :: & LATTICE_bcc_systemSlip = reshape(real([& @@ -556,7 +556,7 @@ module lattice !-------------------------------------------------------------------------------------------------- ! hexagonal integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - lattice_hex_NslipSystem = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex + lattice_hex_NslipSystem = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & lattice_hex_NtwinSystem = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex @@ -568,11 +568,11 @@ module lattice LATTICE_hex_NcleavageSystem = int([3,0,0],pInt) !< # of cleavage systems per family for hex integer(pInt), parameter, private :: & - 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_Nslip = sum(lattice_hex_NslipSystem), & !< total # of slip systems for hex + LATTICE_hex_Ntwin = sum(lattice_hex_NtwinSystem), & !< total # of twin systems for hex LATTICE_hex_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for hex - LATTICE_hex_Ntrans = 0_pInt, & !sum(lattice_hex_NtransSystem), & !< total # of transformation systems for hex - LATTICE_hex_Ncleavage = 3_pInt !sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex + LATTICE_hex_Ntrans = sum(lattice_hex_NtransSystem), & !< total # of transformation systems for hex + LATTICE_hex_Ncleavage = sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex real(pReal), dimension(4+4,LATTICE_hex_Nslip), parameter, private :: & LATTICE_hex_systemSlip = reshape(real([& @@ -850,11 +850,11 @@ module lattice LATTICE_bct_NcleavageSystem = int([0,0,0],pInt) !< # of cleavage systems per family for bct integer(pInt), parameter, private :: & - LATTICE_bct_Nslip = 52_pInt, & !sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct - LATTICE_bct_Ntwin = 0_pInt, & !sum(lattice_bct_NtwinSystem), & !< total # of twin systems for bct + LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct + LATTICE_bct_Ntwin = sum(lattice_bct_NtwinSystem), & !< total # of twin systems for bct LATTICE_bct_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for bct - LATTICE_bct_Ntrans = 0_pInt, & !sum(lattice_bct_NtransSystem), & !< total # of transformation systems for bct - LATTICE_bct_Ncleavage = 0_pInt !sum(lattice_bct_NcleavageSystem) !< total # of cleavage systems for bct + LATTICE_bct_Ntrans = sum(lattice_bct_NtransSystem), & !< total # of transformation systems for bct + LATTICE_bct_Ncleavage = sum(lattice_bct_NcleavageSystem) !< total # of cleavage systems for bct real(pReal), dimension(3+3,LATTICE_bct_Nslip), parameter, private :: & LATTICE_bct_systemSlip = reshape(real([& @@ -1039,11 +1039,11 @@ module lattice LATTICE_ortho_NcleavageSystem = int([1,1,1],pInt) !< # of cleavage systems per family for ortho integer(pInt), parameter, private :: & - LATTICE_ortho_Nslip = 0_pInt, & !sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho - LATTICE_ortho_Ntwin = 0_pInt, & !sum(lattice_ortho_NtwinSystem), & !< total # of twin systems for ortho + LATTICE_ortho_Nslip = sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho + LATTICE_ortho_Ntwin = sum(lattice_ortho_NtwinSystem), & !< total # of twin systems for ortho LATTICE_ortho_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for ortho - LATTICE_ortho_Ntrans = 0_pInt, & !sum(lattice_ortho_NtransSystem), & !< total # of transformation systems for ortho - LATTICE_ortho_Ncleavage = 3_pInt !sum(lattice_ortho_NcleavageSystem) !< total # of cleavage systems for ortho + LATTICE_ortho_Ntrans = sum(lattice_ortho_NtransSystem), & !< total # of transformation systems for ortho + LATTICE_ortho_Ncleavage = sum(lattice_ortho_NcleavageSystem) !< total # of cleavage systems for ortho real(pReal), dimension(3+3,LATTICE_ortho_Ncleavage), parameter, private :: & LATTICE_ortho_systemCleavage = reshape(real([& @@ -1054,23 +1054,18 @@ module lattice ],pReal),[ 3_pInt + 3_pInt,LATTICE_ortho_Ncleavage]) integer(pInt), parameter, public :: & - LATTICE_maxNslip = 52_pInt, & - !LATTICE_maxNslip = maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip,\ - ! LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures - LATTICE_maxNtwin = 24_pInt, & - !LATTICE_maxNtwin = maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin,\ - ! LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures - LATTICE_maxNnonSchmid = 6_pInt, & - !LATTICE_maxNtwin = maxval([LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid,\ - ! LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid,\ - ! LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures - LATTICE_maxNtrans = 12_pInt, & - !LATTICE_maxNtrans = maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans,\ - ! LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]),&!< max # of transformation systems over lattice structures - LATTICE_maxNcleavage = 9_pInt, & - !LATTICE_maxNcleavage = maxval([LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage,\ - ! LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage,\ - ! LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]) !< max # of cleavage systems over lattice structures + LATTICE_maxNslip = maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, & + LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures + LATTICE_maxNtwin = maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, & + LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures + LATTICE_maxNnonSchmid = maxval([LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & + LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & + LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures + LATTICE_maxNtrans = maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, & + LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]), & !< max # of transformation systems over lattice structures + LATTICE_maxNcleavage = maxval([LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & + LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, & + LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]) , & !< max # of cleavage systems over lattice structures LATTICE_maxNinteraction = 182_pInt !< max # of interaction types (in hardening matrix part) real(pReal), dimension(:,:,:), allocatable, public, protected :: & @@ -1250,36 +1245,20 @@ subroutine lattice_init compiler_options #endif use IO, only: & - IO_open_file,& - IO_open_jobFile_stat, & - IO_countSections, & IO_error, & - IO_timeStamp, & - IO_EOF, & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue + IO_timeStamp use config, only: & - material_configfile, & - material_localFileExt, & - material_partPhase + config_phase use debug, only: & debug_level, & debug_lattice, & debug_levelBasic implicit none - integer(pInt), parameter :: FILEUNIT = 200_pInt integer(pInt) :: Nphases character(len=65536) :: & - tag = '', & - line = '' - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: section = 0_pInt,i + tag = '' + integer(pInt) :: section = 0_pInt,i,p real(pReal), dimension(:), allocatable :: & CoverA, & !!!!!!< c/a ratio for low symmetry type lattice CoverA_trans, & !< c/a ratio for transformed hex type lattice @@ -1290,56 +1269,6 @@ subroutine lattice_init write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" -!-------------------------------------------------------------------------------------------------- -! consistency checks (required since ifort 15.0 does not support sum/maxval in parameter definition) - - if (LATTICE_maxNslip /= maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip,LATTICE_bct_Nslip])) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNslip') - if (LATTICE_maxNtwin /= maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin])) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNtwin') - if (LATTICE_maxNtrans /= maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans])) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNtrans') - if (LATTICE_maxNnonSchmid /= maxval([lattice_fcc_NnonSchmid,lattice_bcc_NnonSchmid,& - lattice_hex_NnonSchmid])) call IO_error(0_pInt,ext_msg = 'LATTICE_maxNnonSchmid') - - if (LATTICE_fcc_Nslip /= sum(lattice_fcc_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Nslip') - if (LATTICE_bcc_Nslip /= sum(lattice_bcc_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Nslip') - if (LATTICE_hex_Nslip /= sum(lattice_hex_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Nslip') - if (LATTICE_bct_Nslip /= sum(lattice_bct_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Nslip') - - if (LATTICE_fcc_Ntwin /= sum(lattice_fcc_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ntwin') - if (LATTICE_bcc_Ntwin /= sum(lattice_bcc_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ntwin') - if (LATTICE_hex_Ntwin /= sum(lattice_hex_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ntwin') - if (LATTICE_bct_Ntwin /= sum(lattice_bct_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ntwin') - - if (LATTICE_fcc_Ntrans /= sum(lattice_fcc_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ntrans') - if (LATTICE_bcc_Ntrans /= sum(lattice_bcc_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ntrans') - if (LATTICE_hex_Ntrans /= sum(lattice_hex_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ntrans') - if (LATTICE_bct_Ntrans /= sum(lattice_bct_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ntrans') - - if (LATTICE_fcc_Ncleavage /= sum(lattice_fcc_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ncleavage') - if (LATTICE_bcc_Ncleavage /= sum(lattice_bcc_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ncleavage') - if (LATTICE_hex_Ncleavage /= sum(lattice_hex_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ncleavage') - if (LATTICE_bct_Ncleavage /= sum(lattice_bct_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ncleavage') - if (LATTICE_iso_Ncleavage /= sum(lattice_iso_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_iso_Ncleavage') - if (LATTICE_maxNinteraction /= max(& maxval(lattice_fcc_interactionSlipSlip), & maxval(lattice_bcc_interactionSlipSlip), & @@ -1362,18 +1291,7 @@ subroutine lattice_init ! maxval(lattice_bct_interactionTwinTwin))) & call IO_error(0_pInt,ext_msg = 'LATTICE_maxNinteraction') -!-------------------------------------------------------------------------------------------------- -! 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 - Nphases = IO_countSections(FILEUNIT,material_partPhase) - - if(Nphases<1_pInt) & - call IO_error(160_pInt,Nphases, ext_msg='No phases found') - - if (iand(debug_level(debug_lattice),debug_levelBasic) /= 0_pInt) then - write(6,'(a16,1x,i5)') ' # phases:',Nphases - endif + Nphases = size(config_phase) allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID) allocate(trans_lattice_structure(Nphases),source = LATTICE_undefined_ID) @@ -1450,179 +1368,155 @@ subroutine lattice_init allocate(a_fcc(Nphases),source=0.0_pReal) allocate(a_bcc(Nphases),source=0.0_pReal) - rewind(fileUnit) - line = '' ! to have it initialized - section = 0_pInt ! - " - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - endif - if (section > 0_pInt) then - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('lattice_structure') - select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) + do section = 1, size(config_phase) + p = section + tag = config_phase(p)%getString('lattice_structure') + select case(trim(tag)) case('iso','isotropic') - lattice_structure(section) = LATTICE_iso_ID + lattice_structure(p) = LATTICE_iso_ID case('fcc') - lattice_structure(section) = LATTICE_fcc_ID + lattice_structure(p) = LATTICE_fcc_ID case('bcc') - lattice_structure(section) = LATTICE_bcc_ID + lattice_structure(p) = LATTICE_bcc_ID case('hex','hexagonal') - lattice_structure(section) = LATTICE_hex_ID + lattice_structure(p) = LATTICE_hex_ID case('bct') - lattice_structure(section) = LATTICE_bct_ID + lattice_structure(p) = LATTICE_bct_ID case('ort','orthorhombic') - lattice_structure(section) = LATTICE_ort_ID - case default - call IO_error(130_pInt,ext_msg=trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) - end select - case('trans_lattice_structure') - select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) - case('bcc') - trans_lattice_structure(section) = LATTICE_bcc_ID - case('hex','hexagonal','hcp') - trans_lattice_structure(section) = LATTICE_hex_ID - end select - case ('c11') - lattice_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c12') - lattice_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c13') - lattice_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c22') - lattice_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c23') - lattice_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c33') - lattice_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c44') - lattice_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c55') - lattice_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c66') - lattice_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c11_trans') - lattice_trans_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c12_trans') - lattice_trans_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c13_trans') - lattice_trans_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c22_trans') - lattice_trans_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c23_trans') - lattice_trans_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c33_trans') - lattice_trans_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c44_trans') - lattice_trans_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c55_trans') - lattice_trans_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c66_trans') - lattice_trans_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('covera_ratio','c/a_ratio','c/a') - CoverA(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c/a_trans','c/a_martensite','c/a_mart') - CoverA_trans(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('a_fcc') - a_fcc(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('a_bcc') - a_bcc(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_conductivity11') - lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_conductivity22') - lattice_thermalConductivity33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_conductivity33') - lattice_thermalConductivity33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_expansion11') - do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(1,1,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) - enddo - case ('thermal_expansion22') - do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(2,2,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) - enddo - case ('thermal_expansion33') - do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(3,3,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) - enddo - case ('specific_heat') - lattice_specificHeat(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyformationenergy') - lattice_vacancyFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancysurfaceenergy') - lattice_vacancySurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyvolume') - lattice_vacancyVol(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenformationenergy') - lattice_hydrogenFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogensurfaceenergy') - lattice_hydrogenSurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenvolume') - lattice_hydrogenVol(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('mass_density') - lattice_massDensity(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('reference_temperature') - lattice_referenceTemperature(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_diffusion11') - lattice_DamageDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_diffusion22') - lattice_DamageDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_diffusion33') - lattice_DamageDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_mobility') - lattice_DamageMobility(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_diffusion11') - lattice_vacancyfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_diffusion22') - lattice_vacancyfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_diffusion33') - lattice_vacancyfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_mobility11') - lattice_vacancyfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_mobility22') - lattice_vacancyfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_mobility33') - lattice_vacancyfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_diffusion11') - lattice_PorosityDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_diffusion22') - lattice_PorosityDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_diffusion33') - lattice_PorosityDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_mobility') - lattice_PorosityMobility(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_diffusion11') - lattice_hydrogenfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_diffusion22') - lattice_hydrogenfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_diffusion33') - lattice_hydrogenfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_mobility11') - lattice_hydrogenfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_mobility22') - lattice_hydrogenfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_mobility33') - lattice_hydrogenfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancy_eqcv') - lattice_equilibriumVacancyConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogen_eqch') - lattice_equilibriumHydrogenConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) - end select - endif - enddo + lattice_structure(p) = LATTICE_ort_ID +end select +! case('trans_lattice_structure') +! select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) +! case('bcc') +! trans_lattice_structure(section) = LATTICE_bcc_ID +! case('hex','hexagonal') +! trans_lattice_structure(section) = LATTICE_hex_ID +! end select + + + lattice_C66(1,1,section) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) + lattice_C66(1,2,section) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) + lattice_C66(1,3,section) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) + lattice_C66(2,3,section) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) + lattice_C66(3,3,section) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) + lattice_C66(4,4,section) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) + lattice_C66(5,5,section) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) + lattice_C66(6,6,section) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) + +! case ('c11_trans') +! lattice_trans_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c12_trans') +! lattice_trans_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c13_trans') +! lattice_trans_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c22_trans') +! lattice_trans_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c23_trans') +! lattice_trans_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c33_trans') +! lattice_trans_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c44_trans') +! lattice_trans_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c55_trans') +! lattice_trans_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c66_trans') +! lattice_trans_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) +! +! case ('covera_ratio','c/a_ratio','c/a') +! CoverA(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('c/a_trans','c/a_martensite','c/a_mart') +! CoverA_trans(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('a_fcc') +! a_fcc(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('a_bcc') +! a_bcc(section) = IO_floatValue(line,chunkPos,2_pInt) +! +! case ('thermal_conductivity11') +! lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('thermal_conductivity22') +! lattice_thermalConductivity33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('thermal_conductivity33') +! lattice_thermalConductivity33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('thermal_expansion11') +! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) +! lattice_thermalExpansion33(1,1,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) +! enddo +! case ('thermal_expansion22') +! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) +! lattice_thermalExpansion33(2,2,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) +! enddo +! case ('thermal_expansion33') +! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) +! lattice_thermalExpansion33(3,3,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) +! enddo +! case ('specific_heat') +! lattice_specificHeat(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyformationenergy') +! lattice_vacancyFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancysurfaceenergy') +! lattice_vacancySurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyvolume') +! lattice_vacancyVol(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenformationenergy') +! lattice_hydrogenFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogensurfaceenergy') +! lattice_hydrogenSurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenvolume') +! lattice_hydrogenVol(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('mass_density') +! lattice_massDensity(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('reference_temperature') +! lattice_referenceTemperature(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('damage_diffusion11') +! lattice_DamageDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('damage_diffusion22') +! lattice_DamageDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('damage_diffusion33') +! lattice_DamageDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('damage_mobility') +! lattice_DamageMobility(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_diffusion11') +! lattice_vacancyfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_diffusion22') +! lattice_vacancyfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_diffusion33') +! lattice_vacancyfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_mobility11') +! lattice_vacancyfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_mobility22') +! lattice_vacancyfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancyflux_mobility33') +! lattice_vacancyfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('porosity_diffusion11') +! lattice_PorosityDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('porosity_diffusion22') +! lattice_PorosityDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('porosity_diffusion33') +! lattice_PorosityDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('porosity_mobility') +! lattice_PorosityMobility(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_diffusion11') +! lattice_hydrogenfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_diffusion22') +! lattice_hydrogenfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_diffusion33') +! lattice_hydrogenfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_mobility11') +! lattice_hydrogenfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_mobility22') +! lattice_hydrogenfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogenflux_mobility33') +! lattice_hydrogenfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('vacancy_eqcv') +! lattice_equilibriumVacancyConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) +! case ('hydrogen_eqch') +! lattice_equilibriumHydrogenConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) +! end select +! endif +! enddo + + enddo do i = 1_pInt,Nphases if ((CoverA(i) < 1.0_pReal .or. CoverA(i) > 2.0_pReal) & .and. lattice_structure(i) == LATTICE_hex_ID) call IO_error(131_pInt,el=i) ! checking physical significance of c/a @@ -1631,8 +1525,6 @@ subroutine lattice_init call lattice_initializeStructure(i, CoverA(i), CoverA_trans(i), a_fcc(i), a_bcc(i)) enddo - deallocate(CoverA,CoverA_trans,a_fcc,a_bcc) - end subroutine lattice_init From ed97afb51cf14dda17c4d3124fde1aa704fc3440 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 29 Jul 2018 21:03:14 +0200 Subject: [PATCH 50/79] WIP: inherent definition instead of check, using new reading in functionality --- PRIVATE | 2 +- src/lattice.f90 | 294 ++++++++++++++++++++---------------------------- 2 files changed, 121 insertions(+), 175 deletions(-) diff --git a/PRIVATE b/PRIVATE index 55609e107..20881ab8e 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 55609e1079d6ffde6dffdd584ee22a527ff00a34 +Subproject commit 20881ab8ebe6e64bac939ef6b2f8eb5168601a71 diff --git a/src/lattice.f90 b/src/lattice.f90 index 3064c363e..07f230358 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -16,7 +16,7 @@ module lattice integer(pInt), parameter, public :: & LATTICE_maxNslipFamily = 13_pInt, & !< max # of slip system families over lattice structures LATTICE_maxNtwinFamily = 4_pInt, & !< max # of twin system families over lattice structures - LATTICE_maxNtransFamily = 2_pInt, & !< max # of transformation system families over lattice structures + LATTICE_maxNtransFamily = 1_pInt, & !< max # of transformation system families over lattice structures LATTICE_maxNcleavageFamily = 3_pInt !< max # of transformation system families over lattice structures integer(pInt), allocatable, dimension(:,:), protected, public :: & @@ -82,7 +82,7 @@ module lattice LATTICE_fcc_NtwinSystem = int([12, 0, 0, 0],pInt) !< # of twin systems per family for fcc integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_fcc_NtransSystem = int([12, 0],pInt) !< # of transformation systems per family for fcc + LATTICE_fcc_NtransSystem = int([12],pInt) !< # of transformation systems per family for fcc integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & LATTICE_fcc_NcleavageSystem = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc @@ -365,10 +365,10 @@ module lattice LATTICE_bcc_NtwinSystem = int([ 12, 0, 0, 0], pInt) !< # of twin systems per family for bcc integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_bcc_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for bcc + LATTICE_bcc_NtransSystem = int([0],pInt) !< # of transformation systems per family for bcc integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_bcc_NcleavageSystem = int([3,6,0],pInt) !< # of cleavage systems per family for bcc + LATTICE_bcc_NcleavageSystem = int([3, 6, 0],pInt) !< # of cleavage systems per family for bcc integer(pInt), parameter, private :: & LATTICE_bcc_Nslip = sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc @@ -562,10 +562,10 @@ module lattice lattice_hex_NtwinSystem = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_hex_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for hex + LATTICE_hex_NtransSystem = int([0],pInt) !< # of transformation systems per family for hex integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_hex_NcleavageSystem = int([3,0,0],pInt) !< # of cleavage systems per family for hex + LATTICE_hex_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for hex integer(pInt), parameter, private :: & LATTICE_hex_Nslip = sum(lattice_hex_NslipSystem), & !< total # of slip systems for hex @@ -844,10 +844,10 @@ module lattice LATTICE_bct_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for bct integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_bct_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for bct + LATTICE_bct_NtransSystem = int([0],pInt) !< # of transformation systems per family for bct integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_bct_NcleavageSystem = int([0,0,0],pInt) !< # of cleavage systems per family for bct + LATTICE_bct_NcleavageSystem = int([0, 0, 0],pInt) !< # of cleavage systems per family for bct integer(pInt), parameter, private :: & LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct @@ -1004,17 +1004,17 @@ module lattice LATTICE_iso_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for iso integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_iso_NtransSystem = int([0, 0],pInt) !< # of transformation systems per family for iso + LATTICE_iso_NtransSystem = int([0],pInt) !< # of transformation systems per family for iso integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_iso_NcleavageSystem = int([3,0,0],pInt) !< # of cleavage systems per family for iso + LATTICE_iso_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for iso integer(pInt), parameter, private :: & - LATTICE_iso_Nslip = 0_pInt, & !sum(lattice_iso_NslipSystem), & !< total # of slip systems for iso - LATTICE_iso_Ntwin = 0_pInt, & !sum(lattice_iso_NtwinSystem), & !< total # of twin systems for iso + LATTICE_iso_Nslip = sum(lattice_iso_NslipSystem), & !< total # of slip systems for iso + LATTICE_iso_Ntwin = sum(lattice_iso_NtwinSystem), & !< total # of twin systems for iso LATTICE_iso_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for iso - LATTICE_iso_Ntrans = 0_pInt, & !sum(lattice_iso_NtransSystem), & !< total # of transformation systems for iso - LATTICE_iso_Ncleavage = 3_pInt !sum(lattice_iso_NcleavageSystem) !< total # of cleavage systems for iso + LATTICE_iso_Ntrans = sum(lattice_iso_NtransSystem), & !< total # of transformation systems for iso + LATTICE_iso_Ncleavage = sum(lattice_iso_NcleavageSystem) !< total # of cleavage systems for iso real(pReal), dimension(3+3,LATTICE_iso_Ncleavage), parameter, private :: & LATTICE_iso_systemCleavage = reshape(real([& @@ -1033,10 +1033,10 @@ module lattice LATTICE_ortho_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for ortho integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_ortho_NtransSystem = int([0, 0],pInt) !< # of transformation systems per family for ortho + LATTICE_ortho_NtransSystem = int([0],pInt) !< # of transformation systems per family for ortho integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_ortho_NcleavageSystem = int([1,1,1],pInt) !< # of cleavage systems per family for ortho + LATTICE_ortho_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho integer(pInt), parameter, private :: & LATTICE_ortho_Nslip = sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho @@ -1055,18 +1055,38 @@ module lattice integer(pInt), parameter, public :: & LATTICE_maxNslip = maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, & - LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures + LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures LATTICE_maxNtwin = maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, & - LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures + LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures LATTICE_maxNnonSchmid = maxval([LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & - LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures + LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures LATTICE_maxNtrans = maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, & - LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]), & !< max # of transformation systems over lattice structures + LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]), &!< max # of transformation systems over lattice structures LATTICE_maxNcleavage = maxval([LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, & - LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]) , & !< max # of cleavage systems over lattice structures - LATTICE_maxNinteraction = 182_pInt !< max # of interaction types (in hardening matrix part) + LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]), & !< max # of cleavage systems over lattice structures + LATTICE_maxNinteraction = maxval([ & + maxval(lattice_fcc_interactionSlipSlip), & + maxval(lattice_bcc_interactionSlipSlip), & + maxval(lattice_hex_interactionSlipSlip), & + maxval(lattice_bct_interactionSlipSlip), & + ! + maxval(lattice_fcc_interactionSlipTwin), & + maxval(lattice_bcc_interactionSlipTwin), & + maxval(lattice_hex_interactionSlipTwin), & + ! maxval(lattice_bct_interactionSlipTwin), & + ! + maxval(lattice_fcc_interactionTwinSlip), & + maxval(lattice_bcc_interactionTwinSlip), & + maxval(lattice_hex_interactionTwinSlip), & + ! maxval(lattice_bct_interactionTwinSlip), & + ! + maxval(lattice_fcc_interactionTwinTwin), & + maxval(lattice_bcc_interactionTwinTwin), & + maxval(lattice_hex_interactionTwinTwin) & + ! maxval(lattice_bct_interactionTwinTwin))) + ]) !< max # of interaction types (in hardening matrix part) real(pReal), dimension(:,:,:), allocatable, public, protected :: & lattice_C66, lattice_trans_C66 @@ -1249,10 +1269,6 @@ subroutine lattice_init IO_timeStamp use config, only: & config_phase - use debug, only: & - debug_level, & - debug_lattice, & - debug_levelBasic implicit none integer(pInt) :: Nphases @@ -1260,7 +1276,7 @@ subroutine lattice_init tag = '' integer(pInt) :: section = 0_pInt,i,p real(pReal), dimension(:), allocatable :: & - CoverA, & !!!!!!< c/a ratio for low symmetry type lattice + CoverA, & !< c/a ratio for low symmetry type lattice CoverA_trans, & !< c/a ratio for transformed hex type lattice a_fcc, & !< lattice parameter a for fcc austenite a_bcc !< lattice paramater a for bcc martensite @@ -1269,28 +1285,6 @@ subroutine lattice_init write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - if (LATTICE_maxNinteraction /= max(& - maxval(lattice_fcc_interactionSlipSlip), & - maxval(lattice_bcc_interactionSlipSlip), & - maxval(lattice_hex_interactionSlipSlip), & - maxval(lattice_bct_interactionSlipSlip), & - ! - maxval(lattice_fcc_interactionSlipTwin), & - maxval(lattice_bcc_interactionSlipTwin), & - maxval(lattice_hex_interactionSlipTwin), & -! maxval(lattice_bct_interactionSlipTwin), & - ! - maxval(lattice_fcc_interactionTwinSlip), & - maxval(lattice_bcc_interactionTwinSlip), & - maxval(lattice_hex_interactionTwinSlip), & -! maxval(lattice_bct_interactionTwinSlip), & - ! - maxval(lattice_fcc_interactionTwinTwin), & - maxval(lattice_bcc_interactionTwinTwin), & - maxval(lattice_hex_interactionTwinTwin))) & -! maxval(lattice_bct_interactionTwinTwin))) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNinteraction') - Nphases = size(config_phase) allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID) @@ -1368,23 +1362,22 @@ subroutine lattice_init allocate(a_fcc(Nphases),source=0.0_pReal) allocate(a_bcc(Nphases),source=0.0_pReal) - do section = 1, size(config_phase) - p = section - tag = config_phase(p)%getString('lattice_structure') - select case(trim(tag)) - case('iso','isotropic') - lattice_structure(p) = LATTICE_iso_ID - case('fcc') - lattice_structure(p) = LATTICE_fcc_ID - case('bcc') - lattice_structure(p) = LATTICE_bcc_ID - case('hex','hexagonal') - lattice_structure(p) = LATTICE_hex_ID - case('bct') - lattice_structure(p) = LATTICE_bct_ID - case('ort','orthorhombic') - lattice_structure(p) = LATTICE_ort_ID -end select + do p = 1, size(config_phase) + tag = config_phase(p)%getString('lattice_structure') + select case(trim(tag)) + case('iso','isotropic') + lattice_structure(p) = LATTICE_iso_ID + case('fcc') + lattice_structure(p) = LATTICE_fcc_ID + case('bcc') + lattice_structure(p) = LATTICE_bcc_ID + case('hex','hexagonal') + lattice_structure(p) = LATTICE_hex_ID + case('bct') + lattice_structure(p) = LATTICE_bct_ID + case('ort','orthorhombic') + lattice_structure(p) = LATTICE_ort_ID + end select ! case('trans_lattice_structure') ! select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) @@ -1394,44 +1387,30 @@ end select ! trans_lattice_structure(section) = LATTICE_hex_ID ! end select + lattice_C66(1,1,p) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) + lattice_C66(1,2,p) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) + lattice_C66(1,3,p) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) + lattice_C66(2,3,p) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) + lattice_C66(3,3,p) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) + lattice_C66(4,4,p) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) + lattice_C66(5,5,p) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) + lattice_C66(6,6,p) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) - lattice_C66(1,1,section) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) - lattice_C66(1,2,section) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) - lattice_C66(1,3,section) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) - lattice_C66(2,3,section) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) - lattice_C66(3,3,section) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) - lattice_C66(4,4,section) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) - lattice_C66(5,5,section) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) - lattice_C66(6,6,section) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) + lattice_trans_C66(1,1,p) = config_phase(p)%getFloat('c11_trans',defaultVal=0.0_pReal) + lattice_trans_C66(1,2,p) = config_phase(p)%getFloat('c12_trans',defaultVal=0.0_pReal) + lattice_trans_C66(1,3,p) = config_phase(p)%getFloat('c13_trans',defaultVal=0.0_pReal) + lattice_trans_C66(2,2,p) = config_phase(p)%getFloat('c22_trans',defaultVal=0.0_pReal) + lattice_trans_C66(2,3,p) = config_phase(p)%getFloat('c23_trans',defaultVal=0.0_pReal) + lattice_trans_C66(3,3,p) = config_phase(p)%getFloat('c33_trans',defaultVal=0.0_pReal) + lattice_trans_C66(4,4,p) = config_phase(p)%getFloat('c44_trans',defaultVal=0.0_pReal) + lattice_trans_C66(5,5,p) = config_phase(p)%getFloat('c55_trans',defaultVal=0.0_pReal) + lattice_trans_C66(6,6,p) = config_phase(p)%getFloat('c66_trans',defaultVal=0.0_pReal) + + CoverA(p) = config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal) + CoverA_trans(p) = config_phase(p)%getFloat('c/a_trans',defaultVal=0.0_pReal) + a_fcc(p) = config_phase(p)%getFloat('a_fcc',defaultVal=0.0_pReal) + a_bcc(p) = config_phase(p)%getFloat('a_bcc',defaultVal=0.0_pReal) -! case ('c11_trans') -! lattice_trans_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c12_trans') -! lattice_trans_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c13_trans') -! lattice_trans_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c22_trans') -! lattice_trans_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c23_trans') -! lattice_trans_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c33_trans') -! lattice_trans_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c44_trans') -! lattice_trans_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c55_trans') -! lattice_trans_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c66_trans') -! lattice_trans_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) -! -! case ('covera_ratio','c/a_ratio','c/a') -! CoverA(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('c/a_trans','c/a_martensite','c/a_mart') -! CoverA_trans(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('a_fcc') -! a_fcc(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('a_bcc') -! a_bcc(section) = IO_floatValue(line,chunkPos,2_pInt) -! ! case ('thermal_conductivity11') ! lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) ! case ('thermal_conductivity22') @@ -1450,73 +1429,40 @@ end select ! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) ! lattice_thermalExpansion33(3,3,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) ! enddo -! case ('specific_heat') -! lattice_specificHeat(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyformationenergy') -! lattice_vacancyFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancysurfaceenergy') -! lattice_vacancySurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyvolume') -! lattice_vacancyVol(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenformationenergy') -! lattice_hydrogenFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogensurfaceenergy') -! lattice_hydrogenSurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenvolume') -! lattice_hydrogenVol(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('mass_density') -! lattice_massDensity(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('reference_temperature') -! lattice_referenceTemperature(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('damage_diffusion11') -! lattice_DamageDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('damage_diffusion22') -! lattice_DamageDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('damage_diffusion33') -! lattice_DamageDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('damage_mobility') -! lattice_DamageMobility(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_diffusion11') -! lattice_vacancyfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_diffusion22') -! lattice_vacancyfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_diffusion33') -! lattice_vacancyfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_mobility11') -! lattice_vacancyfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_mobility22') -! lattice_vacancyfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancyflux_mobility33') -! lattice_vacancyfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('porosity_diffusion11') -! lattice_PorosityDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('porosity_diffusion22') -! lattice_PorosityDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('porosity_diffusion33') -! lattice_PorosityDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('porosity_mobility') -! lattice_PorosityMobility(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_diffusion11') -! lattice_hydrogenfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_diffusion22') -! lattice_hydrogenfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_diffusion33') -! lattice_hydrogenfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_mobility11') -! lattice_hydrogenfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_mobility22') -! lattice_hydrogenfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogenflux_mobility33') -! lattice_hydrogenfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('vacancy_eqcv') -! lattice_equilibriumVacancyConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('hydrogen_eqch') -! lattice_equilibriumHydrogenConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) -! end select -! endif -! enddo + lattice_specificHeat(p) = config_phase(p)%getFloat( 'specific_heat',defaultVal=0.0_pReal) + lattice_vacancyFormationEnergy(p) = config_phase(p)%getFloat( 'vacancyformationenergy',defaultVal=0.0_pReal) + lattice_vacancySurfaceEnergy(p) = config_phase(p)%getFloat( 'vacancyvolume',defaultVal=0.0_pReal) + lattice_vacancyVol(p) = config_phase(p)%getFloat( 'vacancysurfaceenergy',defaultVal=0.0_pReal) + lattice_hydrogenFormationEnergy(p) = config_phase(p)%getFloat( 'hydrogenformationenergy',defaultVal=0.0_pReal) + lattice_hydrogenSurfaceEnergy(p) = config_phase(p)%getFloat( 'hydrogensurfaceenergy',defaultVal=0.0_pReal) + lattice_hydrogenVol(p) = config_phase(p)%getFloat( 'hydrogenvolume',defaultVal=0.0_pReal) + lattice_massDensity(p) = config_phase(p)%getFloat( 'mass_density',defaultVal=0.0_pReal) + lattice_referenceTemperature(p) = config_phase(p)%getFloat( 'reference_temperature',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(1,1,p) = config_phase(p)%getFloat( 'damage_diffusion11',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(2,2,p) = config_phase(p)%getFloat( 'damage_diffusion22',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(3,3,p) = config_phase(p)%getFloat( 'damage_diffusion33',defaultVal=0.0_pReal) + lattice_DamageMobility(p) = config_phase(p)%getFloat( 'damage_mobility',defaultVal=0.0_pReal) + lattice_vacancyfluxDiffusion33(1,1,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion11',defaultVal=0.0_pReal) + lattice_vacancyfluxDiffusion33(2,2,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion22',defaultVal=0.0_pReal) + lattice_vacancyfluxDiffusion33(3,3,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion33',defaultVal=0.0_pReal) + lattice_vacancyfluxMobility33(1,1,p) = config_phase(p)%getFloat( 'vacancyflux_mobility11',defaultVal=0.0_pReal) + lattice_vacancyfluxMobility33(2,2,p) = config_phase(p)%getFloat( 'vacancyflux_mobility22',defaultVal=0.0_pReal) + lattice_vacancyfluxMobility33(3,3,p) = config_phase(p)%getFloat( 'vacancyflux_mobility33',defaultVal=0.0_pReal) + lattice_PorosityDiffusion33(1,1,p) = config_phase(p)%getFloat( 'porosity_diffusion11',defaultVal=0.0_pReal) + lattice_PorosityDiffusion33(2,2,p) = config_phase(p)%getFloat( 'porosity_diffusion22',defaultVal=0.0_pReal) + lattice_PorosityDiffusion33(3,3,p) = config_phase(p)%getFloat( 'porosity_diffusion33',defaultVal=0.0_pReal) + lattice_PorosityMobility(p) = config_phase(p)%getFloat( 'porosity_mobility',defaultVal=0.0_pReal) + lattice_hydrogenfluxDiffusion33(1,1,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion11',defaultVal=0.0_pReal) + lattice_hydrogenfluxDiffusion33(2,2,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion22',defaultVal=0.0_pReal) + lattice_hydrogenfluxDiffusion33(3,3,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion33',defaultVal=0.0_pReal) + lattice_hydrogenfluxMobility33(1,1,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility11',defaultVal=0.0_pReal) + lattice_hydrogenfluxMobility33(2,2,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility22',defaultVal=0.0_pReal) + lattice_hydrogenfluxMobility33(3,3,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility33',defaultVal=0.0_pReal) + lattice_equilibriumVacancyConcentration(p) = config_phase(p)%getFloat( 'vacancy_eqcv',defaultVal=0.0_pReal) + lattice_equilibriumHydrogenConcentration(p) = config_phase(p)%getFloat( 'hydrogen_eqch',defaultVal=0.0_pReal) enddo + do i = 1_pInt,Nphases if ((CoverA(i) < 1.0_pReal .or. CoverA(i) > 2.0_pReal) & .and. lattice_structure(i) == LATTICE_hex_ID) call IO_error(131_pInt,el=i) ! checking physical significance of c/a @@ -1682,16 +1628,16 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) myNtwin = lattice_fcc_Ntwin myNtrans = lattice_fcc_Ntrans myNcleavage = lattice_fcc_Ncleavage - do i = 1_pInt,myNslip ! assign slip system vectors + do i = 1_pInt,myNslip ! assign slip system vectors sd(1:3,i) = lattice_fcc_systemSlip(1:3,i) sn(1:3,i) = lattice_fcc_systemSlip(4:6,i) enddo - do i = 1_pInt,myNtwin ! assign twin system vectors and shears + do i = 1_pInt,myNtwin ! 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 - do i = 1_pInt, myNcleavage ! assign cleavage system vectors + do i = 1_pInt, myNcleavage ! assign cleavage system vectors cd(1:3,i) = lattice_fcc_systemCleavage(1:3,i)/norm2(lattice_fcc_systemCleavage(1:3,i)) cn(1:3,i) = lattice_fcc_systemCleavage(4:6,i)/norm2(lattice_fcc_systemCleavage(4:6,i)) ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) @@ -1699,16 +1645,16 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) ! Phase transformation select case(trans_lattice_structure(myPhase)) - case (LATTICE_bcc_ID) ! fcc to bcc transformation + case (LATTICE_bcc_ID) ! fcc to bcc transformation do i = 1_pInt,myNtrans - Rtr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation + Rtr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation lattice_fccTobcc_systemTrans(4,i)*INRAD) - Btr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system + Btr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system lattice_fccTobcc_bainRot(4,i)*INRAD) xtr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) ytr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) ztr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) - Utr(1:3,1:3,i) = 0.0_pReal ! Bain deformation + Utr(1:3,1:3,i) = 0.0_pReal ! Bain deformation if ((a_fcc > 0.0_pReal) .and. (a_bcc > 0.0_pReal)) then Utr(1:3,1:3,i) = (a_bcc/a_fcc)*math_tensorproduct33(xtr(1:3,i), xtr(1:3,i)) + & sqrt(2.0_pReal)*(a_bcc/a_fcc)*math_tensorproduct33(ytr(1:3,i), ytr(1:3,i)) + & From a908e663060c8cbb9544d491c543b3843606c695 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 30 Jul 2018 11:45:16 +0200 Subject: [PATCH 51/79] WIP: reading in new style --- src/homogenization.f90 | 1 - src/lattice.f90 | 25 ++++++++++++------------- src/numerics.f90 | 5 ----- 3 files changed, 12 insertions(+), 19 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 75330e86c..3565999a8 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -494,7 +494,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) subStepMinHomog, & subStepSizeHomog, & stepIncreaseHomog, & - nHomog, & nMPstate use math, only: & math_transpose33 diff --git a/src/lattice.f90 b/src/lattice.f90 index 07f230358..a0717659e 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1379,13 +1379,14 @@ subroutine lattice_init lattice_structure(p) = LATTICE_ort_ID end select -! case('trans_lattice_structure') -! select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) -! case('bcc') -! trans_lattice_structure(section) = LATTICE_bcc_ID -! case('hex','hexagonal') -! trans_lattice_structure(section) = LATTICE_hex_ID -! end select + tag = 'undefined' + tag = config_phase(p)%getString('trans_lattice_structure',defaultVal=tag) + select case(trim(tag)) + case('bcc') + trans_lattice_structure(section) = LATTICE_bcc_ID + case('hex','hexagonal') + trans_lattice_structure(section) = LATTICE_hex_ID + end select lattice_C66(1,1,p) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) lattice_C66(1,2,p) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) @@ -1411,12 +1412,10 @@ subroutine lattice_init a_fcc(p) = config_phase(p)%getFloat('a_fcc',defaultVal=0.0_pReal) a_bcc(p) = config_phase(p)%getFloat('a_bcc',defaultVal=0.0_pReal) -! case ('thermal_conductivity11') -! lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('thermal_conductivity22') -! lattice_thermalConductivity33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) -! case ('thermal_conductivity33') -! lattice_thermalConductivity33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) + lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11') + lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22') + lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33') + ! case ('thermal_expansion11') ! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) ! lattice_thermalExpansion33(1,1,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) diff --git a/src/numerics.f90 b/src/numerics.f90 index 8de664248..56da2041e 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -16,7 +16,6 @@ module numerics integer(pInt), protected, public :: & iJacoStiffness = 1_pInt, & !< frequency of stiffness update iJacoLpresiduum = 1_pInt, & !< frequency of Jacobian update of residuum in Lp - nHomog = 20_pInt, & !< homogenization loop limit (only for debugging info, loop limit is determined by "subStepMinHomog") nMPstate = 10_pInt, & !< materialpoint state loop limit nCryst = 20_pInt, & !< crystallite loop limit (only for debugging info, loop limit is determined by "subStepMinCryst") nState = 10_pInt, & !< state loop limit @@ -284,8 +283,6 @@ subroutine numerics_init pert_Fg = IO_floatValue(line,chunkPos,2_pInt) case ('pert_method') pert_method = IO_intValue(line,chunkPos,2_pInt) - case ('nhomog') - nHomog = IO_intValue(line,chunkPos,2_pInt) case ('nmpstate') nMPstate = IO_intValue(line,chunkPos,2_pInt) case ('ncryst') @@ -536,7 +533,6 @@ subroutine numerics_init write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength - write(6,'(a24,1x,i8)') ' nHomog: ',nHomog write(6,'(a24,1x,es8.1)') ' subStepMinHomog: ',subStepMinHomog write(6,'(a24,1x,es8.1)') ' subStepSizeHomog: ',subStepSizeHomog write(6,'(a24,1x,es8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog @@ -646,7 +642,6 @@ subroutine numerics_init if (pert_Fg <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pert_Fg') if (pert_method <= 0_pInt .or. pert_method >= 4_pInt) & call IO_error(301_pInt,ext_msg='pert_method') - if (nHomog < 1_pInt) call IO_error(301_pInt,ext_msg='nHomog') if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate') if (nCryst < 1_pInt) call IO_error(301_pInt,ext_msg='nCryst') if (nState < 1_pInt) call IO_error(301_pInt,ext_msg='nState') From 7283ee6caa42a980ecffe5db69161bbb3207dd68 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 1 Aug 2018 09:29:01 +0200 Subject: [PATCH 52/79] using updated tests from PRIVATE/master --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 14b60c558..a3e5f7a4b 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 14b60c558375731e80db8e5fa49cba753f0d0939 +Subproject commit a3e5f7a4ba42e841238af3cee1560a4429a39a6e From 5d09e98e02366417ceb57b9cdd6ca705e1b1a8f9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 01:14:18 +0200 Subject: [PATCH 53/79] checking with Philip --- src/plastic_phenopowerlaw.f90 | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index f854e7b00..f91ba28ae 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -591,7 +591,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) ! Calculation of the tangent of Lp - if (dNeq0(gdot_twin)) then !@ Philip: Needed? No division + if (dNeq0(gdot_twin)) then dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin 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) + & @@ -606,6 +606,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, end associate end subroutine plastic_phenopowerlaw_LpAndItsTangent + !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- @@ -649,8 +650,9 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - associate( prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph)), dst => & -dotState(phase_plasticityInstance(ph))) + associate( prm => param(phase_plasticityInstance(ph)), & + stt => state(phase_plasticityInstance(ph)), & + dst => dotState(phase_plasticityInstance(ph))) dst%whole(:,of) = 0.0_pReal @@ -668,7 +670,7 @@ dotState(phase_plasticityInstance(ph))) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt - left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part + left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) **prm%a_slip & * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) @@ -707,7 +709,7 @@ dotState(phase_plasticityInstance(ph))) !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above do j = 1_pInt,prm%totalNslip - dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j + dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor enddo @@ -719,12 +721,12 @@ dotState(phase_plasticityInstance(ph))) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt - dst%s_twin(j,of) = & ! evolution of twin resistance j + dst%s_twin(j,of) = & ! evolution of twin resistance j c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (stt%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 dst%sumF(of) = dst%sumF(of) + gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) - dst%accshear_twin(j,of) = abs(gdot_twin(j)) + dst%accshear_twin(j,of) = abs(gdot_twin(j)) enddo twinSystems2 enddo twinFamilies2 end associate @@ -771,8 +773,9 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) of = phasememberAt(ipc,ip,el) ph = material_phase(ipc,ip,el) - associate( prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph)), dst => & -dotState(phase_plasticityInstance(ph))) + associate( prm => param(phase_plasticityInstance(ph)), & + stt => state(phase_plasticityInstance(ph)), & + dst => dotState(phase_plasticityInstance(ph))) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt @@ -828,13 +831,14 @@ dotState(phase_plasticityInstance(ph))) case (resistance_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & - stt%s_twin(1:prm%totalNtwin,of) + stt%s_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin case (accumulatedshear_twin_ID) plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & stt%accshear_twin(1:prm%totalNtwin,of) c = c + prm%totalNtwin + case (shearrate_twin_ID) j = 0_pInt twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) From af931a78c7c779405ab213ac5610bebae58cf7f2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 08:09:28 +0200 Subject: [PATCH 54/79] finalizing reading in --- src/lattice.f90 | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index a0717659e..e5fde8be8 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1276,6 +1276,7 @@ subroutine lattice_init tag = '' integer(pInt) :: section = 0_pInt,i,p real(pReal), dimension(:), allocatable :: & + temp, & CoverA, & !< c/a ratio for low symmetry type lattice CoverA_trans, & !< c/a ratio for transformed hex type lattice a_fcc, & !< lattice parameter a for fcc austenite @@ -1416,18 +1417,12 @@ subroutine lattice_init lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22') lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33') -! case ('thermal_expansion11') -! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) -! lattice_thermalExpansion33(1,1,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) -! enddo -! case ('thermal_expansion22') -! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) -! lattice_thermalExpansion33(2,2,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) -! enddo -! case ('thermal_expansion33') -! do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) -! lattice_thermalExpansion33(3,3,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) -! enddo + temp = config_phase(p)%getFloats('thermal_expansion11') ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(1,1,1:size(temp),p) = temp + temp = config_phase(p)%getFloats('thermal_expansion22') ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(2,2,1:size(temp),p) = temp + temp = config_phase(p)%getFloats('thermal_expansion33') ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(3,3,1:size(temp),p) = temp lattice_specificHeat(p) = config_phase(p)%getFloat( 'specific_heat',defaultVal=0.0_pReal) lattice_vacancyFormationEnergy(p) = config_phase(p)%getFloat( 'vacancyformationenergy',defaultVal=0.0_pReal) From c2f97095670a0f85538672cd683e52361e38adc4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 08:42:26 +0200 Subject: [PATCH 55/79] leaner, most of it also supported by older gcc --- src/lattice.f90 | 66 ++++++++++++++++++++++++++----------------------- 1 file changed, 35 insertions(+), 31 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index e5fde8be8..f75745433 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1054,40 +1054,44 @@ module lattice ],pReal),[ 3_pInt + 3_pInt,LATTICE_ortho_Ncleavage]) integer(pInt), parameter, public :: & - LATTICE_maxNslip = maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, & - LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures - LATTICE_maxNtwin = maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, & - LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures - LATTICE_maxNnonSchmid = maxval([LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & - LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & - LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures - LATTICE_maxNtrans = maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, & - LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]), &!< max # of transformation systems over lattice structures - LATTICE_maxNcleavage = maxval([LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & - LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, & - LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]), & !< max # of cleavage systems over lattice structures - LATTICE_maxNinteraction = maxval([ & - maxval(lattice_fcc_interactionSlipSlip), & - maxval(lattice_bcc_interactionSlipSlip), & - maxval(lattice_hex_interactionSlipSlip), & - maxval(lattice_bct_interactionSlipSlip), & + LATTICE_maxNslip = max(LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, & + LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip), & !< max # of slip systems over lattice structures + LATTICE_maxNtwin = max(LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, & + LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin), & !< max # of twin systems over lattice structures + LATTICE_maxNnonSchmid = max(LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & + LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & + LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid), & !< max # of non-Schmid contributions over lattice structures + LATTICE_maxNtrans = max(LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, & + LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans), & !< max # of transformation systems over lattice structures + LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & + LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, & + LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage), & !< max # of cleavage systems over lattice structures +#if defined(__GFORTRAN__) + ! only supported in gcc 8 + LATTICE_maxNinteraction = 182_pInt +#else + LATTICE_maxNinteraction = max(& + maxval(lattice_fcc_interactionSlipSlip), & + maxval(lattice_bcc_interactionSlipSlip), & + maxval(lattice_hex_interactionSlipSlip), & + maxval(lattice_bct_interactionSlipSlip), & ! - maxval(lattice_fcc_interactionSlipTwin), & - maxval(lattice_bcc_interactionSlipTwin), & - maxval(lattice_hex_interactionSlipTwin), & - ! maxval(lattice_bct_interactionSlipTwin), & + maxval(lattice_fcc_interactionSlipTwin), & + maxval(lattice_bcc_interactionSlipTwin), & + maxval(lattice_hex_interactionSlipTwin), & + !maxval(lattice_bct_interactionSlipTwin), & ! - maxval(lattice_fcc_interactionTwinSlip), & - maxval(lattice_bcc_interactionTwinSlip), & - maxval(lattice_hex_interactionTwinSlip), & - ! maxval(lattice_bct_interactionTwinSlip), & + maxval(lattice_fcc_interactionTwinSlip), & + maxval(lattice_bcc_interactionTwinSlip), & + maxval(lattice_hex_interactionTwinSlip), & + !maxval(lattice_bct_interactionTwinSlip), & ! - maxval(lattice_fcc_interactionTwinTwin), & - maxval(lattice_bcc_interactionTwinTwin), & - maxval(lattice_hex_interactionTwinTwin) & - ! maxval(lattice_bct_interactionTwinTwin))) - ]) !< max # of interaction types (in hardening matrix part) - + maxval(lattice_fcc_interactionTwinTwin), & + maxval(lattice_bcc_interactionTwinTwin), & + maxval(lattice_hex_interactionTwinTwin) & + !maxval(lattice_bct_interactionTwinTwin))) + ) !< max # of interaction types (in hardening matrix part) +#endif real(pReal), dimension(:,:,:), allocatable, public, protected :: & lattice_C66, lattice_trans_C66 real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & From b305d9133fb5e3c664e9426ff241fd0c0a4dab84 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 09:12:30 +0200 Subject: [PATCH 56/79] avoid timeouts if Abaqus is used by someone else --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 50eb21714..9d3b6c858 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 50eb21714e2f501b111bb62096ebb6a5bfc6708a +Subproject commit 9d3b6c858243ec6d7c1f8425e78be59bfdd6e110 From f0645d84f597d8cf97ebf94f59b4ea8f331f04c1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 16 Jul 2018 22:22:21 +0200 Subject: [PATCH 57/79] not a target anymore --- src/plastic_phenopowerlaw.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index f91ba28ae..bdc6e12a6 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -86,7 +86,7 @@ module plastic_phenopowerlaw sumF end type - type(tPhenopowerlawState), allocatable, dimension(:), target, private :: & + type(tPhenopowerlawState), allocatable, dimension(:), private :: & dotState, & state From c8aa9ff3efe0b1ebd09fd61e85000be030d4c0b1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 3 Aug 2018 19:30:36 +0200 Subject: [PATCH 58/79] merge-related fixes --- PRIVATE | 2 +- lib/damask/config/material.py | 13 +++++++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 9d3b6c858..ae79bc96d 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 9d3b6c858243ec6d7c1f8425e78be59bfdd6e110 +Subproject commit ae79bc96d9dd1fd5ea06b916b0be098169f34a1e diff --git a/lib/damask/config/material.py b/lib/damask/config/material.py index af635dd92..02658019d 100644 --- a/lib/damask/config/material.py +++ b/lib/damask/config/material.py @@ -277,3 +277,16 @@ class Material(): self.data[part.lower()][section.lower()][key.lower()] = value if newlen is not oldlen: print('Length of value was changed from %i to %i!'%(oldlen,newlen)) + + + def add_value(self, part=None, + section=None, + key=None, + value=None): + if not isinstance(value,list): + if not isinstance(value,str): + value = '%s'%value + value = [value] + print('adding %s:%s:%s with value %s '%(part.lower(),section.lower(),key.lower(),value)) + self.data[part.lower()][section.lower()][key.lower()] = value + self.data[part.lower()][section.lower()]['__order__'] += [key.lower()] From eebff83252495f45cb9e79f2ff6b94408c9f301e Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 3 Aug 2018 22:06:36 +0200 Subject: [PATCH 59/79] [skip ci] updated version information after successful test of v2.0.2-263-gb305d913 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index fca0385fb..8ef11d745 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-261-gbc3f6ae9 +v2.0.2-263-gb305d913 From 8edeeaf2135acf428990ba8098db641bc8ff4ad7 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 3 Aug 2018 19:39:14 -0400 Subject: [PATCH 60/79] renaming of p_vec and friends to names based on "group" --- src/material.f90 | 10 +++++----- src/prec.f90 | 8 ++++---- src/vacancyflux_cahnhilliard.f90 | 4 ++-- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index d71fbb37a..c2c52aaa6 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -16,8 +16,8 @@ module material tSourceState, & tHomogMapping, & tPhaseMapping, & - p_vec, & - p_intvec + group_scalar, & + group_int implicit none private @@ -268,7 +268,7 @@ module material porosityMapping, & !< mapping for porosity state/fields hydrogenfluxMapping !< mapping for hydrogen conc state/fields - type(p_vec), allocatable, dimension(:), public :: & + type(group_scalar), allocatable, dimension(:), public :: & temperature, & !< temperature field damage, & !< damage field vacancyConc, & !< vacancy conc field @@ -1120,8 +1120,8 @@ subroutine material_populateGrains phaseID,textureID,dGrains,myNgrains,myNorientations,myNconstituents, & grain,constituentGrain,ipGrain,symExtension, ip real(pReal) :: deviation,extreme,rnd - integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array - type(p_intvec), dimension (:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array + integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array + type(group_int), dimension (:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array myDebug = debug_level(debug_material) diff --git a/src/prec.f90 b/src/prec.f90 index 2cdc533b6..f5b41b873 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -28,13 +28,13 @@ module prec integer(pInt), allocatable, dimension(:) :: realloc_lhs_test - type, public :: p_vec !< variable length datatype used for storage of state + type, public :: group_scalar !< variable length datatype used for storage of state real(pReal), dimension(:), pointer :: p - end type p_vec + end type group_scalar - type, public :: p_intvec + type, public :: group_int integer(pInt), dimension(:), pointer :: p - end type p_intvec + end type group_int !http://stackoverflow.com/questions/3948210/can-i-have-a-pointer-to-an-item-in-an-allocatable-array type, public :: tState diff --git a/src/vacancyflux_cahnhilliard.f90 b/src/vacancyflux_cahnhilliard.f90 index cde2cb233..96fd50d64 100644 --- a/src/vacancyflux_cahnhilliard.f90 +++ b/src/vacancyflux_cahnhilliard.f90 @@ -7,7 +7,7 @@ module vacancyflux_cahnhilliard use prec, only: & pReal, & pInt, & - p_vec + group_scalar implicit none private @@ -26,7 +26,7 @@ module vacancyflux_cahnhilliard real(pReal), dimension(:), allocatable, private :: & vacancyflux_cahnhilliard_flucAmplitude - type(p_vec), dimension(:), allocatable, private :: & + type(group_scalar), dimension(:), allocatable, private :: & vacancyflux_cahnhilliard_thermalFluc real(pReal), parameter, private :: & From e6d5f1926fbab636eb3e62a3d1993d7f67e1368c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 4 Aug 2018 14:35:57 +0200 Subject: [PATCH 61/79] issue of heap size still not finally resolved --- env/DAMASK.csh | 4 +++- env/DAMASK.sh | 4 +++- env/DAMASK.zsh | 4 +++- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/env/DAMASK.csh b/env/DAMASK.csh index 26e2dd8a2..07b4b6817 100644 --- a/env/DAMASK.csh +++ b/env/DAMASK.csh @@ -19,7 +19,9 @@ if ( "x$DAMASK_NUM_THREADS" == "x" ) then endif # currently, there is no information that unlimited causes problems -# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# more info https://jblevins.org/log/segfault +# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap # http://superuser.com/questions/220059/what-parameters-has-ulimit limit datasize unlimited # maximum heap size (kB) limit stacksize unlimited # maximum stack size (kB) diff --git a/env/DAMASK.sh b/env/DAMASK.sh index 509f5f1b7..663e9a4b3 100644 --- a/env/DAMASK.sh +++ b/env/DAMASK.sh @@ -42,7 +42,9 @@ PROCESSING=$(type -p postResults || true 2>/dev/null) [ "x$DAMASK_NUM_THREADS" == "x" ] && DAMASK_NUM_THREADS=1 # currently, there is no information that unlimited causes problems -# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# more info https://jblevins.org/log/segfault +# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap # http://superuser.com/questions/220059/what-parameters-has-ulimit ulimit -d unlimited 2>/dev/null # maximum heap size (kB) ulimit -s unlimited 2>/dev/null # maximum stack size (kB) diff --git a/env/DAMASK.zsh b/env/DAMASK.zsh index 3ceeb116a..43f682865 100644 --- a/env/DAMASK.zsh +++ b/env/DAMASK.zsh @@ -33,7 +33,9 @@ PROCESSING=$(which postResults || true 2>/dev/null) [ "x$DAMASK_NUM_THREADS" = "x" ] && DAMASK_NUM_THREADS=1 # currently, there is no information that unlimited causes problems -# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# more info https://jblevins.org/log/segfault +# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap # http://superuser.com/questions/220059/what-parameters-has-ulimit ulimit -d unlimited 2>/dev/null # maximum heap size (kB) ulimit -s unlimited 2>/dev/null # maximum stack size (kB) From fa0dff7ac8796256e5d1ead0f121391994209093 Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 4 Aug 2018 21:51:25 +0200 Subject: [PATCH 62/79] [skip ci] updated version information after successful test of v2.0.2-282-gc05337a2 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 8ef11d745..6ab575d5c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-263-gb305d913 +v2.0.2-282-gc05337a2 From d623d0379be398f79c3d9e6b861022233a8b0804 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 4 Aug 2018 22:38:38 +0200 Subject: [PATCH 63/79] resolved confusion of different branches in PRIVATE --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 58fcddbe6..67fcdfd00 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 58fcddbe62a071d027c0e2a876f07483b2d1e20e +Subproject commit 67fcdfd001a9e4f3da56d72ebeb0ea16d6d613e6 From 661636d83ec0b532635c8a6e400f1b55c03541b7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 4 Aug 2018 22:53:56 +0200 Subject: [PATCH 64/79] default values needed to suppress error in case of missing key --- src/lattice.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index f75745433..2b7fe5774 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1417,15 +1417,15 @@ subroutine lattice_init a_fcc(p) = config_phase(p)%getFloat('a_fcc',defaultVal=0.0_pReal) a_bcc(p) = config_phase(p)%getFloat('a_bcc',defaultVal=0.0_pReal) - lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11') - lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22') - lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33') + lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11',defaultVal=0.0_pReal) + lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22',defaultVal=0.0_pReal) + lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33',defaultVal=0.0_pReal) - temp = config_phase(p)%getFloats('thermal_expansion11') ! read up to three parameters (constant, linear, quadratic with T) + temp = config_phase(p)%getFloats('thermal_expansion11',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) lattice_thermalExpansion33(1,1,1:size(temp),p) = temp - temp = config_phase(p)%getFloats('thermal_expansion22') ! read up to three parameters (constant, linear, quadratic with T) + temp = config_phase(p)%getFloats('thermal_expansion22',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) lattice_thermalExpansion33(2,2,1:size(temp),p) = temp - temp = config_phase(p)%getFloats('thermal_expansion33') ! read up to three parameters (constant, linear, quadratic with T) + temp = config_phase(p)%getFloats('thermal_expansion33',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) lattice_thermalExpansion33(3,3,1:size(temp),p) = temp lattice_specificHeat(p) = config_phase(p)%getFloat( 'specific_heat',defaultVal=0.0_pReal) From 2be13b0047366f4160516e70c596399b620351a8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 06:02:33 +0200 Subject: [PATCH 65/79] test that also works for new nonlocal --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 67fcdfd00..3d5f71743 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 67fcdfd001a9e4f3da56d72ebeb0ea16d6d613e6 +Subproject commit 3d5f71743d97eadb4b7ec3d110fe86bf1d6d83d6 From 60fc47ca2a41bc135ebca48a724e4a840fc4cfae Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 09:41:27 +0200 Subject: [PATCH 66/79] unused import --- src/spectral_thermal.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index 8e5b95ab9..4275c9533 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -65,8 +65,6 @@ subroutine spectral_thermal_init compiler_options #endif use IO, only: & - IO_intOut, & - IO_read_realFile, & IO_timeStamp use spectral_utilities, only: & wgt From c0adb613504586adec9252f3796f285612eb8058 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 10:41:01 +0200 Subject: [PATCH 67/79] outdated description --- src/spectral_interface.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index 1ab92a178..c3cb9141b 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -4,9 +4,8 @@ !> @brief Interfacing between the spectral solver and the material subroutines provided !! by DAMASK !> @details Interfacing between the spectral solver and the material subroutines provided -!> by DAMASK. Interpretating the command line arguments or, in case of called from f2py, -!> the arguments parsed to the init routine to get load case, geometry file, working -!> directory, etc. +!> by DAMASK. Interpretating the command line arguments to get load case, geometry file, +!> and working directory. !-------------------------------------------------------------------------------------------------- module DAMASK_interface use prec, only: & From 5337fb1229baab5e6a5e18fc3daf2ee0a138981f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 11:08:17 +0200 Subject: [PATCH 68/79] old runtime debugging leftovers --- src/constitutive.f90 | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9c3989a9c..7833f70cf 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -864,19 +864,11 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra FpArray !< plastic deformation gradient real(pReal), intent(in), dimension(6) :: & Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel) - integer(pLongInt) :: & - tick = 0_pLongInt, & - tock = 0_pLongInt, & - tickrate, & - maxticks integer(pInt) :: & ho, & !< homogenization tme, & !< thermal member position s !< counter in source loop - if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) & - call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) - ho = material_homog( ip,el) tme = thermalMapping(ho)%p(ip,el) @@ -957,13 +949,6 @@ subroutine constitutive_collectDeltaState(Tstar_v, Fe, ipc, ip, el) Fe !< elastic deformation gradient integer(pInt) :: & s !< counter in source loop - integer(pLongInt) :: & - tick, tock, & - tickrate, & - maxticks - - if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) & - call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_KINEHARDENING_ID) plasticityType From 686f0fe801abce250794f28eaccf8b58ef65a684 Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 5 Aug 2018 15:22:24 +0200 Subject: [PATCH 69/79] [skip ci] updated version information after successful test of v2.0.2-349-gd623d037 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6ab575d5c..7f5defebc 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-282-gc05337a2 +v2.0.2-349-gd623d037 From 8173b8ced1f01a5b278efe579a4f54baa3a811ff Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 5 Aug 2018 22:35:17 +0200 Subject: [PATCH 70/79] [skip ci] updated version information after successful test of v2.0.2-350-g2be13b00 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6ab575d5c..f5b06264c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-282-gc05337a2 +v2.0.2-350-g2be13b00 From 80841adcbbfad9b461df0c3132abb1b0bd631533 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 22:50:21 +0200 Subject: [PATCH 71/79] support python 3 soon --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 3d5f71743..737427a96 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3d5f71743d97eadb4b7ec3d110fe86bf1d6d83d6 +Subproject commit 737427a967e098e1cc82f69f5447fd1a02ffa855 From 3fbc537b7bbb378c49a737ca10714d74b99e72b1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 5 Aug 2018 22:50:43 +0200 Subject: [PATCH 72/79] avoid deadlock for master pipelines --- .gitlab-ci.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0721f1374..114580f8d 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -418,6 +418,9 @@ createTar: script: - cd $(mktemp -d) - $DAMASKROOT/PRIVATE/releasing/deployMe.sh $CI_COMMIT_SHA + except: + - master + - release ################################################################################################### AbaqusStd: From 6c4ae60030190c6ba71981feefcff5c090fd0bf7 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 9 Aug 2018 00:03:41 +0200 Subject: [PATCH 73/79] [skip ci] updated version information after successful test of v2.0.2-357-g3fbc537b --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 7f5defebc..104e87fde 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-349-gd623d037 +v2.0.2-357-g3fbc537b From ba215ed9ea99faefb1be819ed2f5cdaf67e87ff2 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Mon, 13 Aug 2018 18:27:51 -0400 Subject: [PATCH 74/79] small polish --- src/prec.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/prec.f90 b/src/prec.f90 index f5b41b873..caf59cfe8 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -41,8 +41,8 @@ module prec integer(pInt) :: & sizeState = 0_pInt, & !< size of state sizeDotState = 0_pInt, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates - offsetDeltaState = 0_pInt, & !< offset of delta state - sizeDeltaState = 0_pInt, & !< size of delta state, i.e. state(offset+1:offset+sizeDot) follows time evolution by deltaState increments + offsetDeltaState = 0_pInt, & !< index offset of delta state + sizeDeltaState = 0_pInt, & !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments sizePostResults = 0_pInt !< size of output data real(pReal), pointer, dimension(:), contiguous :: & atolState @@ -146,7 +146,7 @@ logical elemental pure function dEq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - dEq = merge(.True., .False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + dEq = merge(.True.,.False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function dEq @@ -163,7 +163,7 @@ logical elemental pure function dNeq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - dNeq = merge(.False., .True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + dNeq = merge(.False.,.True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function dNeq @@ -180,7 +180,7 @@ logical elemental pure function dEq0(a,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.2250738585072014E-308 ! smallest non-denormalized number - dEq0 = merge(.True., .False.,abs(a) <= merge(tol,eps,present(tol))) + dEq0 = merge(.True.,.False.,abs(a) <= merge(tol,eps,present(tol))) end function dEq0 @@ -197,7 +197,7 @@ logical elemental pure function dNeq0(a,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.2250738585072014E-308 ! smallest non-denormalized number - dNeq0 = merge(.False., .True.,abs(a) <= merge(tol,eps,present(tol))) + dNeq0 = merge(.False.,.True.,abs(a) <= merge(tol,eps,present(tol))) end function dNeq0 @@ -215,7 +215,7 @@ logical elemental pure function cEq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - cEq = merge(.True., .False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + cEq = merge(.True.,.False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function cEq @@ -233,7 +233,7 @@ logical elemental pure function cNeq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - cNeq = merge(.False., .True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + cNeq = merge(.False.,.True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function cNeq end module prec From 2ea894dbbeec0571df07bac2b3c4d007cdc456e2 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 16 Aug 2018 03:16:13 +0200 Subject: [PATCH 75/79] [skip ci] updated version information after successful test of v2.0.2-374-g3e4f6598 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 104e87fde..943cac93c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-357-g3fbc537b +v2.0.2-374-g3e4f6598 From 08d6cb242f29c01e0f488648b97eb003a2dc7eab Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 17 Aug 2018 15:42:35 -0400 Subject: [PATCH 76/79] adopted new name for covera_ratio: c/a --- examples/SpectralMethod/EshelbyInclusion/material.config | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/SpectralMethod/EshelbyInclusion/material.config b/examples/SpectralMethod/EshelbyInclusion/material.config index 83045938d..e002584b0 100644 --- a/examples/SpectralMethod/EshelbyInclusion/material.config +++ b/examples/SpectralMethod/EshelbyInclusion/material.config @@ -38,7 +38,7 @@ plasticity none [Ti matrix] lattice_structure hex -covera_ratio 1.587 +c/a 1.587 plasticity none {config/elastic_Ti.config} {config/thermal.config} @@ -65,7 +65,7 @@ plasticity none [Ti inclusion] lattice_structure hex -covera_ratio 1.587 +c/a 1.587 plasticity none {config/elastic_Ti.config} {config/thermal.config} From c03ea8f5c7e93c2cbd7849d0eb0e48332c207e4e Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 17 Aug 2018 15:43:09 -0400 Subject: [PATCH 77/79] added forgotten C66(2,2) read-in from parameter database --- src/lattice.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/lattice.f90 b/src/lattice.f90 index 2b7fe5774..ca1cd597a 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1396,6 +1396,7 @@ subroutine lattice_init lattice_C66(1,1,p) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) lattice_C66(1,2,p) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) lattice_C66(1,3,p) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) + lattice_C66(2,2,p) = config_phase(p)%getFloat('c22',defaultVal=0.0_pReal) lattice_C66(2,3,p) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) lattice_C66(3,3,p) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) lattice_C66(4,4,p) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) From 615af684eb7c2a948b6632fb9b80963a867b2800 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 20 Aug 2018 08:55:59 +0200 Subject: [PATCH 78/79] [skip ci] updated version information after successful test of v2.0.2-381-gc03ea8f5 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 943cac93c..fea0a6cd0 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-374-g3e4f6598 +v2.0.2-381-gc03ea8f5 From 7c683d4f3d49b38a337fcb85c97abd55a57be20b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Aug 2018 09:02:03 +0200 Subject: [PATCH 79/79] updated tests for 38- and 36- branches --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 737427a96..c44717258 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 737427a967e098e1cc82f69f5447fd1a02ffa855 +Subproject commit c4471725893e301044924eb0990e2ad619aa0a46