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

View File

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