223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

require all hardening coefficients/ non schmid coefficients to be specified in material.config, do not silently ignore any 

warning message now more meaningful (?) when using less than maximum number of slip families
This commit is contained in:
Christoph Kords 2013-09-12 14:47:09 +00:00
parent a17b85cba8
commit 5f973a21c0
6 changed files with 145 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
code/IO.f90
View File

@ -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)

28
code/constitutive_dislotwin.f90
View File

@ -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

25
code/constitutive_nonlocal.f90
View File

@ -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')

53
code/constitutive_phenopowerlaw.f90
View File

@ -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

2
code/constitutive_titanmod.f90
View File

@ -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, &

99
code/lattice.f90
View File

@ -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