diff --git a/code/IO.f90 b/code/IO.f90 index 5455acce8..0ad943ec5 100644 --- a/code/IO.f90 +++ b/code/IO.f90 @@ -1528,6 +1528,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) msg = 'unknown plasticity specified:' case (205_pInt) msg = 'unknown lattice structure encountered' + case (206_pInt) + msg = 'hex lattice structure with invalid c/a ratio' case (210_pInt) msg = 'unknown material parameter:' @@ -1535,6 +1537,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) msg = 'material parameter out of bounds:' case (212_pInt) msg = 'unknown plasticity output:' + case (213_pInt) + msg = 'not enough values for material parameter:' case (252_pInt) msg = 'nonlocal plasticity works only for direct CPFEM, i.e. one grain per integration point' @@ -1689,6 +1693,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg) else write(6,'(a13,1x,i9,35x,a1)') ' + at element',e,'+' endif + elseif (present(i)) then ! now having the meaning of "instance" + write(6,'(a15,1x,i9,33x,a1)') ' + for instance',i,'+' endif write(6,'(a)') ' +--------------------------------------------------------+' flush(6) @@ -1726,6 +1732,10 @@ subroutine IO_warning(warning_ID,e,i,g,ext_msg) msg = 'parameter has no effect' case (47_pInt) msg = 'no valid parameter for FFTW, using FFTW_PATIENT' + case (50_pInt) + msg = 'not using all available slip system families' + case (51_pInt) + msg = 'not using all available twin system families' case (101_pInt) msg = 'crystallite debugging off' case (201_pInt) diff --git a/code/constitutive_dislotwin.f90 b/code/constitutive_dislotwin.f90 index 171d0c0d6..7d1be917f 100644 --- a/code/constitutive_dislotwin.f90 +++ b/code/constitutive_dislotwin.f90 @@ -157,9 +157,9 @@ use lattice !* Input variables integer(pInt), intent(in) :: file !* Local variables -integer(pInt), parameter :: maxNchunks = 21_pInt -integer(pInt), dimension(1+2*maxNchunks) :: positions -integer(pInt), dimension(6) :: configNchunks + integer(pInt), parameter :: MAXNCHUNKS = lattice_maxNinteraction + 1_pInt +integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions +integer(pInt), dimension(7) :: configNchunks integer(pInt) :: section = 0_pInt, maxNinstance,mySize=0_pInt,myStructure,maxTotalNslip,maxTotalNtwin,& f,i,j,k,l,m,n,o,p,q,r,s,ns,nt, & Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, & @@ -315,7 +315,7 @@ enddo if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran if (phase_plasticity(section) == constitutive_dislotwin_LABEL) then ! one of my sections i = phase_plasticityInstance(section) ! which instance of my plasticity is present phase - positions = IO_stringPos(line,maxNchunks) + positions = IO_stringPos(line,MAXNCHUNKS) tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key select case(tag) case ('plasticity', 'elasticity') @@ -353,10 +353,18 @@ enddo case ('c66') constitutive_dislotwin_Cslip_66(6,6,i) = IO_floatValue(line,positions,2_pInt) case ('nslip') + if (positions(1) < 1_pInt + Nchunks_SlipFamilies) then + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')') + endif + Nchunks_SlipFamilies = positions(1) - 1_pInt do j = 1_pInt, Nchunks_SlipFamilies constitutive_dislotwin_Nslip(j,i) = IO_intValue(line,positions,1_pInt+j) enddo case ('ntwin') + if (positions(1) < 1_pInt + Nchunks_TwinFamilies) then + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')') + endif + Nchunks_TwinFamilies = positions(1) - 1_pInt do j = 1_pInt, Nchunks_TwinFamilies constitutive_dislotwin_Ntwin(j,i) = IO_intValue(line,positions,1_pInt+j) enddo @@ -431,18 +439,30 @@ enddo case ('catomicvolume') constitutive_dislotwin_CAtomicVolume(i) = IO_floatValue(line,positions,2_pInt) case ('interaction_slipslip','interactionslipslip') + if (positions(1) < 1_pInt + Nchunks_SlipSlip) then + call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')') + endif do j = 1_pInt, Nchunks_SlipSlip constitutive_dislotwin_interaction_SlipSlip(j,i) = IO_floatValue(line,positions,1_pInt+j) enddo case ('interaction_sliptwin','interactionsliptwin') + if (positions(1) < 1_pInt + Nchunks_SlipTwin) then + call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')') + endif do j = 1_pInt, Nchunks_SlipTwin constitutive_dislotwin_interaction_SlipTwin(j,i) = IO_floatValue(line,positions,1_pInt+j) enddo case ('interaction_twinslip','interactiontwinslip') + if (positions(1) < 1_pInt + Nchunks_TwinSlip) then + call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')') + endif do j = 1_pInt, Nchunks_TwinSlip constitutive_dislotwin_interaction_TwinSlip(j,i) = IO_floatValue(line,positions,1_pInt+j) enddo case ('interaction_twintwin','interactiontwintwin') + if (positions(1) < 1_pInt + Nchunks_TwinTwin) then + call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_DISLOTWIN_LABEL//')') + endif do j = 1_pInt, Nchunks_TwinTwin constitutive_dislotwin_interaction_TwinTwin(j,i) = IO_floatValue(line,positions,1_pInt+j) enddo diff --git a/code/constitutive_nonlocal.f90 b/code/constitutive_nonlocal.f90 index ef8a89518..8a0efb6c1 100644 --- a/code/constitutive_nonlocal.f90 +++ b/code/constitutive_nonlocal.f90 @@ -235,6 +235,7 @@ use IO, only: IO_read, & IO_floatValue, & IO_intValue, & IO_error, & + IO_warning, & IO_timeStamp use debug, only: debug_level, & debug_constitutive, & @@ -254,10 +255,10 @@ use lattice integer(pInt), intent(in) :: myFile !*** local variables -integer(pInt), parameter :: maxNchunks = 21_pInt + integer(pInt), parameter :: MAXNCHUNKS = lattice_maxNinteraction + 1_pInt integer(pInt), & - dimension(1_pInt+2_pInt*maxNchunks) :: positions -integer(pInt), dimension(6) :: configNchunks + dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions +integer(pInt), dimension(7) :: configNchunks integer(pInt) :: section = 0_pInt, & maxNinstance, & maxTotalNslip, & @@ -275,6 +276,7 @@ integer(pInt) :: section = 0_pInt, & c, & ! index of dislocation character Nchunks_SlipSlip = 0_pInt, & Nchunks_SlipFamilies = 0_pInt, & + Nchunks_nonSchmid = 0_pInt, & mySize = 0_pInt ! to suppress warnings, safe as init is called only once character(len=65536) tag character(len=65536) :: line = '' ! to start initialized @@ -433,7 +435,7 @@ do while (trim(line) /= '#EOF#') if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran if (phase_plasticity(section) == CONSTITUTIVE_NONLOCAL_LABEL) then ! one of my sections i = phase_plasticityInstance(section) ! which instance of my plasticity is present phase - positions = IO_stringPos(line,maxNchunks) + positions = IO_stringPos(line,MAXNCHUNKS) tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key select case(tag) case('plasticity','elasticity','/nonlocal/') @@ -446,6 +448,7 @@ do while (trim(line) /= '#EOF#') configNchunks = lattice_configNchunks(constitutive_nonlocal_structureName(i)) Nchunks_SlipFamilies = configNchunks(1) Nchunks_SlipSlip = configNchunks(3) + Nchunks_nonSchmid = configNchunks(7) case ('c/a_ratio','covera_ratio') CoverA(i) = IO_floatValue(line,positions,2_pInt) case ('c11') @@ -467,6 +470,10 @@ do while (trim(line) /= '#EOF#') case ('c66') Cslip66(6,6,i) = IO_floatValue(line,positions,2_pInt) case ('nslip') + if (positions(1) < 1_pInt + Nchunks_SlipFamilies) then + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_NONLOCAL_LABEL//')') + endif + Nchunks_SlipFamilies = positions(1) - 1_pInt do f = 1_pInt, Nchunks_SlipFamilies Nslip(f,i) = IO_intValue(line,positions,1_pInt+f) enddo @@ -527,7 +534,10 @@ do while (trim(line) /= '#EOF#') case('significantn','significant_n','significantdislocations','significant_dislcations') significantN(i) = IO_floatValue(line,positions,2_pInt) case ('interaction_slipslip') - do it = 1_pInt, Nchunks_SlipSlip + if (positions(1) < 1_pInt + Nchunks_SlipSlip) then + call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_NONLOCAL_LABEL//')') + endif + do it = 1_pInt,Nchunks_SlipSlip interactionSlipSlip(it,i) = IO_floatValue(line,positions,1_pInt+it) enddo case('linetension','linetensioneffect','linetension_effect') @@ -575,7 +585,10 @@ do while (trim(line) /= '#EOF#') case('shortrangestresscorrection') shortRangeStressCorrection(i) = IO_floatValue(line,positions,2_pInt) > 0.0_pReal case ('nonschmid_coefficients') - do f = 1_pInt, lattice_maxNnonSchmid + if (positions(1) < 1_pInt + Nchunks_nonSchmid) then + call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_NONLOCAL_LABEL//')') + endif + do f = 1_pInt,Nchunks_nonSchmid nonSchmidCoeff(f,i) = IO_floatValue(line,positions,1_pInt+f) enddo case('probabilisticmultiplication','randomsources','randommultiplication','discretesources') diff --git a/code/constitutive_phenopowerlaw.f90 b/code/constitutive_phenopowerlaw.f90 index 1f42b3097..7bc316163 100644 --- a/code/constitutive_phenopowerlaw.f90 +++ b/code/constitutive_phenopowerlaw.f90 @@ -134,12 +134,12 @@ subroutine constitutive_phenopowerlaw_init(myFile) integer(pInt), parameter :: MAXNCHUNKS = lattice_maxNinteraction + 1_pInt integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions - integer(pInt), dimension(6) :: configNchunks + integer(pInt), dimension(7) :: configNchunks integer(pInt) :: & maxNinstance, & i,j,k, f,o, & Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, & - Nchunks_SlipFamilies, Nchunks_TwinFamilies, & + Nchunks_SlipFamilies, Nchunks_TwinFamilies, Nchunks_nonSchmid, & myStructure, index_myFamily, index_otherFamily, & mySize=0_pInt, section = 0_pInt character(len=65536) :: & @@ -163,6 +163,7 @@ subroutine constitutive_phenopowerlaw_init(myFile) Nchunks_SlipTwin = lattice_maxNinteraction Nchunks_TwinSlip = lattice_maxNinteraction Nchunks_TwinTwin = lattice_maxNinteraction + Nchunks_nonSchmid = lattice_maxNnonSchmid allocate(constitutive_phenopowerlaw_sizeDotState(maxNinstance)) constitutive_phenopowerlaw_sizeDotState = 0_pInt @@ -276,6 +277,7 @@ subroutine constitutive_phenopowerlaw_init(myFile) Nchunks_SlipTwin = configNchunks(4) Nchunks_TwinSlip = configNchunks(5) Nchunks_TwinTwin = configNchunks(6) + Nchunks_nonSchmid = configNchunks(7) case ('covera_ratio') constitutive_phenopowerlaw_CoverA(i) = IO_floatValue(line,positions,2_pInt) case ('c11') @@ -297,15 +299,19 @@ subroutine constitutive_phenopowerlaw_init(myFile) case ('c66') constitutive_phenopowerlaw_Cslip_66(6,6,i) = IO_floatValue(line,positions,2_pInt) case ('nslip') + if (positions(1) < 1_pInt + Nchunks_SlipFamilies) then + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_PHENOPOWERLAW_label//')') + endif + Nchunks_SlipFamilies = positions(1) - 1_pInt do j = 1_pInt, Nchunks_SlipFamilies constitutive_phenopowerlaw_Nslip(j,i) = IO_intValue(line,positions,1_pInt+j) - enddo + enddo case ('gdot0_slip') constitutive_phenopowerlaw_gdot0_slip(i) = IO_floatValue(line,positions,2_pInt) case ('n_slip') constitutive_phenopowerlaw_n_slip(i) = IO_floatValue(line,positions,2_pInt) case ('tau0_slip') - do j = 1_pInt, Nchunks_SlipFamilies + do j = 1_pInt,Nchunks_SlipFamilies constitutive_phenopowerlaw_tau0_slip(j,i) = IO_floatValue(line,positions,1_pInt+j) enddo case ('tausat_slip') @@ -315,6 +321,10 @@ subroutine constitutive_phenopowerlaw_init(myFile) case ('a_slip', 'w0_slip') constitutive_phenopowerlaw_a_slip(i) = IO_floatValue(line,positions,2_pInt) case ('ntwin') + if (positions(1) < 1_pInt + Nchunks_TwinFamilies) then + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_PHENOPOWERLAW_label//')') + endif + Nchunks_TwinFamilies = positions(1) - 1_pInt do j = 1_pInt, Nchunks_TwinFamilies constitutive_phenopowerlaw_Ntwin(j,i) = IO_intValue(line,positions,1_pInt+j) enddo @@ -352,23 +362,38 @@ subroutine constitutive_phenopowerlaw_init(myFile) case ('atol_twinfrac') constitutive_phenopowerlaw_aTolTwinfrac(i) = IO_floatValue(line,positions,2_pInt) case ('interaction_slipslip') + if (positions(1) < 1_pInt + Nchunks_SlipSlip) then + call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_PHENOPOWERLAW_label//')') + endif do j = 1_pInt, Nchunks_SlipSlip constitutive_phenopowerlaw_interaction_SlipSlip(j,i) = IO_floatValue(line,positions,1_pInt+j) enddo case ('interaction_sliptwin') + if (positions(1) < 1_pInt + Nchunks_SlipTwin) then + call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_PHENOPOWERLAW_label//')') + endif do j = 1_pInt, Nchunks_SlipTwin constitutive_phenopowerlaw_interaction_SlipTwin(j,i) = IO_floatValue(line,positions,1_pInt+j) enddo case ('interaction_twinslip') + if (positions(1) < 1_pInt + Nchunks_TwinSlip) then + call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_PHENOPOWERLAW_label//')') + endif do j = 1_pInt, Nchunks_TwinSlip constitutive_phenopowerlaw_interaction_TwinSlip(j,i) = IO_floatValue(line,positions,1_pInt+j) enddo case ('interaction_twintwin') + if (positions(1) < 1_pInt + Nchunks_TwinTwin) then + call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_PHENOPOWERLAW_label//')') + endif do j = 1_pInt, Nchunks_TwinTwin constitutive_phenopowerlaw_interaction_TwinTwin(j,i) = IO_floatValue(line,positions,1_pInt+j) enddo case ('nonschmid_coefficients') - do j = 1_pInt, lattice_maxNnonSchmid + if (positions(1) < 1_pInt + Nchunks_nonSchmid) then + call IO_error(213_pInt,ext_msg=trim(tag)//' ('//CONSTITUTIVE_PHENOPOWERLAW_label//')') + endif + do j = 1_pInt,Nchunks_nonSchmid constitutive_phenopowerlaw_nonSchmidCoeff(j,i) = IO_floatValue(line,positions,1_pInt+j) enddo case default @@ -390,28 +415,28 @@ subroutine constitutive_phenopowerlaw_init(myFile) constitutive_phenopowerlaw_totalNslip(i) = sum(constitutive_phenopowerlaw_Nslip(:,i)) ! how many slip systems altogether constitutive_phenopowerlaw_totalNtwin(i) = sum(constitutive_phenopowerlaw_Ntwin(:,i)) ! how many twin systems altogether - if (constitutive_phenopowerlaw_structure(i) < 1 ) call IO_error(205_pInt,e=i) + if (constitutive_phenopowerlaw_structure(i) < 1 ) call IO_error(205_pInt,i=i) if (any(constitutive_phenopowerlaw_tau0_slip(:,i) < 0.0_pReal .and. & - constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,e=i,ext_msg='tau0_slip (' & + constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='tau0_slip (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') - if (constitutive_phenopowerlaw_gdot0_slip(i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='gdot0_slip (' & + if (constitutive_phenopowerlaw_gdot0_slip(i) <= 0.0_pReal) call IO_error(211_pInt,i=i,ext_msg='gdot0_slip (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') - if (constitutive_phenopowerlaw_n_slip(i) <= 0.0_pReal) call IO_error(211_pInt,e=i,ext_msg='n_slip (' & + if (constitutive_phenopowerlaw_n_slip(i) <= 0.0_pReal) call IO_error(211_pInt,i=i,ext_msg='n_slip (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if (any(constitutive_phenopowerlaw_tausat_slip(:,i) <= 0.0_pReal .and. & - constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,e=i,ext_msg='tausat_slip (' & + constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='tausat_slip (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if (any(constitutive_phenopowerlaw_a_slip(i) == 0.0_pReal .and. & - constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,e=i,ext_msg='a_slip (' & + constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='a_slip (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if (any(constitutive_phenopowerlaw_tau0_twin(:,i) < 0.0_pReal .and. & - constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,e=i,ext_msg='tau0_twin (' & + constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='tau0_twin (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if ( constitutive_phenopowerlaw_gdot0_twin(i) <= 0.0_pReal .and. & - any(constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,e=i,ext_msg='gdot0_twin (' & + any(constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='gdot0_twin (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if ( constitutive_phenopowerlaw_n_twin(i) <= 0.0_pReal .and. & - any(constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,e=i,ext_msg='n_twin (' & + any(constitutive_phenopowerlaw_Ntwin(:,i) > 0)) call IO_error(211_pInt,i=i,ext_msg='n_twin (' & //CONSTITUTIVE_PHENOPOWERLAW_label//')') if (constitutive_phenopowerlaw_aTolResistance(i) <= 0.0_pReal) & constitutive_phenopowerlaw_aTolResistance(i) = 1.0_pReal ! default absolute tolerance 1 Pa diff --git a/code/constitutive_titanmod.f90 b/code/constitutive_titanmod.f90 index 6e4f3670f..306baa541 100644 --- a/code/constitutive_titanmod.f90 +++ b/code/constitutive_titanmod.f90 @@ -231,7 +231,7 @@ subroutine constitutive_titanmod_init(myFile) integer(pInt), parameter :: MAXNCHUNKS = 21_pInt integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions - integer(pInt), dimension(6) :: configNchunks + integer(pInt), dimension(7) :: configNchunks integer(pInt) :: section = 0_pInt,f,i,j,k,l,m,n,o,p,q,r,s,s1,s2,t,t1,t2,ns,nt,& Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, & Nchunks_SlipFamilies, Nchunks_TwinFamilies, & diff --git a/code/lattice.f90 b/code/lattice.f90 index 20c68c2d1..790bb6bd5 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -880,53 +880,54 @@ integer(pInt) function lattice_initializeStructure(struct,CoverA) endif case ('hex') - if (CoverA >= 1.0_pReal) then ! checking physical significance of c/a - lattice_hex_Nstructure = lattice_hex_Nstructure + 1_pInt ! count instances of hex structures - myStructure = 2_pInt + lattice_hex_Nstructure ! 3,4,5,.. for hex - myNslipSystem = lattice_hex_NslipSystem ! size of slip system families - myNtwinSystem = lattice_hex_NtwinSystem ! size of twin system families - myNslip = lattice_hex_Nslip ! overall number of slip systems - myNtwin = lattice_hex_Ntwin ! overall number of twin systems - processMe = .true. - lattice_NnonSchmid(myStructure) = lattice_hex_NnonSchmid ! Currently no known non schmid contributions for hex (to be changed later) -! converting from 4 axes coordinate system (a1=a2=a3=c) to ortho-hexgonal system (a, b, c) - do i = 1_pInt,myNslip - sd(1,i) = lattice_hex_systemSlip(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] - sd(2,i) = (lattice_hex_systemSlip(1,i)+2.0_pReal*lattice_hex_systemSlip(2,i))*(0.5_pReal*sqrt(3.0_pReal)) - sd(3,i) = lattice_hex_systemSlip(4,i)*CoverA - sn(1,i) = lattice_hex_systemSlip(5,i) ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) - sn(2,i) = (lattice_hex_systemSlip(5,i)+2.0_pReal*lattice_hex_systemSlip(6,i))/sqrt(3.0_pReal) - sn(3,i) = lattice_hex_systemSlip(8,i)/CoverA - do j = 1_pInt,lattice_hex_NnonSchmid - sns(1:3,1:3,1,j,i) = 0.0_pReal - sns(1:3,1:3,2,j,i) = 0.0_pReal - enddo - enddo - do i = 1_pInt,myNtwin - td(1,i) = lattice_hex_systemTwin(1,i)*1.5_pReal - td(2,i) = (lattice_hex_systemTwin(1,i)+2.0_pReal*lattice_hex_systemTwin(2,i))*(0.5_pReal*sqrt(3.0_pReal)) - td(3,i) = lattice_hex_systemTwin(4,i)*CoverA - tn(1,i) = lattice_hex_systemTwin(5,i) - tn(2,i) = (lattice_hex_systemTwin(5,i)+2.0_pReal*lattice_hex_systemTwin(6,i))/sqrt(3.0_pReal) - tn(3,i) = lattice_hex_systemTwin(8,i)/CoverA - - select case(lattice_hex_shearTwin(i)) ! from Christian & Mahajan 1995 p.29 - case (1_pInt) ! <-10.1>{10.2} - ts(i) = (3.0_pReal-CoverA*CoverA)/sqrt(3.0_pReal)/CoverA - case (2_pInt) ! <11.6>{-1-1.1} - ts(i) = 1.0_pReal/CoverA - case (3_pInt) ! <10.-2>{10.1} - ts(i) = (4.0_pReal*CoverA*CoverA-9.0_pReal)/4.0_pReal/sqrt(3.0_pReal)/CoverA - case (4_pInt) ! <11.-3>{11.2} - ts(i) = 2.0_pReal*(CoverA*CoverA-2.0_pReal)/3.0_pReal/CoverA - end select - - enddo - interactionSlipSlip => lattice_hex_interactionSlipSlip - interactionSlipTwin => lattice_hex_interactionSlipTwin - interactionTwinSlip => lattice_hex_interactionTwinSlip - interactionTwinTwin => lattice_hex_interactionTwinTwin + if (CoverA < 1.0_pReal) then ! checking physical significance of c/a + call IO_error(206_pInt) endif + lattice_hex_Nstructure = lattice_hex_Nstructure + 1_pInt ! count instances of hex structures + myStructure = 2_pInt + lattice_hex_Nstructure ! 3,4,5,.. for hex + myNslipSystem = lattice_hex_NslipSystem ! size of slip system families + myNtwinSystem = lattice_hex_NtwinSystem ! size of twin system families + myNslip = lattice_hex_Nslip ! overall number of slip systems + myNtwin = lattice_hex_Ntwin ! overall number of twin systems + processMe = .true. + lattice_NnonSchmid(myStructure) = lattice_hex_NnonSchmid ! Currently no known non schmid contributions for hex (to be changed later) + + ! converting from 4 axes coordinate system (a1=a2=a3=c) to ortho-hexgonal system (a, b, c) + do i = 1_pInt,myNslip + sd(1,i) = lattice_hex_systemSlip(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] + sd(2,i) = (lattice_hex_systemSlip(1,i)+2.0_pReal*lattice_hex_systemSlip(2,i))*(0.5_pReal*sqrt(3.0_pReal)) + sd(3,i) = lattice_hex_systemSlip(4,i)*CoverA + sn(1,i) = lattice_hex_systemSlip(5,i) ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) + sn(2,i) = (lattice_hex_systemSlip(5,i)+2.0_pReal*lattice_hex_systemSlip(6,i))/sqrt(3.0_pReal) + sn(3,i) = lattice_hex_systemSlip(8,i)/CoverA + do j = 1_pInt,lattice_hex_NnonSchmid + sns(1:3,1:3,1,j,i) = 0.0_pReal + sns(1:3,1:3,2,j,i) = 0.0_pReal + enddo + enddo + do i = 1_pInt,myNtwin + td(1,i) = lattice_hex_systemTwin(1,i)*1.5_pReal + td(2,i) = (lattice_hex_systemTwin(1,i)+2.0_pReal*lattice_hex_systemTwin(2,i))*(0.5_pReal*sqrt(3.0_pReal)) + td(3,i) = lattice_hex_systemTwin(4,i)*CoverA + tn(1,i) = lattice_hex_systemTwin(5,i) + tn(2,i) = (lattice_hex_systemTwin(5,i)+2.0_pReal*lattice_hex_systemTwin(6,i))/sqrt(3.0_pReal) + tn(3,i) = lattice_hex_systemTwin(8,i)/CoverA + select case(lattice_hex_shearTwin(i)) ! from Christian & Mahajan 1995 p.29 + case (1_pInt) ! <-10.1>{10.2} + ts(i) = (3.0_pReal-CoverA*CoverA)/sqrt(3.0_pReal)/CoverA + case (2_pInt) ! <11.6>{-1-1.1} + ts(i) = 1.0_pReal/CoverA + case (3_pInt) ! <10.-2>{10.1} + ts(i) = (4.0_pReal*CoverA*CoverA-9.0_pReal)/4.0_pReal/sqrt(3.0_pReal)/CoverA + case (4_pInt) ! <11.-3>{11.2} + ts(i) = 2.0_pReal*(CoverA*CoverA-2.0_pReal)/3.0_pReal/CoverA + end select + enddo + + interactionSlipSlip => lattice_hex_interactionSlipSlip + interactionSlipTwin => lattice_hex_interactionSlipTwin + interactionTwinSlip => lattice_hex_interactionTwinSlip + interactionTwinTwin => lattice_hex_interactionTwinTwin end select if (processMe) then @@ -1064,13 +1065,14 @@ pure function lattice_symmetrizeC66(structName,C66) ! SlipTwinInteraction ! TwinSlipInteraction ! TwinTwinInteraction +! NnonSchmid !-------------------------------------------------------------------------------------------------- function lattice_configNchunks(struct) use prec, only: & pInt implicit none - integer(pInt), dimension(6) :: lattice_configNchunks + integer(pInt), dimension(7) :: lattice_configNchunks character(len=*), intent(in) :: struct select case(struct(1:3)) ! check first three chars of structure name @@ -1081,6 +1083,7 @@ function lattice_configNchunks(struct) lattice_configNchunks(4) = maxval(lattice_fcc_interactionSlipTwin) lattice_configNchunks(5) = maxval(lattice_fcc_interactionTwinSlip) lattice_configNchunks(6) = maxval(lattice_fcc_interactionTwinTwin) + lattice_configNchunks(7) = lattice_fcc_NnonSchmid case ('bcc') lattice_configNchunks(1) = count(lattice_bcc_NslipSystem > 0_pInt) lattice_configNchunks(2) = count(lattice_bcc_NtwinSystem > 0_pInt) @@ -1088,6 +1091,7 @@ function lattice_configNchunks(struct) lattice_configNchunks(4) = maxval(lattice_bcc_interactionSlipTwin) lattice_configNchunks(5) = maxval(lattice_bcc_interactionTwinSlip) lattice_configNchunks(6) = maxval(lattice_bcc_interactionTwinTwin) + lattice_configNchunks(7) = lattice_bcc_NnonSchmid case ('hex') lattice_configNchunks(1) = count(lattice_hex_NslipSystem > 0_pInt) lattice_configNchunks(2) = count(lattice_hex_NtwinSystem > 0_pInt) @@ -1095,6 +1099,7 @@ function lattice_configNchunks(struct) lattice_configNchunks(4) = maxval(lattice_hex_interactionSlipTwin) lattice_configNchunks(5) = maxval(lattice_hex_interactionTwinSlip) lattice_configNchunks(6) = maxval(lattice_hex_interactionTwinTwin) + lattice_configNchunks(7) = lattice_hex_NnonSchmid end select end function lattice_configNchunks