diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 5cfd30835..9418cd56d 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -39,13 +39,9 @@ add_library(DEBUG OBJECT "debug.f90") add_dependencies(DEBUG NUMERICS) list(APPEND OBJECTFILES $) -add_library(CHAINED_LIST OBJECT "linked_list.f90") -add_dependencies(CHAINED_LIST DEBUG) -list(APPEND OBJECTFILES $) - -add_library(CONFIG_MATERIAL OBJECT "config.f90") -add_dependencies(CONFIG_MATERIAL CHAINED_LIST) -list(APPEND OBJECTFILES $) +add_library(CONFIG OBJECT "config.f90") +add_dependencies(CONFIG DEBUG) +list(APPEND OBJECTFILES $) add_library(FEsolving OBJECT "FEsolving.f90") add_dependencies(FEsolving DEBUG) @@ -70,7 +66,7 @@ elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") endif() add_library(MATERIAL OBJECT "material.f90") -add_dependencies(MATERIAL MESH CONFIG_MATERIAL) +add_dependencies(MATERIAL MESH CONFIG) list(APPEND OBJECTFILES $) add_library(DAMASK_HELPERS OBJECT "lattice.f90") diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 372aeaab4..0d4b55255 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -6,7 +6,6 @@ #include "IO.f90" #include "numerics.f90" #include "debug.f90" -#include "linked_list.f90" #include "config.f90" #include "math.f90" #include "FEsolving.f90" diff --git a/src/config.f90 b/src/config.f90 index 66c2f18bb..a2bdd6b50 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -6,13 +6,41 @@ !! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture' !-------------------------------------------------------------------------------------------------- module config - use linked_list use prec, only: & pReal, & pInt implicit none private + type, private :: tPartitionedString + character(len=:), allocatable :: val + integer(pInt), dimension(:), allocatable :: pos + end type tPartitionedString + + type, public :: tPartitionedStringList + type(tPartitionedString) :: string + type(tPartitionedStringList), pointer :: next => null() + contains + procedure :: add => add + procedure :: show => show + + procedure :: keyExists => keyExists + procedure :: countKeys => countKeys + + procedure :: getFloat => getFloat + procedure :: getFloats => getFloats + + procedure :: getInt => getInt + procedure :: getInts => getInts + + procedure :: getStringsRaw => strings + procedure :: getString => getString + procedure :: getStrings => getStrings + + end type tPartitionedStringList + + type(tPartitionedStringList), public :: emptyList + type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & phaseConfig, & microstructureConfig, & @@ -48,7 +76,8 @@ module config MATERIAL_configFile = 'material.config', & !< generic name for material configuration file MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file - public :: config_init + +public :: config_init contains @@ -202,4 +231,432 @@ subroutine parseFile(line,& end if end subroutine parseFile +!-------------------------------------------------------------------------------------------------- +!> @brief add element +!> @details Adds a string together with the start/end position of chunks in this string. The new +!! element is added at the end of the list. Empty strings are not added. All strings are converted +!! to lower case +!-------------------------------------------------------------------------------------------------- +subroutine add(this,string) + use IO, only: & + IO_isBlank, & + IO_lc, & + IO_stringPos + + implicit none + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: string + type(tPartitionedStringList), pointer :: new, item + + if (IO_isBlank(string)) return + + allocate(new) + new%string%val = IO_lc (trim(string)) + new%string%pos = IO_stringPos(trim(string)) + + item => this + do while (associated(item%next)) + item => item%next + enddo + item%next => new + +end subroutine add + + +!-------------------------------------------------------------------------------------------------- +!> @brief prints all elements +!> @details Strings are printed in order of insertion (FIFO) +!-------------------------------------------------------------------------------------------------- +subroutine show(this) + + implicit none + class(tPartitionedStringList) :: this + type(tPartitionedStringList), pointer :: item + + item => this%next + do while (associated(item)) + write(6,'(a)') trim(item%string%val) + item => item%next + end do + +end subroutine show + + +!-------------------------------------------------------------------------------------------------- +!> @brief deallocates all elements of a given list +!> @details Strings are printed in order of insertion (FIFO) +!-------------------------------------------------------------------------------------------------- +! subroutine free_all() +! implicit none +! +! type(node), pointer :: item +! +! do +! item => first +! +! if (associated(item) .eqv. .FALSE.) exit +! +! first => first%next +! deallocate(item) +! end do +! end subroutine free_all + + +!-------------------------------------------------------------------------------------------------- +!> @brief reports wether a given key (string value at first position) exists in the list +!-------------------------------------------------------------------------------------------------- +logical function keyExists(this,key) + use IO, only: & + IO_stringValue + + implicit none + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: item + + keyExists = .false. + + item => this%next + do while (associated(item) .and. .not. keyExists) + keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) + item => item%next + end do + +end function keyExists + + +!-------------------------------------------------------------------------------------------------- +!> @brief count number of key appearances +!> @details traverses list and counts each occurrence of specified key +!-------------------------------------------------------------------------------------------------- +integer(pInt) function countKeys(this,key) + use IO, only: & + IO_stringValue + + implicit none + + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: item + + countKeys = 0_pInt + + item => this%next + do while (associated(item)) + if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) & + countKeys = countKeys + 1_pInt + item => item%next + end do + +end function countKeys + + +!-------------------------------------------------------------------------------------------------- +!> @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 + + +!-------------------------------------------------------------------------------------------------- +!> @brief gets float value of first string that matches given key (i.e. first chunk) +!> @details gets one float value. If key is not found exits with error unless default is given +!-------------------------------------------------------------------------------------------------- +real(pReal) function getFloat(this,key,defaultVal) + use IO, only : & + IO_error, & + IO_stringValue, & + IO_FloatValue + + implicit none + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + real(pReal), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + logical :: found + + if (present(defaultVal)) getFloat = defaultVal + found = present(defaultVal) + + item => this%next + do while (associated(item)) + if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then + found = .true. + if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + getFloat = IO_FloatValue(item%string%val,item%string%pos,2) + endif + item => item%next + end do + + if (.not. found) call IO_error(140_pInt,ext_msg=key) + +end function getFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief gets integer value for given key +!> @details gets one integer value. If key is not found exits with error unless default is given +!-------------------------------------------------------------------------------------------------- +integer(pInt) function getInt(this,key,defaultVal) + use IO, only: & + IO_error, & + IO_stringValue, & + IO_IntValue + + implicit none + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + integer(pInt), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + logical :: found + + if (present(defaultVal)) getInt = defaultVal + found = present(defaultVal) + + item => this%next + do while (associated(item)) + if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then + found = .true. + if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + getInt = IO_IntValue(item%string%val,item%string%pos,2) + endif + item => item%next + end do + + if (.not. found) call IO_error(140_pInt,ext_msg=key) + +end function getInt + + +!-------------------------------------------------------------------------------------------------- +!> @brief gets string value for given key +!> @details if key is not found exits with error unless default is given +!-------------------------------------------------------------------------------------------------- +character(len=65536) function getString(this,key,defaultVal,raw) + use IO, only: & + IO_error, & + IO_stringValue + + implicit none + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + character(len=65536), intent(in), optional :: defaultVal + logical, intent(in), optional :: raw + type(tPartitionedStringList), pointer :: item + logical :: found, & + split + + if (present(defaultVal)) getString = defaultVal + split = merge(.not. raw,.true.,present(raw)) + found = present(defaultVal) + + item => this%next + do while (associated(item)) + if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then + found = .true. + if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + + if (split) then + getString = IO_StringValue(item%string%val,item%string%pos,2) + else + getString = trim(item%string%val(item%string%pos(4):)) ! raw string starting a second chunk + endif + endif + item => item%next + end do + + if (.not. found) call IO_error(140_pInt,ext_msg=key) + +end function getString + + +!-------------------------------------------------------------------------------------------------- +!> @brief ... +!> @details ... +!-------------------------------------------------------------------------------------------------- +function getStrings(this,key,defaultVal,raw) + use IO + + implicit none + character(len=65536),dimension(:), allocatable :: getStrings + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + character(len=65536),dimension(:), intent(in), optional :: defaultVal + logical, intent(in), optional :: raw + type(tPartitionedStringList), pointer :: item + character(len=65536) :: str + integer(pInt) :: i + logical :: found, & + split, & + cumulative + + cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') + split = merge(.not. raw,.true.,present(raw)) + found = .false. + + item => this%next + do while (associated(item)) + if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then + found = .true. + if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings) + if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + + arrayAllocated: if (.not. allocated(getStrings)) then + if (split) then + str = IO_StringValue(item%string%val,item%string%pos,2_pInt) + allocate(getStrings(1),source=str) + do i=3_pInt,item%string%pos(1) + str = IO_StringValue(item%string%val,item%string%pos,i) + getStrings = [getStrings,str] + enddo + else + str = item%string%val(item%string%pos(4):) + getStrings = [str] + endif + else arrayAllocated + if (split) then + do i=2_pInt,item%string%pos(1) + str = IO_StringValue(item%string%val,item%string%pos,i) + getStrings = [getStrings,str] + enddo + else + getStrings = [getStrings,str] + endif + endif arrayAllocated + endif + item => item%next + end do + + if (present(defaultVal) .and. .not. found) then + getStrings = defaultVal + found = .true. + endif + if (.not. found) call IO_error(140_pInt,ext_msg=key) + +end function getStrings + + +!-------------------------------------------------------------------------------------------------- +!> @brief gets array of int values for given key +!> @details if key is not found exits with error unless default is given +!-------------------------------------------------------------------------------------------------- +function getInts(this,key,defaultVal) + use IO, only: & + IO_error, & + IO_stringValue, & + IO_IntValue + + implicit none + integer(pInt), dimension(:), allocatable :: getInts + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + integer(pInt), dimension(:), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + integer(pInt) :: i + logical :: found, & + cumulative + + cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') + found = .false. + + allocate(getInts(0)) + + item => this%next + do while (associated(item)) + if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then + found = .true. + if (.not. cumulative) then + deallocate(getInts) ! use here rhs allocation with empty list + allocate(getInts(0)) + endif + if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + do i = 2_pInt, item%string%pos(1) + getInts = [getInts,IO_IntValue(item%string%val,item%string%pos,i)] + enddo + endif + item => item%next + end do + + if (present(defaultVal) .and. .not. found) then + getInts = defaultVal + found = .true. + endif + if (.not. found) call IO_error(140_pInt,ext_msg=key) + +end function getInts + + +!-------------------------------------------------------------------------------------------------- +!> @brief gets array of float values for given key +!> @details if key is not found exits with error unless default is given +!-------------------------------------------------------------------------------------------------- +function getFloats(this,key,defaultVal) + use IO, only: & + IO_error, & + IO_stringValue, & + IO_FloatValue + + implicit none + real(pReal), dimension(:), allocatable :: getFloats + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + real(pReal), dimension(:), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + integer(pInt) :: i + logical :: found, & + cumulative + + cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') + found = .false. + + allocate(getFloats(0)) + + item => this%next + do while (associated(item)) + if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then + found = .true. + if (.not. cumulative) then + deallocate(getFloats) ! use here rhs allocation with empty list + allocate(getFloats(0)) + endif + if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + do i = 2_pInt, item%string%pos(1) + getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)] + enddo + endif + item => item%next + end do + + if (present(defaultVal) .and. .not. found) then + getFloats = defaultVal + found = .true. + endif + if (.not. found) call IO_error(140_pInt,ext_msg=key) + +end function getFloats + + end module config diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 17cf1570d..53d38a770 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -268,8 +268,7 @@ subroutine crystallite_init do c = 1_pInt, material_Ncrystallite - if (crystalliteConfig(c)%keyExists('(output)') )then - str = crystalliteConfig(c)%getStrings('(output)') + str = crystalliteConfig(c)%getStrings('(output)',defaultVal=[character(len=65536)::]) do o = 1_pInt, size(str) crystallite_output(o,c) = str(o) outputName: select case(str(o)) @@ -321,7 +320,6 @@ subroutine crystallite_init call IO_error(105_pInt,ext_msg=tag//' (Crystallite)') end select outputName enddo - endif enddo diff --git a/src/linked_list.f90 b/src/linked_list.f90 deleted file mode 100644 index b07b743c0..000000000 --- a/src/linked_list.f90 +++ /dev/null @@ -1,472 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Martin Dieh, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Chained list to store string together with position of delimiters -!-------------------------------------------------------------------------------------------------- -module linked_list - use prec, only: & - pReal, & - pInt - - implicit none - private - type, private :: tPartitionedString - character(len=:), allocatable :: val - integer(pInt), dimension(:), allocatable :: pos - end type tPartitionedString - - type, public :: tPartitionedStringList - type(tPartitionedString) :: string - type(tPartitionedStringList), pointer :: next => null() - contains - procedure :: add => add - procedure :: show => show - - procedure :: keyExists => exist - procedure :: countKeys => count - - procedure :: getFloat => getFloat - procedure :: getFloats => getFloats - - procedure :: getInt => getInt - procedure :: getInts => getInts - - procedure :: getStringsRaw => strings - procedure :: getString => getString - procedure :: getStrings => getStrings - - end type tPartitionedStringList - - type(tPartitionedStringList), public :: emptyList - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief add element -!> @details Adds a string together with the start/end position of chunks in this string. The new -!! element is added at the end of the list. Empty strings are not added. All strings are converted -!! to lower case -!-------------------------------------------------------------------------------------------------- -subroutine add(this,string) - use IO, only: & - IO_isBlank, & - IO_lc, & - IO_stringPos - - implicit none - class(tPartitionedStringList), target, intent(in) :: this - character(len=*), intent(in) :: string - type(tPartitionedStringList), pointer :: new, item - - if (IO_isBlank(string)) return - - allocate(new) - new%string%val = IO_lc (trim(string)) - new%string%pos = IO_stringPos(trim(string)) - - item => this - do while (associated(item%next)) - item => item%next - enddo - item%next => new - -end subroutine add - - -!-------------------------------------------------------------------------------------------------- -!> @brief prints all elements -!> @details Strings are printed in order of insertion (FIFO) -!-------------------------------------------------------------------------------------------------- -subroutine show(this) - - implicit none - class(tPartitionedStringList) :: this - type(tPartitionedStringList), pointer :: item - - item => this%next - do while (associated(item)) - write(6,'(a)') trim(item%string%val) - item => item%next - end do - -end subroutine show - - -!-------------------------------------------------------------------------------------------------- -!> @brief deallocates all elements of a given list -!> @details Strings are printed in order of insertion (FIFO) -!-------------------------------------------------------------------------------------------------- -! subroutine free_all() -! implicit none -! -! type(node), pointer :: item -! -! do -! item => first -! -! if (associated(item) .eqv. .FALSE.) exit -! -! first => first%next -! deallocate(item) -! end do -! end subroutine free_all - - -!-------------------------------------------------------------------------------------------------- -!> @brief reports wether a given key (string value at first position) exists in the list -!-------------------------------------------------------------------------------------------------- -logical function exist(this,key) - use IO, only: & - IO_stringValue - - implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: item - - exist = .false. - - item => this%next - do while (associated(item) .and. .not. exist) - exist = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) - item => item%next - end do - -end function exist - - -!-------------------------------------------------------------------------------------------------- -!> @brief count number of key appearances -!> @details traverses list and counts each occurrence of specified key -!-------------------------------------------------------------------------------------------------- -integer(pInt) function count(this,key) - use IO, only: & - IO_stringValue - - implicit none - - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: item - - count = 0_pInt - - item => this%next - do while (associated(item)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) & - count = count + 1_pInt - item => item%next - end do - -end function count - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns all strings in the list -!> @details returns raw string without start/end position of chunks -!-------------------------------------------------------------------------------------------------- -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 - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets float value of first string that matches given key (i.e. first chunk) -!> @details gets one float value. If key is not found exits with error unless default is given -!-------------------------------------------------------------------------------------------------- -real(pReal) function getFloat(this,key,defaultVal) - use IO, only : & - IO_error, & - IO_stringValue, & - IO_FloatValue - - implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - real(pReal), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - logical :: found - - if (present(defaultVal)) getFloat = defaultVal - found = present(defaultVal) - - item => this%next - do while (associated(item)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - getFloat = IO_FloatValue(item%string%val,item%string%pos,2) - endif - item => item%next - end do - - if (.not. found) call IO_error(140_pInt,ext_msg=key) - -end function getFloat - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets integer value for given key -!> @details gets one integer value. If key is not found exits with error unless default is given -!-------------------------------------------------------------------------------------------------- -integer(pInt) function getInt(this,key,defaultVal) - use IO, only: & - IO_error, & - IO_stringValue, & - IO_IntValue - - implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - integer(pInt), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - logical :: found - - if (present(defaultVal)) getInt = defaultVal - found = present(defaultVal) - - item => this%next - do while (associated(item)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - getInt = IO_IntValue(item%string%val,item%string%pos,2) - endif - item => item%next - end do - - if (.not. found) call IO_error(140_pInt,ext_msg=key) - -end function getInt - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets string value for given key -!> @details if key is not found exits with error unless default is given -!-------------------------------------------------------------------------------------------------- -character(len=65536) function getString(this,key,defaultVal,raw) - use IO, only: & - IO_error, & - IO_stringValue - - implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - character(len=65536), intent(in), optional :: defaultVal - logical, intent(in), optional :: raw - type(tPartitionedStringList), pointer :: item - logical :: found, & - split - - if (present(defaultVal)) getString = defaultVal - split = merge(.not. raw,.true.,present(raw)) - found = present(defaultVal) - - item => this%next - do while (associated(item)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - - if (split) then - getString = IO_StringValue(item%string%val,item%string%pos,2) - else - getString = trim(item%string%val(item%string%pos(4):)) ! raw string starting a second chunk - endif - endif - item => item%next - end do - - if (.not. found) call IO_error(140_pInt,ext_msg=key) - -end function getString - - -!-------------------------------------------------------------------------------------------------- -!> @brief ... -!> @details ... -!-------------------------------------------------------------------------------------------------- -function getStrings(this,key,defaultVal,raw) - use IO - - implicit none - character(len=65536),dimension(:), allocatable :: getStrings - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - character(len=65536),dimension(:), intent(in), optional :: defaultVal - logical, intent(in), optional :: raw - type(tPartitionedStringList), pointer :: item - character(len=65536) :: str - integer(pInt) :: i - logical :: found, & - split, & - cumulative - - cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - split = merge(.not. raw,.true.,present(raw)) - found = .false. - - item => this%next - do while (associated(item)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings) - if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - - arrayAllocated: if (.not. allocated(getStrings)) then - if (split) then - str = IO_StringValue(item%string%val,item%string%pos,2_pInt) - allocate(getStrings(1),source=str) - do i=3_pInt,item%string%pos(1) - str = IO_StringValue(item%string%val,item%string%pos,i) - getStrings = [getStrings,str] - enddo - else - str = item%string%val(item%string%pos(4):) - getStrings = [str] - endif - else arrayAllocated - if (split) then - do i=2_pInt,item%string%pos(1) - str = IO_StringValue(item%string%val,item%string%pos,i) - getStrings = [getStrings,str] - enddo - else - getStrings = [getStrings,str] - endif - endif arrayAllocated - endif - item => item%next - end do - - if (present(defaultVal) .and. .not. found) then - getStrings = defaultVal - found = .true. - endif - if (.not. found) call IO_error(140_pInt,ext_msg=key) - -end function getStrings - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets array of int values for given key -!> @details if key is not found exits with error unless default is given -!-------------------------------------------------------------------------------------------------- -function getInts(this,key,defaultVal) - use IO, only: & - IO_error, & - IO_stringValue, & - IO_IntValue - - implicit none - integer(pInt), dimension(:), allocatable :: getInts - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - integer(pInt), dimension(:), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - integer(pInt) :: i - logical :: found, & - cumulative - - cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - found = .false. - - allocate(getInts(0)) - - item => this%next - do while (associated(item)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (.not. cumulative) then - deallocate(getInts) ! use here rhs allocation with empty list - allocate(getInts(0)) - endif - if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - do i = 2_pInt, item%string%pos(1) - getInts = [getInts,IO_IntValue(item%string%val,item%string%pos,i)] - enddo - endif - item => item%next - end do - - if (present(defaultVal) .and. .not. found) then - getInts = defaultVal - found = .true. - endif - if (.not. found) call IO_error(140_pInt,ext_msg=key) - -end function getInts - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets array of float values for given key -!> @details if key is not found exits with error unless default is given -!-------------------------------------------------------------------------------------------------- -function getFloats(this,key,defaultVal) - use IO, only: & - IO_error, & - IO_stringValue, & - IO_FloatValue - - implicit none - real(pReal), dimension(:), allocatable :: getFloats - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - real(pReal), dimension(:), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - integer(pInt) :: i - logical :: found, & - cumulative - - cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - found = .false. - - allocate(getFloats(0)) - - item => this%next - do while (associated(item)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. - if (.not. cumulative) then - deallocate(getFloats) ! use here rhs allocation with empty list - allocate(getFloats(0)) - endif - if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - do i = 2_pInt, item%string%pos(1) - getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)] - enddo - endif - item => item%next - end do - - if (present(defaultVal) .and. .not. found) then - getFloats = defaultVal - found = .true. - endif - if (.not. found) call IO_error(140_pInt,ext_msg=key) - -end function getFloats - - -end module linked_list diff --git a/src/material.f90 b/src/material.f90 index 474f10a59..48e71af07 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -8,7 +8,6 @@ !-------------------------------------------------------------------------------------------------- module material use config - use linked_list use prec, only: & pReal, & pInt, & @@ -226,7 +225,7 @@ module material phase_localPlasticity !< flags phases with local constitutive law - character(len=256), dimension(:), allocatable, private :: & + character(len=65536), dimension(:), allocatable, private :: & texture_ODFfile !< name of each ODF file integer(pInt), private :: & @@ -761,7 +760,7 @@ subroutine material_parsePhase implicit none integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p - character(len=256), dimension(:), allocatable :: str + character(len=65536), dimension(:), allocatable :: str allocate(phase_elasticity(material_Nphase),source=ELASTICITY_undefined_ID) diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index ed1ac7f54..5d98a647b 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -106,7 +106,7 @@ use IO implicit none - type(tParameters), pointer :: p + type(tParameters), pointer :: prm integer(pInt) :: & o, & @@ -120,7 +120,7 @@ use IO character(len=65536) :: & extmsg = '' integer(pInt) :: NipcMyPhase,i - character(len=64), dimension(:), allocatable :: outputs + character(len=65536), dimension(:), allocatable :: outputs write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_ISOTROPIC_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -144,26 +144,26 @@ use IO do phase = 1_pInt, size(phase_plasticityInstance) if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then instance = phase_plasticityInstance(phase) - p => param(instance) ! shorthand pointer to parameter object of my constitutive law - p%tau0 = phaseConfig(phase)%getFloat('tau0') - p%tausat = phaseConfig(phase)%getFloat('tausat') - p%gdot0 = phaseConfig(phase)%getFloat('gdot0') - p%n = phaseConfig(phase)%getFloat('n') - p%h0 = phaseConfig(phase)%getFloat('h0') - p%fTaylor = phaseConfig(phase)%getFloat('m') - p%h0_slopeLnRate = phaseConfig(phase)%getFloat('h0_slopelnrate', defaultVal=0.0_pReal) ! ToDo: alias allowed? - p%tausat_SinhFitA = phaseConfig(phase)%getFloat('tausat_sinhfita',defaultVal=0.0_pReal) - p%tausat_SinhFitB = phaseConfig(phase)%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal) - p%tausat_SinhFitC = phaseConfig(phase)%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal) - p%tausat_SinhFitD = phaseConfig(phase)%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal) - p%a = phaseConfig(phase)%getFloat('a') ! ToDo: alias - p%aTolFlowStress = phaseConfig(phase)%getFloat('atol_flowstress',defaultVal=1.0_pReal) - p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + prm => param(instance) ! shorthand pointer to parameter object of my constitutive law + prm%tau0 = phaseConfig(phase)%getFloat('tau0') + prm%tausat = phaseConfig(phase)%getFloat('tausat') + prm%gdot0 = phaseConfig(phase)%getFloat('gdot0') + prm%n = phaseConfig(phase)%getFloat('n') + prm%h0 = phaseConfig(phase)%getFloat('h0') + prm%fTaylor = phaseConfig(phase)%getFloat('m') + prm%h0_slopeLnRate = phaseConfig(phase)%getFloat('h0_slopelnrate', defaultVal=0.0_pReal) + prm%tausat_SinhFitA = phaseConfig(phase)%getFloat('tausat_sinhfita',defaultVal=0.0_pReal) + prm%tausat_SinhFitB = phaseConfig(phase)%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal) + prm%tausat_SinhFitC = phaseConfig(phase)%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal) + prm%tausat_SinhFitD = phaseConfig(phase)%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal) + prm%a = phaseConfig(phase)%getFloat('a') + prm%aTolFlowStress = phaseConfig(phase)%getFloat('atol_flowstress',defaultVal=1.0_pReal) + prm%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - p%dilatation = phaseConfig(phase)%keyExists('/dilatation/') + prm%dilatation = phaseConfig(phase)%keyExists('/dilatation/') - outputs = phaseConfig(phase)%getStrings('(output)') - allocate(p%outputID(0)) + outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=[character(len=65536)::]) + allocate(prm%outputID(0)) do i=1_pInt, size(outputs) select case(outputs(i)) case ('flowstress') @@ -171,28 +171,28 @@ use IO plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i) plasticState(phase)%sizePostResults = plasticState(phase)%sizePostResults + 1_pInt plastic_isotropic_sizePostResult(i,instance) = 1_pInt - p%outputID = [p%outputID,flowstress_ID] + prm%outputID = [prm%outputID,flowstress_ID] case ('strainrate') plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i) plasticState(phase)%sizePostResults = & plasticState(phase)%sizePostResults + 1_pInt plastic_isotropic_sizePostResult(i,instance) = 1_pInt - p%outputID = [p%outputID,strainrate_ID] + prm%outputID = [prm%outputID,strainrate_ID] end select enddo !-------------------------------------------------------------------------------------------------- ! sanity checks extmsg = '' - if (p%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"'aTolShear' " - if (p%tau0 < 0.0_pReal) extmsg = trim(extmsg)//"'tau0' " - if (p%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//"'gdot0' " - if (p%n <= 0.0_pReal) extmsg = trim(extmsg)//"'n' " - if (p%tausat <= p%tau0) extmsg = trim(extmsg)//"'tausat' " - if (p%a <= 0.0_pReal) extmsg = trim(extmsg)//"'a' " - if (p%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//"'m' " - if (p%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//"'atol_flowstress' " + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"'aTolShear' " + if (prm%tau0 < 0.0_pReal) extmsg = trim(extmsg)//"'tau0' " + if (prm%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//"'gdot0' " + if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//"'n' " + if (prm%tausat <= prm%tau0) extmsg = trim(extmsg)//"'tausat' " + if (prm%a <= 0.0_pReal) extmsg = trim(extmsg)//"'a' " + if (prm%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//"'m' " + if (prm%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//"'atol_flowstress' " if (extmsg /= '') call IO_error(211_pInt,ip=instance,& ext_msg=trim(extmsg)//'('//PLASTICITY_ISOTROPIC_label//')') @@ -228,13 +228,13 @@ use IO state(instance)%flowstress => plasticState(phase)%state (1,1:NipcMyPhase) dotState(instance)%flowstress => plasticState(phase)%dotState (1,1:NipcMyPhase) - plasticState(phase)%state0(1,1:NipcMyPhase) = p%tau0 - plasticState(phase)%aTolState(1) = p%aTolFlowstress + plasticState(phase)%state0(1,1:NipcMyPhase) = prm%tau0 + plasticState(phase)%aTolState(1) = prm%aTolFlowstress state(instance)%accumulatedShear => plasticState(phase)%state (2,1:NipcMyPhase) dotState(instance)%accumulatedShear => plasticState(phase)%dotState (2,1:NipcMyPhase) plasticState(phase)%state0 (2,1:NipcMyPhase) = 0.0_pReal - plasticState(phase)%aTolState(2) = p%aTolShear + plasticState(phase)%aTolState(2) = prm%aTolShear ! global alias plasticState(phase)%slipRate => plasticState(phase)%dotState(2:2,1:NipcMyPhase) plasticState(phase)%accumulatedSlip => plasticState(phase)%state (2:2,1:NipcMyPhase) @@ -282,7 +282,7 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) ip, & !< integration point el !< element - type(tParameters), pointer :: p + type(tParameters), pointer :: prm real(pReal), dimension(3,3) :: & Tstar_dev_33 !< deviatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor @@ -298,7 +298,7 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - p => param(instance) + prm => param(instance) Tstar_dev_33 = math_deviatoric33(math_Mandel6to33(Tstar_v)) ! deviatoric part of 2nd Piola-Kirchhoff stress squarenorm_Tstar_dev = math_mul33xx33(Tstar_dev_33,Tstar_dev_33) @@ -308,11 +308,11 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) Lp = 0.0_pReal dLp_dTstar99 = 0.0_pReal else - gamma_dot = p%gdot0 & - * ( sqrt(1.5_pReal) * norm_Tstar_dev / p%fTaylor / state(instance)%flowstress(of) ) & - **p%n + gamma_dot = prm%gdot0 & + * ( sqrt(1.5_pReal) * norm_Tstar_dev / prm%fTaylor / state(instance)%flowstress(of) ) & + **prm%n - Lp = Tstar_dev_33/norm_Tstar_dev * gamma_dot/p%fTaylor + Lp = Tstar_dev_33/norm_Tstar_dev * gamma_dot/prm%fTaylor if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & @@ -326,13 +326,13 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! Calculation of the tangent of Lp forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dTstar_3333(k,l,m,n) = (p%n-1.0_pReal) * & + dLp_dTstar_3333(k,l,m,n) = (prm%n-1.0_pReal) * & Tstar_dev_33(k,l)*Tstar_dev_33(m,n) / squarenorm_Tstar_dev forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt) & dLp_dTstar_3333(k,l,k,l) = dLp_dTstar_3333(k,l,k,l) + 1.0_pReal forall (k=1_pInt:3_pInt,m=1_pInt:3_pInt) & dLp_dTstar_3333(k,k,m,m) = dLp_dTstar_3333(k,k,m,m) - 1.0_pReal/3.0_pReal - dLp_dTstar99 = math_Plain3333to99(gamma_dot / p%fTaylor * & + dLp_dTstar99 = math_Plain3333to99(gamma_dot / prm%fTaylor * & dLp_dTstar_3333 / norm_Tstar_dev) end if end subroutine plastic_isotropic_LpAndItsTangent @@ -364,7 +364,7 @@ subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar_3333,Tstar_v,ipc,ip,e ip, & !< integration point el !< element - type(tParameters), pointer :: p + type(tParameters), pointer :: prm real(pReal), dimension(3,3) :: & Tstar_sph_33 !< sphiatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor @@ -378,28 +378,28 @@ subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar_3333,Tstar_v,ipc,ip,e of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - p => param(instance) + prm => param(instance) Tstar_sph_33 = math_spherical33(math_Mandel6to33(Tstar_v)) ! spherical part of 2nd Piola-Kirchhoff stress squarenorm_Tstar_sph = math_mul33xx33(Tstar_sph_33,Tstar_sph_33) norm_Tstar_sph = sqrt(squarenorm_Tstar_sph) - if (p%dilatation .and. norm_Tstar_sph > 0.0_pReal) then ! Tstar == 0 or J2 plascitiy --> both Li and dLi_dTstar are zero - gamma_dot = p%gdot0 & - * (sqrt(1.5_pReal) * norm_Tstar_sph / p%fTaylor / state(instance)%flowstress(of) ) & - **p%n + if (prm%dilatation .and. norm_Tstar_sph > 0.0_pReal) then ! Tstar == 0 or J2 plascitiy --> both Li and dLi_dTstar are zero + gamma_dot = prm%gdot0 & + * (sqrt(1.5_pReal) * norm_Tstar_sph / prm%fTaylor / state(instance)%flowstress(of) ) & + **prm%n - Li = Tstar_sph_33/norm_Tstar_sph * gamma_dot/p%fTaylor + Li = Tstar_sph_33/norm_Tstar_sph * gamma_dot/prm%fTaylor !-------------------------------------------------------------------------------------------------- ! Calculation of the tangent of Li forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLi_dTstar_3333(k,l,m,n) = (p%n-1.0_pReal) * & + dLi_dTstar_3333(k,l,m,n) = (prm%n-1.0_pReal) * & Tstar_sph_33(k,l)*Tstar_sph_33(m,n) / squarenorm_Tstar_sph forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt) & dLi_dTstar_3333(k,l,k,l) = dLi_dTstar_3333(k,l,k,l) + 1.0_pReal - dLi_dTstar_3333 = gamma_dot / p%fTaylor * & + dLi_dTstar_3333 = gamma_dot / prm%fTaylor * & dLi_dTstar_3333 / norm_Tstar_sph else Li = 0.0_pReal @@ -428,7 +428,7 @@ subroutine plastic_isotropic_dotState(Tstar_v,ipc,ip,el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element - type(tParameters), pointer :: p + type(tParameters), pointer :: prm real(pReal), dimension(6) :: & Tstar_dev_v !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation real(pReal) :: & @@ -442,11 +442,11 @@ subroutine plastic_isotropic_dotState(Tstar_v,ipc,ip,el) of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - p => param(instance) + prm => param(instance) !-------------------------------------------------------------------------------------------------- ! norm of (deviatoric) 2nd Piola-Kirchhoff stress - if (p%dilatation) then + if (prm%dilatation) then norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v)) else Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal @@ -455,26 +455,26 @@ subroutine plastic_isotropic_dotState(Tstar_v,ipc,ip,el) end if !-------------------------------------------------------------------------------------------------- ! strain rate - gamma_dot = p%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v & + gamma_dot = prm%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v & / &!----------------------------------------------------------------------------------- - (p%fTaylor*state(instance)%flowstress(of) ))**p%n + (prm%fTaylor*state(instance)%flowstress(of) ))**prm%n !-------------------------------------------------------------------------------------------------- ! hardening coefficient if (abs(gamma_dot) > 1e-12_pReal) then - if (dEq0(p%tausat_SinhFitA)) then - saturation = p%tausat + if (dEq0(prm%tausat_SinhFitA)) then + saturation = prm%tausat else - saturation = p%tausat & - + asinh( (gamma_dot / p%tausat_SinhFitA& - )**(1.0_pReal / p%tausat_SinhFitD)& - )**(1.0_pReal / p%tausat_SinhFitC) & - / ( p%tausat_SinhFitB & - * (gamma_dot / p%gdot0)**(1.0_pReal / p%n) & + saturation = prm%tausat & + + asinh( (gamma_dot / prm%tausat_SinhFitA& + )**(1.0_pReal / prm%tausat_SinhFitD)& + )**(1.0_pReal / prm%tausat_SinhFitC) & + / ( prm%tausat_SinhFitB & + * (gamma_dot / prm%gdot0)**(1.0_pReal / prm%n) & ) endif - hardening = ( p%h0 + p%h0_slopeLnRate * log(gamma_dot) ) & - * abs( 1.0_pReal - state(instance)%flowstress(of)/saturation )**p%a & + hardening = ( prm%h0 + prm%h0_slopeLnRate * log(gamma_dot) ) & + * abs( 1.0_pReal - state(instance)%flowstress(of)/saturation )**prm%a & * sign(1.0_pReal, 1.0_pReal - state(instance)%flowstress(of)/saturation) else hardening = 0.0_pReal @@ -505,7 +505,7 @@ function plastic_isotropic_postResults(Tstar_v,ipc,ip,el) ip, & !< integration point el !< element - type(tParameters), pointer :: p + type(tParameters), pointer :: prm real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & plastic_isotropic_postResults @@ -522,11 +522,11 @@ function plastic_isotropic_postResults(Tstar_v,ipc,ip,el) of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - p => param(instance) + prm => param(instance) !-------------------------------------------------------------------------------------------------- ! norm of (deviatoric) 2nd Piola-Kirchhoff stress - if (p%dilatation) then + if (prm%dilatation) then norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v)) else Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal @@ -538,15 +538,15 @@ function plastic_isotropic_postResults(Tstar_v,ipc,ip,el) plastic_isotropic_postResults = 0.0_pReal outputsLoop: do o = 1_pInt,plastic_isotropic_Noutput(instance) - select case(p%outputID(o)) + select case(prm%outputID(o)) case (flowstress_ID) plastic_isotropic_postResults(c+1_pInt) = state(instance)%flowstress(of) c = c + 1_pInt case (strainrate_ID) plastic_isotropic_postResults(c+1_pInt) = & - p%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v & + prm%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v & / &!---------------------------------------------------------------------------------- - (p%fTaylor * state(instance)%flowstress(of)) ) ** p%n + (prm%fTaylor * state(instance)%flowstress(of)) ) ** prm%n c = c + 1_pInt end select enddo outputsLoop