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

clearer structure

This commit is contained in:
Martin Diehl 2020-02-25 17:32:49 +01:00
parent 605e976915
commit 4889e75e52
1 changed files with 320 additions and 337 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/lattice.f90
View File

@ -550,13 +550,12 @@ subroutine lattice_init
allocate(lattice_mu(Nphases), source=0.0_pReal)
allocate(lattice_nu(Nphases), source=0.0_pReal)
allocate(lattice_Scleavage(3,3,3,lattice_maxNcleavage,Nphases),source=0.0_pReal)
allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0)
do p = 1, size(config_phase)
tag = config_phase(p)%getString('lattice_structure')
select case(trim(tag(1:3)))
select case(tag(1:3))
case('iso')
lattice_structure(p) = LATTICE_iso_ID
case('fcc')
@ -569,6 +568,8 @@ subroutine lattice_init
lattice_structure(p) = LATTICE_bct_ID
case('ort')
lattice_structure(p) = LATTICE_ort_ID
case default
call IO_error(130,ext_msg='lattice_init')
end select
@ -624,8 +625,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA)
CoverA
integer :: &
i, &
myNcleavage
i
lattice_C66(1:6,1:6,myPhase) = lattice_symmetrizeC66(lattice_structure(myPhase),&
lattice_C66(1:6,1:6,myPhase))
@ -655,51 +655,34 @@ subroutine lattice_initializeStructure(myPhase,CoverA)
lattice_thermalConductivity33 (1:3,1:3,myPhase))
lattice_DamageDiffusion33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),&
lattice_DamageDiffusion33 (1:3,1:3,myPhase))
myNcleavage = 0
select case(lattice_structure(myPhase))
case (LATTICE_fcc_ID)
myNcleavage = lattice_fcc_Ncleavage
lattice_NcleavageSystem(1:2,myPhase) = lattice_fcc_NcleavageSystem
lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = &
lattice_Scleavage(1:3,1:3,1:3,1:lattice_fcc_Ncleavage,myPhase) = &
lattice_SchmidMatrix_cleavage(lattice_fcc_ncleavageSystem,'fcc',covera)
case (LATTICE_bcc_ID)
myNcleavage = lattice_bcc_Ncleavage
lattice_NcleavageSystem(1:2,myPhase) = lattice_bcc_NcleavageSystem
lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = &
lattice_Scleavage(1:3,1:3,1:3,1:lattice_bcc_Ncleavage,myPhase) = &
lattice_SchmidMatrix_cleavage(lattice_bcc_ncleavagesystem,'bcc',covera)
case (LATTICE_hex_ID)
myNcleavage = lattice_hex_Ncleavage
lattice_NcleavageSystem(1:1,myPhase) = lattice_hex_NcleavageSystem
lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = &
lattice_Scleavage(1:3,1:3,1:3,1:lattice_hex_Ncleavage,myPhase) = &
lattice_SchmidMatrix_cleavage(lattice_hex_ncleavagesystem,'hex',covera)
case (LATTICE_bct_ID)
case (LATTICE_ort_ID)
myNcleavage = lattice_ort_Ncleavage
lattice_NcleavageSystem(1:3,myPhase) = lattice_ort_NcleavageSystem
lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = &
lattice_Scleavage(1:3,1:3,1:3,1:lattice_ort_Ncleavage,myPhase) = &
lattice_SchmidMatrix_cleavage(lattice_ort_NcleavageSystem,'ort',covera)
case (LATTICE_iso_ID)
myNcleavage = lattice_iso_Ncleavage
lattice_NcleavageSystem(1:1,myPhase) = lattice_iso_NcleavageSystem
lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = &
lattice_Scleavage(1:3,1:3,1:3,1:lattice_iso_Ncleavage,myPhase) = &
lattice_SchmidMatrix_cleavage(lattice_iso_NcleavageSystem,'iso',covera)
!--------------------------------------------------------------------------------------------------
! something went wrong
case default
call IO_error(130,ext_msg='lattice_initializeStructure')
end select
end subroutine lattice_initializeStructure