Merge branch '30_parsePhasePartOnce' into 19-NewStylePhenopowerlaw

This commit is contained in:
Martin Diehl 2018-06-26 07:38:53 +02:00
commit 6ffac60961
2 changed files with 50 additions and 81 deletions

View File

@ -36,8 +36,6 @@ module config
procedure :: getInts => getInts
procedure :: getStrings => getStrings
procedure :: getStringsRaw => strings
end type tPartitionedStringList
type(tPartitionedStringList), public :: emptyList
@ -113,7 +111,7 @@ subroutine config_init()
myDebug = debug_level(debug_material)
write(6,'(/,a)') ' <<<+- material init -+>>>'
write(6,'(/,a)') ' <<<+- config init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
@ -444,7 +442,7 @@ character(len=65536) function getString(this,key,defaultVal,raw)
logical :: found, &
split
if (present(defaultVal)) getString = defaultVal
if (present(defaultVal)) getString = trim(defaultVal)
split = merge(.not. raw,.true.,present(raw))
found = present(defaultVal)
@ -464,6 +462,7 @@ character(len=65536) function getString(this,key,defaultVal,raw)
end do
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
@ -640,35 +639,4 @@ function getStrings(this,key,defaultVal,raw)
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

View File

@ -908,7 +908,7 @@ subroutine material_parseTexture
implicit none
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
character(len=65536) :: tag
@ -936,9 +936,9 @@ subroutine material_parseTexture
fiber = 0_pInt
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
select case (lines(j))
select case (strings(j))
case('x', '+x')
texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis
case('-x')
@ -973,70 +973,71 @@ subroutine material_parseTexture
endif
if (textureConfig(t)%keyExists('(random)')) then
lines = textureConfig(t)%getStrings('(random)',raw=.true.)
do i = 1_pInt, size(lines)
strings = textureConfig(t)%getStrings('(random)',raw=.true.)
do i = 1_pInt, size(strings)
gauss = gauss + 1_pInt
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
select case (IO_stringValue(lines(i),chunkPos,j))
select case (IO_stringValue(strings(i),chunkPos,j))
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')
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
enddo
enddo
endif
lines = textureConfig(t)%getStringsRaw()
do i=1_pInt, size(lines)
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
do j = 2_pInt,10_pInt,2_pInt
tag = IO_stringValue(lines(i),chunkPos,j)
select case (tag)
if (textureConfig(t)%keyExists('(gauss)')) then
gauss = gauss + 1_pInt
strings = textureConfig(t)%getStrings('(gauss)',raw= .true.)
do i = 1_pInt , size(strings)
chunkPos = IO_stringPos(strings(i))
do j = 1_pInt,9_pInt,2_pInt
select case (IO_stringValue(strings(i),chunkPos,j))
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')
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')
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')
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')
texture_Gauss(5,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)
end select
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)
texture_Gauss(5,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)
end select
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(lines(i),chunkPos,j+1_pInt)*inRad
texture_Fiber(1,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('alpha2')
texture_Fiber(2,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
texture_Fiber(2,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('beta1')
texture_Fiber(3,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
texture_Fiber(3,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('beta2')
texture_Fiber(4,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
texture_Fiber(4,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
case('scatter')
texture_Fiber(5,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
texture_Fiber(5,fiber,t) = IO_floatValue(strings(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
texture_Fiber(6,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)
end select
enddo
enddo
endif
enddo
end subroutine material_parseTexture