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

Merge branch '30_parsePhasePartOnce' into 19-NewStylePhenopowerlaw

This commit is contained in:
Martin Diehl 2018-06-26 07:38:53 +02:00
parent 6cd08a38b1 a91fa75a28
commit 6ffac60961
2 changed files with 50 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
src/config.f90
View File

@ -36,8 +36,6 @@ module config
procedure :: getInts => getInts procedure :: getInts => getInts
procedure :: getStrings => getStrings procedure :: getStrings => getStrings
procedure :: getStringsRaw => strings
end type tPartitionedStringList end type tPartitionedStringList
type(tPartitionedStringList), public :: emptyList type(tPartitionedStringList), public :: emptyList
@ -113,7 +111,7 @@ subroutine config_init()
myDebug = debug_level(debug_material) myDebug = debug_level(debug_material)
write(6,'(/,a)') ' <<<+- material init -+>>>' write(6,'(/,a)') ' <<<+- config init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
@ -444,7 +442,7 @@ character(len=65536) function getString(this,key,defaultVal,raw)
logical :: found, & logical :: found, &
split split
if (present(defaultVal)) getString = defaultVal if (present(defaultVal)) getString = trim(defaultVal)
split = merge(.not. raw,.true.,present(raw)) split = merge(.not. raw,.true.,present(raw))
found = present(defaultVal) found = present(defaultVal)
@ -464,6 +462,7 @@ character(len=65536) function getString(this,key,defaultVal,raw)
end do end do
if (.not. found) call IO_error(140_pInt,ext_msg=key) if (.not. found) call IO_error(140_pInt,ext_msg=key)
if (present(defaultVal) .and. len_trim(getString)/=len_trim(defaultVal)) write(6,*) 'mist';flush(6)
end function getString end function getString
@ -640,35 +639,4 @@ function getStrings(this,key,defaultVal,raw)
end function getStrings end function getStrings
!--------------------------------------------------------------------------------------------------
!> @brief DEPRECATED: REMOVE SOON
!--------------------------------------------------------------------------------------------------
function strings(this)
use IO, only: &
IO_error, &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=65536), dimension(:), allocatable :: strings
character(len=65536) :: string
type(tPartitionedStringList), pointer :: item
item => this%next
do while (associated(item))
string = item%string%val
GfortranBug86033: if (.not. allocated(strings)) then
allocate(strings(1),source=string)
else GfortranBug86033
strings = [strings,string]
endif GfortranBug86033
item => item%next
end do
if (size(strings) < 0_pInt) call IO_error(142_pInt) ! better to check for "allocated"?
end function strings
end module config end module config

95
src/material.f90
View File

@ -908,7 +908,7 @@ subroutine material_parseTexture
implicit none implicit none
integer(pInt) :: section, gauss, fiber, j, t, i integer(pInt) :: section, gauss, fiber, j, t, i
character(len=65536), dimension(:), allocatable :: lines character(len=65536), dimension(:), allocatable :: strings ! Values for given key in material config
integer(pInt), dimension(:), allocatable :: chunkPos integer(pInt), dimension(:), allocatable :: chunkPos
character(len=65536) :: tag character(len=65536) :: tag
@ -936,9 +936,9 @@ subroutine material_parseTexture
fiber = 0_pInt fiber = 0_pInt
if (textureConfig(t)%keyExists('axes')) then if (textureConfig(t)%keyExists('axes')) then
lines = textureConfig(t)%getStrings('axes') strings = textureConfig(t)%getStrings('axes')
do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries
select case (lines(j)) select case (strings(j))
case('x', '+x') case('x', '+x')
texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis
case('-x') case('-x')
@ -973,70 +973,71 @@ subroutine material_parseTexture
endif endif
if (textureConfig(t)%keyExists('(random)')) then if (textureConfig(t)%keyExists('(random)')) then
lines = textureConfig(t)%getStrings('(random)',raw=.true.) strings = textureConfig(t)%getStrings('(random)',raw=.true.)
do i = 1_pInt, size(lines) do i = 1_pInt, size(strings)
gauss = gauss + 1_pInt gauss = gauss + 1_pInt
texture_Gauss(1:3,gauss,t) = math_sampleRandomOri() texture_Gauss(1:3,gauss,t) = math_sampleRandomOri()
chunkPos = IO_stringPos(lines(i)) chunkPos = IO_stringPos(strings(i))
do j = 1_pInt,3_pInt,2_pInt do j = 1_pInt,3_pInt,2_pInt
select case (IO_stringValue(lines(i),chunkPos,j)) select case (IO_stringValue(strings(i),chunkPos,j))
case('scatter') case('scatter')
texture_Gauss(4,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad texture_Gauss(4,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('fraction') case('fraction')
texture_Gauss(5,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt) texture_Gauss(5,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)
end select end select
enddo enddo
enddo enddo
endif endif
lines = textureConfig(t)%getStringsRaw()
do i=1_pInt, size(lines) if (textureConfig(t)%keyExists('(gauss)')) then
chunkPos = IO_stringPos(lines(i))
tag = IO_stringValue(lines(i),chunkPos,1_pInt) ! extract key
textureType: select case(tag)
case ('(gauss)') textureType
gauss = gauss + 1_pInt gauss = gauss + 1_pInt
do j = 2_pInt,10_pInt,2_pInt strings = textureConfig(t)%getStrings('(gauss)',raw= .true.)
tag = IO_stringValue(lines(i),chunkPos,j) do i = 1_pInt , size(strings)
select case (tag) chunkPos = IO_stringPos(strings(i))
do j = 1_pInt,9_pInt,2_pInt
select case (IO_stringValue(strings(i),chunkPos,j))
case('phi1') case('phi1')
texture_Gauss(1,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('phi') case('phi')
texture_Gauss(2,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('phi2') case('phi2')
texture_Gauss(3,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('scatter') case('scatter')
texture_Gauss(4,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad texture_Gauss(4,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('fraction') case('fraction')
texture_Gauss(5,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt) texture_Gauss(5,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)
end select end select
enddo enddo
enddo
endif
if (textureConfig(t)%keyExists('(fiber)')) then
gauss = gauss + 1_pInt
strings = textureConfig(t)%getStrings('(fiber)',raw= .true.)
do i = 1_pInt, size(strings)
chunkPos = IO_stringPos(strings(i))
do j = 1_pInt,11_pInt,2_pInt
select case (IO_stringValue(strings(i),chunkPos,j))
case('alpha1')
texture_Fiber(1,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('alpha2')
texture_Fiber(2,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('beta1')
texture_Fiber(3,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('beta2')
texture_Fiber(4,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('scatter')
texture_Fiber(5,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('fraction')
texture_Fiber(6,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)
end select
enddo
enddo
endif
enddo
case ('(fiber)') textureType
fiber = fiber + 1_pInt
do j = 2_pInt,12_pInt,2_pInt
tag = IO_stringValue(lines(i),chunkPos,j)
select case (tag)
case('alpha1')
texture_Fiber(1,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('alpha2')
texture_Fiber(2,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('beta1')
texture_Fiber(3,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('beta2')
texture_Fiber(4,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('scatter')
texture_Fiber(5,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('fraction')
texture_Fiber(6,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)
end select
enddo
end select textureType
enddo
enddo
end subroutine material_parseTexture end subroutine material_parseTexture