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

general polishing

This commit is contained in:
Martin Diehl 2013-03-28 13:50:20 +00:00
parent 39221818dd
commit d59e072209
1 changed files with 152 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

270
code/material.f90
View File

@ -35,13 +35,13 @@ module material
implicit none implicit none
private private
character(len=64), parameter, public :: & character(len=64), parameter, public :: &
material_configFile = 'material.config', & !< generic name for material configuration file material_CONFIGFILE = 'material.config', & !< generic name for material configuration file
material_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file material_LOCALFILEEXT = 'materialConfig' !< extension of solver job name depending material configuration file
character(len=32), parameter, public :: & character(len=32), parameter, public :: &
material_partHomogenization = 'homogenization', & !< keyword for homogenization part material_PARTHOMOGENIZATION = 'homogenization', & !< keyword for homogenization part
material_partCrystallite = 'crystallite', & !< keyword for crystallite part material_PARTCRYSTALLITE = 'crystallite', & !< keyword for crystallite part
material_partPhase = 'phase' !< keyword for phase part material_PARTPHASE = 'phase' !< keyword for phase part
character(len=64), dimension(:), allocatable, public, protected :: & character(len=64), dimension(:), allocatable, public, protected :: &
phase_elasticity, & !< elasticity of each phase phase_elasticity, & !< elasticity of each phase
@ -83,8 +83,8 @@ module material
character(len=32), parameter, private :: & character(len=32), parameter, private :: &
material_partMicrostructure = 'microstructure', & !< keyword for microstructure part material_PARTMICROSTRUCTURE = 'microstructure', & !< keyword for microstructure part
material_partTexture = 'texture' !< keyword for texture part material_PARTTEXTURE = 'texture' !< keyword for texture part
character(len=64), dimension(:), allocatable, private :: & character(len=64), dimension(:), allocatable, private :: &
microstructure_name, & !< name of each microstructure microstructure_name, & !< name of each microstructure
@ -152,8 +152,7 @@ subroutine material_init
implicit none implicit none
integer(pInt), parameter :: fileunit = 200_pInt integer(pInt), parameter :: fileunit = 200_pInt
integer(pInt) :: i,j, myDebug integer(pInt) :: m,c,h, myDebug
myDebug = debug_level(debug_material) myDebug = debug_level(debug_material)
write(6,'(/,a)') ' <<<+- material init -+>>>' write(6,'(/,a)') ' <<<+- material init -+>>>'
@ -161,69 +160,70 @@ subroutine material_init
write(6,'(a16,a)') ' Current time : ',IO_timeStamp() write(6,'(a16,a)') ' Current time : ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
if (.not. IO_open_jobFile_stat(fileunit,material_localFileExt)) then ! no local material configuration present...
if (.not. IO_open_jobFile_stat(fileunit,material_localFileExt)) then ! no local material configuration present... call IO_open_file(fileunit,material_configFile) ! ...open material.config file
call IO_open_file(fileunit,material_configFile) ! ...open material.config file
endif endif
call material_parseHomogenization(fileunit,material_partHomogenization) call material_parseHomogenization(fileunit,material_partHomogenization)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
write(6,*) 'Homogenization parsed' write(6,'(a)') ' Homogenization parsed'
endif endif
call material_parseMicrostructure(fileunit,material_partMicrostructure) call material_parseMicrostructure(fileunit,material_partMicrostructure)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
write(6,*) 'Microstructure parsed' write(6,'(a)') ' Microstructure parsed'
endif endif
call material_parseCrystallite(fileunit,material_partCrystallite) call material_parseCrystallite(fileunit,material_partCrystallite)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
write(6,*) 'Crystallite parsed' write(6,'(a)') ' Crystallite parsed'
endif endif
call material_parseTexture(fileunit,material_partTexture) call material_parseTexture(fileunit,material_partTexture)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
write(6,*) 'Texture parsed' write(6,'(a)') ' Texture parsed'
endif endif
call material_parsePhase(fileunit,material_partPhase) call material_parsePhase(fileunit,material_partPhase)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
write(6,*) 'Phase parsed' write(6,'(a)') ' Phase parsed'
endif endif
close(fileunit) close(fileunit)
do i = 1_pInt,material_Nmicrostructure do m = 1_pInt,material_Nmicrostructure
if (microstructure_crystallite(i) < 1_pInt .or. & if (microstructure_crystallite(m) < 1_pInt .or. &
microstructure_crystallite(i) > material_Ncrystallite) call IO_error(150_pInt,i) microstructure_crystallite(m) > material_Ncrystallite) &
if (minval(microstructure_phase(1:microstructure_Nconstituents(i),i)) < 1_pInt .or. & call IO_error(150_pInt,m)
maxval(microstructure_phase(1:microstructure_Nconstituents(i),i)) > material_Nphase) call IO_error(151_pInt,i) if (minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. &
if (minval(microstructure_texture(1:microstructure_Nconstituents(i),i)) < 1_pInt .or. & maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > material_Nphase) &
maxval(microstructure_texture(1:microstructure_Nconstituents(i),i)) > material_Ntexture) call IO_error(152_pInt,i) call IO_error(151_pInt,m)
if (abs(sum(microstructure_fraction(:,i)) - 1.0_pReal) >= 1.0e-10_pReal) then if (minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. &
maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > material_Ntexture) &
call IO_error(152_pInt,m)
if (abs(sum(microstructure_fraction(:,m)) - 1.0_pReal) >= 1.0e-10_pReal) then
if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then
write(6,*)'sum of microstructure fraction = ',sum(microstructure_fraction(:,i)) write(6,'(a)') ' sum of microstructure fraction = ',sum(microstructure_fraction(:,m))
endif endif
call IO_error(153_pInt,i) call IO_error(153_pInt,m)
endif endif
enddo enddo
if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then debugOut: if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then
write(6,'(/,a,/)') ' MATERIAL configuration' write(6,'(/,a,/)') ' MATERIAL configuration'
write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains'
do i = 1_pInt,material_Nhomogenization do h = 1_pInt,material_Nhomogenization
write(6,'(1x,a32,1x,a16,1x,i4)') homogenization_name(i),homogenization_type(i),homogenization_Ngrains(i) write(6,'(1x,a32,1x,a16,1x,i4)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h)
enddo enddo
write(6,*) write(6,'(/,a32,19x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents','homogeneous'
write(6,'(a32,1x,a11,1x,a12,1x,a13)') 'microstructure ','crystallite','constituents','homogeneous' do m = 1_pInt,material_Nmicrostructure
do i = 1_pInt,material_Nmicrostructure write(6,'(a32,4x,i4,8x,i4,8x,l1)') microstructure_name(m), &
write(6,'(a32,4x,i4,8x,i4,8x,l1)') microstructure_name(i), & microstructure_crystallite(m), &
microstructure_crystallite(i), & microstructure_Nconstituents(m), &
microstructure_Nconstituents(i), & microstructure_elemhomo(m)
microstructure_elemhomo(i) if (microstructure_Nconstituents(m) > 0_pInt) then
if (microstructure_Nconstituents(i) > 0_pInt) then do c = 1_pInt,microstructure_Nconstituents(m)
do j = 1_pInt,microstructure_Nconstituents(i) write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(c,m)),&
write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(j,i)),& texture_name(microstructure_texture(c,m)),&
texture_name(microstructure_texture(j,i)),& microstructure_fraction(c,m)
microstructure_fraction(j,i)
enddo enddo
write(6,*) write(6,*)
endif endif
enddo enddo
endif endif debugOut
call material_populateGrains call material_populateGrains
@ -234,7 +234,17 @@ end subroutine material_init
!> @brief parses the homogenization part in the material configuration file !> @brief parses the homogenization part in the material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine material_parseHomogenization(myFile,myPart) subroutine material_parseHomogenization(myFile,myPart)
use IO use IO, only: &
IO_globalTagInPart, &
IO_countSections, &
IO_error, &
IO_countTagInPart, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringValue, &
IO_intValue, &
IO_stringPos
use mesh, only: & use mesh, only: &
mesh_element mesh_element
@ -256,15 +266,15 @@ subroutine material_parseHomogenization(myFile,myPart)
material_Nhomogenization = Nsections material_Nhomogenization = Nsections
if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart)
allocate(homogenization_name(Nsections)); homogenization_name = '' allocate(homogenization_name(Nsections)); homogenization_name = ''
allocate(homogenization_type(Nsections)); homogenization_type = '' allocate(homogenization_type(Nsections)); homogenization_type = ''
allocate(homogenization_typeInstance(Nsections)); homogenization_typeInstance = 0_pInt allocate(homogenization_typeInstance(Nsections)); homogenization_typeInstance = 0_pInt
allocate(homogenization_Ngrains(Nsections)); homogenization_Ngrains = 0_pInt allocate(homogenization_Ngrains(Nsections)); homogenization_Ngrains = 0_pInt
allocate(homogenization_Noutput(Nsections)); homogenization_Noutput = 0_pInt allocate(homogenization_Noutput(Nsections)); homogenization_Noutput = 0_pInt
allocate(homogenization_active(Nsections)); homogenization_active = .false. allocate(homogenization_active(Nsections)); homogenization_active = .false.
forall (s = 1_pInt:Nsections) homogenization_active(s) = any(mesh_element(3,:) == s) ! current homogenization used in model? Homogenization view, maximum operations depend on maximum number of homog schemes forall (s = 1_pInt:Nsections) homogenization_active(s) = any(mesh_element(3,:) == s) ! current homogenization used in model? Homogenization view, maximum operations depend on maximum number of homog schemes
homogenization_Noutput = IO_countTagInPart(myFile,myPart,'(output)',Nsections) homogenization_Noutput = IO_countTagInPart(myFile,myPart,'(output)',Nsections)
rewind(myFile) rewind(myFile)
line = '' line = ''
@ -273,7 +283,7 @@ subroutine material_parseHomogenization(myFile,myPart)
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
enddo enddo
if (echo) write(6,*) trim(line) ! echo part header if (echo) write(6,'(a)') trim(line) ! echo part header
do do
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
@ -302,7 +312,7 @@ subroutine material_parseHomogenization(myFile,myPart)
100 homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active) 100 homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active)
end subroutine material_parseHomogenization end subroutine material_parseHomogenization
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -352,8 +362,9 @@ subroutine material_parseMicrostructure(myFile,myPart)
microstructure_fraction = 0.0_pReal microstructure_fraction = 0.0_pReal
rewind(myFile) rewind(myFile)
line = '' line = '' ! to have it initialized
section = 0_pInt section = 0_pInt ! - " -
constituent = 0_pInt ! - " -
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
@ -456,8 +467,18 @@ subroutine material_parseCrystallite(myFile,myPart)
!> @brief parses the phase part in the material configuration file !> @brief parses the phase part in the material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine material_parsePhase(myFile,myPart) subroutine material_parsePhase(myFile,myPart)
use IO use IO, only: &
IO_globalTagInPart, &
IO_countSections, &
IO_error, &
IO_countTagInPart, &
IO_getTag, &
IO_spotTagInPart, &
IO_lc, &
IO_isBlank, &
IO_stringValue, &
IO_stringPos
implicit none implicit none
character(len=*), intent(in) :: myPart character(len=*), intent(in) :: myPart
integer(pInt), intent(in) :: myFile integer(pInt), intent(in) :: myFile
@ -476,13 +497,13 @@ subroutine material_parsePhase(myFile,myPart)
material_Nphase = Nsections material_Nphase = Nsections
if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart)
allocate(phase_name(Nsections)); phase_name = '' allocate(phase_name(Nsections)); phase_name = ''
allocate(phase_elasticity(Nsections)); phase_elasticity = '' allocate(phase_elasticity(Nsections)); phase_elasticity = ''
allocate(phase_elasticityInstance(Nsections)); phase_elasticityInstance = 0_pInt allocate(phase_elasticityInstance(Nsections)); phase_elasticityInstance = 0_pInt
allocate(phase_plasticity(Nsections)); phase_plasticity = '' allocate(phase_plasticity(Nsections)); phase_plasticity = ''
allocate(phase_plasticityInstance(Nsections)); phase_plasticityInstance = 0_pInt allocate(phase_plasticityInstance(Nsections)); phase_plasticityInstance = 0_pInt
allocate(phase_Noutput(Nsections)) allocate(phase_Noutput(Nsections)); phase_Noutput = 0_pInt
allocate(phase_localPlasticity(Nsections)) allocate(phase_localPlasticity(Nsections)); phase_localPlasticity = .false.
phase_Noutput = IO_countTagInPart(myFile,myPart,'(output)',Nsections) phase_Noutput = IO_countTagInPart(myFile,myPart,'(output)',Nsections)
phase_localPlasticity = .not. IO_spotTagInPart(myFile,myPart,'/nonlocal/',Nsections) phase_localPlasticity = .not. IO_spotTagInPart(myFile,myPart,'/nonlocal/',Nsections)
@ -532,7 +553,18 @@ subroutine material_parsePhase(myFile,myPart)
!> @brief parses the texture part in the material configuration file !> @brief parses the texture part in the material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine material_parseTexture(myFile,myPart) subroutine material_parseTexture(myFile,myPart)
use IO use IO, only: &
IO_globalTagInPart, &
IO_countSections, &
IO_error, &
IO_countTagInPart, &
IO_getTag, &
IO_spotTagInPart, &
IO_lc, &
IO_isBlank, &
IO_floatValue, &
IO_stringValue, &
IO_stringPos
use math, only: & use math, only: &
inRad, & inRad, &
math_sampleRandomOri math_sampleRandomOri
@ -544,7 +576,7 @@ subroutine material_parseTexture(myFile,myPart)
integer(pInt), parameter :: maxNchunks = 13_pInt integer(pInt), parameter :: maxNchunks = 13_pInt
integer(pInt), dimension(1+2*maxNchunks) :: positions integer(pInt), dimension(1+2*maxNchunks) :: positions
integer(pInt) :: Nsections, section, gauss, fiber, i integer(pInt) :: Nsections, section, gauss, fiber, j
character(len=64) :: tag character(len=64) :: tag
character(len=1024) :: line character(len=1024) :: line
logical :: echo logical :: echo
@ -570,19 +602,21 @@ subroutine material_parseTexture(myFile,myPart)
allocate(texture_Fiber (6,texture_maxNfiber,Nsections)); texture_Fiber = 0.0_pReal allocate(texture_Fiber (6,texture_maxNfiber,Nsections)); texture_Fiber = 0.0_pReal
rewind(myFile) rewind(myFile)
line = '' line = '' ! to have in initialized
section = 0_pInt section = 0_pInt ! - " -
gauss = 0_pInt ! - " -
fiber = 0_pInt ! - " -
do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart do while (IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to myPart
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
enddo enddo
if (echo) write(6,*) trim(line) ! echo part header if (echo) write(6,'(a)') trim(line) ! echo part header
do do
read(myFile,'(a1024)',END=100) line read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (echo) write(6,*) trim(line) ! echo back read lines if (echo) write(6,'(a)') trim(line) ! echo back read lines
if (IO_getTag(line,'[',']') /= '') then ! next section if (IO_getTag(line,'[',']') /= '') then ! next section
section = section + 1_pInt section = section + 1_pInt
gauss = 0_pInt gauss = 0_pInt
@ -592,12 +626,12 @@ subroutine material_parseTexture(myFile,myPart)
if (section > 0_pInt) then if (section > 0_pInt) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag) textureType: select case(tag)
case ('hybridia') case ('hybridia') textureType
texture_ODFfile(section) = IO_stringValue(line,positions,2_pInt) texture_ODFfile(section) = IO_stringValue(line,positions,2_pInt)
case ('symmetry') case ('symmetry') textureType
tag = IO_lc(IO_stringValue(line,positions,2_pInt)) tag = IO_lc(IO_stringValue(line,positions,2_pInt))
select case (tag) select case (tag)
case('orthotropic') case('orthotropic')
@ -608,58 +642,58 @@ subroutine material_parseTexture(myFile,myPart)
texture_symmetry(section) = 1_pInt texture_symmetry(section) = 1_pInt
end select end select
case ('(random)') case ('(random)') textureType
gauss = gauss + 1_pInt gauss = gauss + 1_pInt
texture_Gauss(1:3,gauss,section) = math_sampleRandomOri() texture_Gauss(1:3,gauss,section) = math_sampleRandomOri()
do i = 2_pInt,4_pInt,2_pInt do j = 2_pInt,4_pInt,2_pInt
tag = IO_lc(IO_stringValue(line,positions,i)) tag = IO_lc(IO_stringValue(line,positions,j))
select case (tag) select case (tag)
case('scatter') case('scatter')
texture_Gauss(4,gauss,section) = IO_floatValue(line,positions,i+1_pInt)*inRad texture_Gauss(4,gauss,section) = IO_floatValue(line,positions,j+1_pInt)*inRad
case('fraction') case('fraction')
texture_Gauss(5,gauss,section) = IO_floatValue(line,positions,i+1_pInt) texture_Gauss(5,gauss,section) = IO_floatValue(line,positions,j+1_pInt)
end select end select
enddo enddo
case ('(gauss)') case ('(gauss)') textureType
gauss = gauss + 1_pInt gauss = gauss + 1_pInt
do i = 2_pInt,10_pInt,2_pInt do j = 2_pInt,10_pInt,2_pInt
tag = IO_lc(IO_stringValue(line,positions,i)) tag = IO_lc(IO_stringValue(line,positions,j))
select case (tag) select case (tag)
case('phi1') case('phi1')
texture_Gauss(1,gauss,section) = IO_floatValue(line,positions,i+1_pInt)*inRad texture_Gauss(1,gauss,section) = IO_floatValue(line,positions,j+1_pInt)*inRad
case('phi') case('phi')
texture_Gauss(2,gauss,section) = IO_floatValue(line,positions,i+1_pInt)*inRad texture_Gauss(2,gauss,section) = IO_floatValue(line,positions,j+1_pInt)*inRad
case('phi2') case('phi2')
texture_Gauss(3,gauss,section) = IO_floatValue(line,positions,i+1_pInt)*inRad texture_Gauss(3,gauss,section) = IO_floatValue(line,positions,j+1_pInt)*inRad
case('scatter') case('scatter')
texture_Gauss(4,gauss,section) = IO_floatValue(line,positions,i+1_pInt)*inRad texture_Gauss(4,gauss,section) = IO_floatValue(line,positions,j+1_pInt)*inRad
case('fraction') case('fraction')
texture_Gauss(5,gauss,section) = IO_floatValue(line,positions,i+1_pInt) texture_Gauss(5,gauss,section) = IO_floatValue(line,positions,j+1_pInt)
end select end select
enddo enddo
case ('(fiber)') case ('(fiber)') textureType
fiber = fiber + 1_pInt fiber = fiber + 1_pInt
do i = 2_pInt,12_pInt,2_pInt do j = 2_pInt,12_pInt,2_pInt
tag = IO_lc(IO_stringValue(line,positions,i)) tag = IO_lc(IO_stringValue(line,positions,j))
select case (tag) select case (tag)
case('alpha1') case('alpha1')
texture_Fiber(1,fiber,section) = IO_floatValue(line,positions,i+1_pInt)*inRad texture_Fiber(1,fiber,section) = IO_floatValue(line,positions,j+1_pInt)*inRad
case('alpha2') case('alpha2')
texture_Fiber(2,fiber,section) = IO_floatValue(line,positions,i+1_pInt)*inRad texture_Fiber(2,fiber,section) = IO_floatValue(line,positions,j+1_pInt)*inRad
case('beta1') case('beta1')
texture_Fiber(3,fiber,section) = IO_floatValue(line,positions,i+1_pInt)*inRad texture_Fiber(3,fiber,section) = IO_floatValue(line,positions,j+1_pInt)*inRad
case('beta2') case('beta2')
texture_Fiber(4,fiber,section) = IO_floatValue(line,positions,i+1_pInt)*inRad texture_Fiber(4,fiber,section) = IO_floatValue(line,positions,j+1_pInt)*inRad
case('scatter') case('scatter')
texture_Fiber(5,fiber,section) = IO_floatValue(line,positions,i+1_pInt)*inRad texture_Fiber(5,fiber,section) = IO_floatValue(line,positions,j+1_pInt)*inRad
case('fraction') case('fraction')
texture_Fiber(6,fiber,section) = IO_floatValue(line,positions,i+1_pInt) texture_Fiber(6,fiber,section) = IO_floatValue(line,positions,j+1_pInt)
end select end select
enddo enddo
end select end select textureType
endif endif
enddo enddo
@ -740,7 +774,7 @@ subroutine material_populateGrains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! identify maximum grain count per IP (from element) and find grains per homog/micro pair ! identify maximum grain count per IP (from element) and find grains per homog/micro pair
Nelems = 0_pInt ! reuse as counter Nelems = 0_pInt ! reuse as counter
do e = 1_pInt,mesh_NcpElems elementLooping: do e = 1_pInt,mesh_NcpElems
t = FE_geomtype(mesh_element(2,e)) t = FE_geomtype(mesh_element(2,e))
homog = mesh_element(3,e) homog = mesh_element(3,e)
micro = mesh_element(4,e) micro = mesh_element(4,e)
@ -757,7 +791,7 @@ subroutine material_populateGrains
Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt
elemsOfHomogMicro(homog,micro)%p(Nelems(homog,micro)) = e ! remember elements active in this homog/micro pair elemsOfHomogMicro(homog,micro)%p(Nelems(homog,micro)) = e ! remember elements active in this homog/micro pair
enddo enddo elementLooping
allocate(volumeOfGrain(maxval(Ngrains))) ! reserve memory for maximum case allocate(volumeOfGrain(maxval(Ngrains))) ! reserve memory for maximum case
allocate(phaseOfGrain(maxval(Ngrains))) ! reserve memory for maximum case allocate(phaseOfGrain(maxval(Ngrains))) ! reserve memory for maximum case
allocate(textureOfGrain(maxval(Ngrains))) ! reserve memory for maximum case allocate(textureOfGrain(maxval(Ngrains))) ! reserve memory for maximum case
@ -765,9 +799,7 @@ subroutine material_populateGrains
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) write(6,'(/,a/)') ' MATERIAL grain population'
write(6,*) 'MATERIAL grain population'
write(6,*)
write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#' write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#'
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
endif endif
@ -778,8 +810,7 @@ subroutine material_populateGrains
myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) write(6,'(/,a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains
write(6,'(a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
endif endif
@ -806,40 +837,41 @@ subroutine material_populateGrains
! divide myNgrains as best over constituents ! divide myNgrains as best over constituents
NgrainsOfConstituent = 0_pInt NgrainsOfConstituent = 0_pInt
forall (i = 1_pInt:microstructure_Nconstituents(micro)) & forall (i = 1_pInt:microstructure_Nconstituents(micro)) &
NgrainsOfConstituent(i) = nint(microstructure_fraction(i,micro) * myNgrains, pInt) ! do rounding integer conversion NgrainsOfConstituent(i) = nint(microstructure_fraction(i,micro) * myNgrains, pInt) ! do rounding integer conversion
do while (sum(NgrainsOfConstituent) /= myNgrains) ! total grain count over constituents wrong? do while (sum(NgrainsOfConstituent) /= myNgrains) ! total grain count over constituents wrong?
sgn = sign(1_pInt, myNgrains - sum(NgrainsOfConstituent)) ! direction of required change sgn = sign(1_pInt, myNgrains - sum(NgrainsOfConstituent)) ! direction of required change
extreme = 0.0_pReal extreme = 0.0_pReal
t = 0_pInt t = 0_pInt
do i = 1_pInt,microstructure_Nconstituents(micro) ! find largest deviator do i = 1_pInt,microstructure_Nconstituents(micro) ! find largest deviator
if (real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro)) > extreme) then if (real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro)) > extreme) then
extreme = real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro)) extreme = real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro))
t = i t = i
endif endif
enddo enddo
NgrainsOfConstituent(t) = NgrainsOfConstituent(t) + sgn ! change that by one NgrainsOfConstituent(t) = NgrainsOfConstituent(t) + sgn ! change that by one
enddo enddo
phaseOfGrain = 0_pInt phaseOfGrain = 0_pInt
textureOfGrain = 0_pInt textureOfGrain = 0_pInt
orientationOfGrain = 0.0_pReal orientationOfGrain = 0.0_pReal
grain = 0_pInt ! reset microstructure grain index grain = 0_pInt ! reset microstructure grain index
constituents: do i = 1_pInt,microstructure_Nconstituents(micro) ! loop over constituents constituents: do i = 1_pInt,microstructure_Nconstituents(micro) ! loop over constituents
phaseID = microstructure_phase(i,micro) phaseID = microstructure_phase(i,micro)
textureID = microstructure_texture(i,micro) textureID = microstructure_texture(i,micro)
phaseOfGrain(grain+1_pInt:grain+NgrainsOfConstituent(i)) = phaseID ! assign resp. phase phaseOfGrain(grain+1_pInt:grain+NgrainsOfConstituent(i)) = phaseID ! assign resp. phase
textureOfGrain(grain+1_pInt:grain+NgrainsOfConstituent(i)) = textureID ! assign resp. texture textureOfGrain(grain+1_pInt:grain+NgrainsOfConstituent(i)) = textureID ! assign resp. texture
myNorientations = ceiling(real(NgrainsOfConstituent(i),pReal)/& myNorientations = ceiling(real(NgrainsOfConstituent(i),pReal)/&
real(texture_symmetry(textureID),pReal),pInt) ! max number of unique orientations (excl. symmetry) real(texture_symmetry(textureID),pReal),pInt) ! max number of unique orientations (excl. symmetry)
constituentGrain = 0_pInt ! constituent grain index
constituentGrain = 0_pInt ! constituent grain index
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! dealing with texture components ! dealing with texture components
if (texture_ODFfile(textureID) == '') then if (texture_ODFfile(textureID) == '') then
do t = 1_pInt,texture_Ngauss(textureID) ! loop over Gauss components do t = 1_pInt,texture_Ngauss(textureID) ! loop over Gauss components
do g = 1_pInt,int(myNorientations*texture_Gauss(5,t,textureID),pInt) ! loop over required grain count do g = 1_pInt,int(myNorientations*texture_Gauss(5,t,textureID),pInt) ! loop over required grain count
orientationOfGrain(:,grain+constituentGrain+g) = & orientationOfGrain(:,grain+constituentGrain+g) = &
math_sampleGaussOri(texture_Gauss(1:3,t,textureID),& math_sampleGaussOri(texture_Gauss(1:3,t,textureID),&
texture_Gauss( 4,t,textureID)) texture_Gauss( 4,t,textureID))
@ -847,8 +879,8 @@ subroutine material_populateGrains
constituentGrain = constituentGrain + int(myNorientations*texture_Gauss(5,t,textureID)) constituentGrain = constituentGrain + int(myNorientations*texture_Gauss(5,t,textureID))
enddo enddo
do t = 1_pInt,texture_Nfiber(textureID) ! loop over fiber components do t = 1_pInt,texture_Nfiber(textureID) ! loop over fiber components
do g = 1_pInt,int(myNorientations*texture_Fiber(6,t,textureID),pInt) ! loop over required grain count do g = 1_pInt,int(myNorientations*texture_Fiber(6,t,textureID),pInt) ! loop over required grain count
orientationOfGrain(:,grain+constituentGrain+g) = & orientationOfGrain(:,grain+constituentGrain+g) = &
math_sampleFiberOri(texture_Fiber(1:2,t,textureID),& math_sampleFiberOri(texture_Fiber(1:2,t,textureID),&
texture_Fiber(3:4,t,textureID),& texture_Fiber(3:4,t,textureID),&
@ -861,6 +893,7 @@ subroutine material_populateGrains
orientationOfGrain(:,grain+j) = math_sampleRandomOri() orientationOfGrain(:,grain+j) = math_sampleRandomOri()
enddo enddo
else else
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! hybrid IA ! hybrid IA
orientationOfGrain(:,grain+1:grain+myNorientations) = IO_hybridIA(myNorientations,texture_ODFfile(textureID)) orientationOfGrain(:,grain+1:grain+myNorientations) = IO_hybridIA(myNorientations,texture_ODFfile(textureID))
@ -886,7 +919,7 @@ subroutine material_populateGrains
grain = grain + NgrainsOfConstituent(i) ! advance microstructure grain index grain = grain + NgrainsOfConstituent(i) ! advance microstructure grain index
enddo constituents enddo constituents
!--------------------------------------------------------------------------------------------------
! unless element homogeneous, reshuffle grains ! unless element homogeneous, reshuffle grains
if (.not. microstructure_elemhomo(micro)) then if (.not. microstructure_elemhomo(micro)) then
do i=1_pInt,myNgrains-1_pInt ! walk thru grains do i=1_pInt,myNgrains-1_pInt ! walk thru grains
@ -905,7 +938,7 @@ subroutine material_populateGrains
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calc fraction after weighing with volumePerGrain, exchange in MC steps to improve result... ! calc fraction after weighing with volumePerGrain, exchange in MC steps to improve result
grain = 0_pInt grain = 0_pInt
do hme = 1_pInt, Nelems(homog,micro) do hme = 1_pInt, Nelems(homog,micro)
e = elemsOfHomogMicro(homog,micro)%p(hme) ! only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex e = elemsOfHomogMicro(homog,micro)%p(hme) ! only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
@ -938,9 +971,10 @@ subroutine material_populateGrains
deallocate(textureOfGrain) deallocate(textureOfGrain)
deallocate(orientationOfGrain) deallocate(orientationOfGrain)
deallocate(Nelems) deallocate(Nelems)
!> ToDo - causing segmentation fault: needs looking into
!do homog = 1,material_Nhomogenization !do homog = 1,material_Nhomogenization
! do micro = 1,material_Nmicrostructure ! do micro = 1,material_Nmicrostructure
! if (Nelems(homog,micro) > 0_pInt) deallocate(elemsOfHomogMicro(homog,micro)%p) ! ToDo - causing segmentation fault: needs looking into ! if (Nelems(homog,micro) > 0_pInt) deallocate(elemsOfHomogMicro(homog,micro)%p)
! enddo ! enddo
!enddo !enddo
deallocate(elemsOfHomogMicro) deallocate(elemsOfHomogMicro)