From 300b2827b29f0b215b7c4d1de5f7120149fe058b Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Mon, 25 Jun 2018 15:28:15 +0200 Subject: [PATCH 1/2] Using new functions for parsing material config --- src/config.f90 | 33 ----------------- src/material.f90 | 93 ++++++++++++++++++++++++------------------------ 2 files changed, 47 insertions(+), 79 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 68f06e7a2..9b229b2ec 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -36,8 +36,6 @@ module config procedure :: getInts => getInts procedure :: getStrings => getStrings - procedure :: getStringsRaw => strings - end type tPartitionedStringList type(tPartitionedStringList), public :: emptyList @@ -640,35 +638,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 diff --git a/src/material.f90 b/src/material.f90 index 5462f3e9d..5b005d87c 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -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 From a91fa75a2826fc27e02e4ba2a829c899c0b41c1b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 07:38:03 +0200 Subject: [PATCH 2/2] sanity check, something is going wrong with intel 16.0 --- src/config.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 9b229b2ec..a469019ae 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -111,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" @@ -442,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) @@ -462,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