also parsing texture only once

src/material.f90

@@ -309,6 +309,7 @@ module material
    phaseConfig, &
    microstructureConfig, &
    homogenizationConfig, &
+   textureConfig, &
    crystalliteConfig
 
  public :: &
@@ -443,6 +444,10 @@ subroutine material_init()
      case (trim(material_partHomogenization))
        line = material_parseHomogenization(FILEUNIT)
        if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
+    
+     case (trim(material_partTexture))
+       line = material_parseTexture(FILEUNIT)
+       if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
 
      case default
        line = IO_read(fileUnit)
@@ -451,10 +456,6 @@ subroutine material_init()
 
  enddo
 
- call material_parseTexture(FILEUNIT,material_partTexture)
- if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
- close(FILEUNIT)
-
  allocate(plasticState       (material_Nphase))
  allocate(sourceState        (material_Nphase))
  do myPhase = 1,material_Nphase
@@ -1002,7 +1003,6 @@ character(len=65536) function material_parsePhase(fileUnit)
    endif inSection
  enddo
 
-
  material_Nphase = size(phaseConfig)
  if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase)
 
@@ -1123,7 +1123,7 @@ end function material_parsePhase
 !--------------------------------------------------------------------------------------------------
 !> @brief parses the texture part in the material configuration file
 !--------------------------------------------------------------------------------------------------
-subroutine material_parseTexture(fileUnit,myPart)
+character(len=65536) function material_parseTexture(fileUnit)
  use prec, only: &
    dNeq
  use IO, only: &
@@ -1148,63 +1148,77 @@ subroutine material_parseTexture(fileUnit,myPart)
    math_inv33
 
  implicit none
- character(len=*), intent(in) :: myPart
  integer(pInt),    intent(in) :: fileUnit
 
 
  integer(pInt), allocatable, dimension(:) :: chunkPos
- integer(pInt) :: Nsections, section, gauss, fiber, j
+ integer(pInt) :: Nsections, section, gauss, fiber, j, t, i
- character(len=65536) :: tag
+ character(len=64) ::  tag2
- character(len=65536) :: line
+ character(len=256), dimension(:), allocatable ::  bla
  logical              :: echo
 
- echo = IO_globalTagInPart(fileUnit,myPart,'/echo/')
+ character(len=65536) :: line, tag,devNull
 
- Nsections = IO_countSections(fileUnit,myPart)
+ allocate(textureConfig(0))
- material_Ntexture = Nsections
- if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart)
 
- allocate(texture_name(Nsections));        texture_name=''
+ t = 0_pInt
- allocate(texture_ODFfile(Nsections));  texture_ODFfile=''
+ do while (trim(line) /= IO_EOF)                                                                    ! read through sections of material part
- allocate(texture_symmetry(Nsections),           source=1_pInt)
- allocate(texture_Ngauss(Nsections),             source=0_pInt)
- allocate(texture_Nfiber(Nsections),             source=0_pInt)
-
- texture_Ngauss = IO_countTagInPart(fileUnit,myPart,'(gauss)', Nsections) + &
-                  IO_countTagInPart(fileUnit,myPart,'(random)',Nsections)
- texture_Nfiber = IO_countTagInPart(fileUnit,myPart,'(fiber)', Nsections)
- texture_maxNgauss = maxval(texture_Ngauss)
- texture_maxNfiber = maxval(texture_Nfiber)
- allocate(texture_Gauss (5,texture_maxNgauss,Nsections), source=0.0_pReal)
- allocate(texture_Fiber (6,texture_maxNfiber,Nsections), source=0.0_pReal)
- allocate(texture_transformation(3,3,Nsections),         source=0.0_pReal)
- texture_transformation = spread(math_I3,3,Nsections)
-
- rewind(fileUnit)
- line    = ''                                                                                       ! to have in initialized
- section = 0_pInt                                                                                   ! - " -
- gauss   = 0_pInt                                                                                   ! - " -
- fiber   = 0_pInt                                                                                   ! - " -
- do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart)                     ! wind forward to <texture>
-   line = IO_read(fileUnit)
- enddo
- if (echo) write(6,'(/,1x,a)') trim(line)                                                           ! echo part header
-
- do while (trim(line) /= IO_EOF)
    line = IO_read(fileUnit)
    if (IO_isBlank(line)) cycle                                                                      ! skip empty lines
-   if (IO_getTag(line,'<','>') /= '') then                                                          ! stop at next part
+   foundNextPart: if (IO_getTag(line,'<','>') /= '') then
-     line = IO_read(fileUnit, .true.)                                                               ! reset IO_read
+     devNull = IO_read(fileUnit, .true.)                                                            ! reset IO_read
      exit
-   endif
+   endif foundNextPart
-   if (echo) write(6,'(2x,a)') trim(line)                                                           ! echo back read lines
+   nextSection: if (IO_getTag(line,'[',']') /= '') then
-   if (IO_getTag(line,'[',']') /= '') then                                                          ! next section
+     t = t + 1_pInt
-     section = section + 1_pInt
+     textureConfig = [textureConfig, emptyList]
-     gauss = 0_pInt
+     tag2 = IO_getTag(line,'[',']')
-     fiber = 0_pInt
+     GfortranBug86033: if (.not. allocated(texture_name)) then
-     texture_name(section) = IO_getTag(line,'[',']')
+       allocate(texture_name(1),source=tag2)
-   endif
+     else GfortranBug86033
-   if (section > 0_pInt) then
+       texture_name  = [texture_name,tag2]
+     endif GfortranBug86033
+   endif nextSection
+   chunkPos = IO_stringPos(line)
+   tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt))                                          ! extract key
+   inSection: if (t > 0_pInt) then
+     chunkPos = IO_stringPos(line)
+     call textureConfig(t)%add(IO_lc(trim(line)),chunkPos)
+   else inSection
+     echo = (trim(tag) == '/echo/')
+   endif inSection
+ enddo
+
+ material_Ntexture = size(textureConfig)
+ if (material_Ntexture < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture)
+
+ allocate(texture_ODFfile(material_Ntexture));           texture_ODFfile=''
+ allocate(texture_symmetry(material_Ntexture),           source=1_pInt)
+ allocate(texture_Ngauss(material_Ntexture),             source=0_pInt)
+ allocate(texture_Nfiber(material_Ntexture),             source=0_pInt)
+
+ do t=1_pInt, material_Ntexture
+   texture_Ngauss(t) =  textureConfig(t)%countKeys('(gauss)') &
+                     +  textureConfig(t)%countKeys('(random)')
+   texture_Nfiber(t) =  textureConfig(t)%countKeys('(fiber)')
+ enddo
+
+ texture_maxNgauss = maxval(texture_Ngauss)
+ texture_maxNfiber = maxval(texture_Nfiber)
+ allocate(texture_Gauss (5,texture_maxNgauss,material_Ntexture), source=0.0_pReal)
+ allocate(texture_Fiber (6,texture_maxNfiber,material_Ntexture), source=0.0_pReal)
+ allocate(texture_transformation(3,3,material_Ntexture),         source=0.0_pReal)
+          texture_transformation = spread(math_I3,3,material_Ntexture)
+
+ do t=1_pInt, material_Ntexture
+   section = t
+   gauss = 0_pInt
+   fiber = 0_pInt
+   bla = textureConfig(t)%getStringsRaw()
+
+   lines: do i=1_pInt, size(bla)
+     line = bla(i)
+
      chunkPos = IO_stringPos(line)
      tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                             ! extract key
      textureType: select case(tag)
@@ -1297,12 +1311,12 @@ subroutine material_parseTexture(fileUnit,myPart)
                  texture_Fiber(6,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)
            end select
          enddo
-
      end select textureType
-   endif
+   enddo lines
  enddo
 
-end subroutine material_parseTexture
+     material_parseTexture = line
+end function material_parseTexture
 
 
 !--------------------------------------------------------------------------------------------------