diff --git a/src/config.f90 b/src/config.f90 index a2bdd6b50..68f06e7a2 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -20,6 +20,7 @@ module config type, public :: tPartitionedStringList type(tPartitionedString) :: string type(tPartitionedStringList), pointer :: next => null() + contains procedure :: add => add procedure :: show => show @@ -28,14 +29,14 @@ module config procedure :: countKeys => countKeys procedure :: getFloat => getFloat - procedure :: getFloats => getFloats - procedure :: getInt => getInt + procedure :: getString => getString + + procedure :: getFloats => getFloats procedure :: getInts => getInts + procedure :: getStrings => getStrings procedure :: getStringsRaw => strings - procedure :: getString => getString - procedure :: getStrings => getStrings end type tPartitionedStringList @@ -352,38 +353,9 @@ 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 +!> @brief gets float value of for a given key from a linked list +!> @details gets the last value if the key occurs more than once. If key is not found exits with +!! error unless default is given !-------------------------------------------------------------------------------------------------- real(pReal) function getFloat(this,key,defaultVal) use IO, only : & @@ -417,8 +389,9 @@ 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 +!> @brief gets integer value of for a given key from a linked list +!> @details gets the last value if the key occurs more than once. If key is not found exits with +!! error unless default is given !-------------------------------------------------------------------------------------------------- integer(pInt) function getInt(this,key,defaultVal) use IO, only: & @@ -452,8 +425,10 @@ end function getInt !-------------------------------------------------------------------------------------------------- -!> @brief gets string value for given key -!> @details if key is not found exits with error unless default is given +!> @brief gets string value of for a given key from a linked list +!> @details gets the last value if the key occurs more than once. If key is not found exits with +!! error unless default is given. If raw is true, the the complete string is returned, otherwise +!! the individual chunks are returned !-------------------------------------------------------------------------------------------------- character(len=65536) function getString(this,key,defaultVal,raw) use IO, only: & @@ -494,74 +469,60 @@ end function getString !-------------------------------------------------------------------------------------------------- -!> @brief ... -!> @details ... +!> @brief gets array of float values of for a given key from a linked list +!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all +!! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- -function getStrings(this,key,defaultVal,raw) - use IO +function getFloats(this,key,defaultVal) + use IO, only: & + IO_error, & + IO_stringValue, & + IO_FloatValue 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 + 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, & - split, & - cumulative + cumulative cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - split = merge(.not. raw,.true.,present(raw)) 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 (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings) + 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) - - 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 + 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 - getStrings = defaultVal + getFloats = defaultVal found = .true. endif if (.not. found) call IO_error(140_pInt,ext_msg=key) -end function getStrings +end function getFloats !-------------------------------------------------------------------------------------------------- -!> @brief gets array of int values for given key -!> @details if key is not found exits with error unless default is given +!> @brief gets array of integer values of for a given key from a linked list +!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all +!! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- function getInts(this,key,defaultVal) use IO, only: & @@ -610,53 +571,104 @@ 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 +!> @brief gets array of string values of for a given key from a linked list +!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all +!! values from the last occurrence. If key is not found exits with error unless default is given. +!! If raw is true, the the complete string is returned, otherwise the individual chunks are returned !-------------------------------------------------------------------------------------------------- -function getFloats(this,key,defaultVal) +function getStrings(this,key,defaultVal,raw) use IO, only: & IO_error, & - IO_stringValue, & - IO_FloatValue + IO_StringValue 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 + 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. - 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 (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings) 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 + + notAllocated: 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 notAllocated + 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 notAllocated endif item => item%next end do if (present(defaultVal) .and. .not. found) then - getFloats = defaultVal + getStrings = defaultVal found = .true. endif if (.not. found) call IO_error(140_pInt,ext_msg=key) -end function getFloats +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/crystallite.f90 b/src/crystallite.f90 index 53d38a770..4a086ba8a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -192,7 +192,7 @@ subroutine crystallite_init myNcomponents, & !< number of components at current IP mySize - character(len=64), dimension(:), allocatable :: str + character(len=65536), dimension(:), allocatable :: str character(len=65536) :: & tag = '' @@ -268,7 +268,13 @@ subroutine crystallite_init do c = 1_pInt, material_Ncrystallite - str = crystalliteConfig(c)%getStrings('(output)',defaultVal=[character(len=65536)::]) +#if defined(__GFORTRAN__) + str = ['GfortranBug86277'] + str = crystalliteConfig(c)%getStrings('(output)',defaultVal=str) + if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] +#else + str = crystalliteConfig(c)%getStrings('(output)',defaultVal=[character(len=65536)::]) +#endif do o = 1_pInt, size(str) crystallite_output(o,c) = str(o) outputName: select case(str(o)) diff --git a/src/material.f90 b/src/material.f90 index 48e71af07..5462f3e9d 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -811,59 +811,72 @@ subroutine material_parsePhase allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),material_Nphase), & source=STIFFNESS_DEGRADATION_undefined_ID) do p=1_pInt, material_Nphase - if (phase_Nsources(p) /= 0_pInt) then - str = phaseConfig(p)%getStrings('(source)') - do sourceCtr = 1_pInt, size(str) - select case (trim(str(sourceCtr))) - case (SOURCE_thermal_dissipation_label) - phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID - case (SOURCE_thermal_externalheat_label) - phase_source(sourceCtr,p) = SOURCE_thermal_externalheat_ID - case (SOURCE_damage_isoBrittle_label) - phase_source(sourceCtr,p) = SOURCE_damage_isoBrittle_ID - case (SOURCE_damage_isoDuctile_label) - phase_source(sourceCtr,p) = SOURCE_damage_isoDuctile_ID - case (SOURCE_damage_anisoBrittle_label) - phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID - case (SOURCE_damage_anisoDuctile_label) - phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID - case (SOURCE_vacancy_phenoplasticity_label) - phase_source(sourceCtr,p) = SOURCE_vacancy_phenoplasticity_ID - case (SOURCE_vacancy_irradiation_label) - phase_source(sourceCtr,p) = SOURCE_vacancy_irradiation_ID - case (SOURCE_vacancy_thermalfluc_label) - phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID - end select - enddo - endif - if (phase_Nkinematics(p) /= 0_pInt) then - str = phaseConfig(p)%getStrings('(kinematics)') - do kinematicsCtr = 1_pInt, size(str) - select case (trim(str(kinematicsCtr))) - case (KINEMATICS_cleavage_opening_label) - phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID - case (KINEMATICS_slipplane_opening_label) - phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID - case (KINEMATICS_thermal_expansion_label) - phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID - case (KINEMATICS_vacancy_strain_label) - phase_kinematics(kinematicsCtr,p) = KINEMATICS_vacancy_strain_ID - case (KINEMATICS_hydrogen_strain_label) - phase_kinematics(kinematicsCtr,p) = KINEMATICS_hydrogen_strain_ID - end select - enddo - endif - if (phase_NstiffnessDegradations(p) /= 0_pInt) then - str = phaseConfig(p)%getStrings('(stiffness_degradation)') - do stiffDegradationCtr = 1_pInt, size(str) - select case (trim(str(stiffDegradationCtr))) - case (STIFFNESS_DEGRADATION_damage_label) - phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID - case (STIFFNESS_DEGRADATION_porosity_label) - phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_porosity_ID - end select - enddo - endif +#if defined(__GFORTRAN__) + str = ['GfortranBug86277'] + str = phaseConfig(p)%getStrings('(source)',defaultVal=str) + if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] +#else + str = phaseConfig(p)%getStrings('(source)',defaultVal=[character(len=65536)::]) +#endif + do sourceCtr = 1_pInt, size(str) + select case (trim(str(sourceCtr))) + case (SOURCE_thermal_dissipation_label) + phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID + case (SOURCE_thermal_externalheat_label) + phase_source(sourceCtr,p) = SOURCE_thermal_externalheat_ID + case (SOURCE_damage_isoBrittle_label) + phase_source(sourceCtr,p) = SOURCE_damage_isoBrittle_ID + case (SOURCE_damage_isoDuctile_label) + phase_source(sourceCtr,p) = SOURCE_damage_isoDuctile_ID + case (SOURCE_damage_anisoBrittle_label) + phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID + case (SOURCE_damage_anisoDuctile_label) + phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID + case (SOURCE_vacancy_phenoplasticity_label) + phase_source(sourceCtr,p) = SOURCE_vacancy_phenoplasticity_ID + case (SOURCE_vacancy_irradiation_label) + phase_source(sourceCtr,p) = SOURCE_vacancy_irradiation_ID + case (SOURCE_vacancy_thermalfluc_label) + phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID + end select + enddo + +#if defined(__GFORTRAN__) + str = ['GfortranBug86277'] + str = phaseConfig(p)%getStrings('(kinematics)',defaultVal=str) + if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] +#else + str = phaseConfig(p)%getStrings('(kinematics)',defaultVal=[character(len=65536)::]) +#endif + do kinematicsCtr = 1_pInt, size(str) + select case (trim(str(kinematicsCtr))) + case (KINEMATICS_cleavage_opening_label) + phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID + case (KINEMATICS_slipplane_opening_label) + phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID + case (KINEMATICS_thermal_expansion_label) + phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID + case (KINEMATICS_vacancy_strain_label) + phase_kinematics(kinematicsCtr,p) = KINEMATICS_vacancy_strain_ID + case (KINEMATICS_hydrogen_strain_label) + phase_kinematics(kinematicsCtr,p) = KINEMATICS_hydrogen_strain_ID + end select + enddo +#if defined(__GFORTRAN__) + str = ['GfortranBug86277'] + str = phaseConfig(p)%getStrings('(stiffness_degradation)',defaultVal=str) + if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] +#else + str = phaseConfig(p)%getStrings('(stiffness_degradation)',defaultVal=[character(len=65536)::]) +#endif + do stiffDegradationCtr = 1_pInt, size(str) + select case (trim(str(stiffDegradationCtr))) + case (STIFFNESS_DEGRADATION_damage_label) + phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID + case (STIFFNESS_DEGRADATION_porosity_label) + phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_porosity_ID + end select + enddo enddo allocate(phase_plasticityInstance(material_Nphase), source=0_pInt) diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 5d98a647b..6c2dc2ce4 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -162,7 +162,13 @@ use IO prm%dilatation = phaseConfig(phase)%keyExists('/dilatation/') +#if defined(__GFORTRAN__) + outputs = ['GfortranBug86277'] + outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=outputs) + if (outputs(1) == 'GfortranBug86277') outputs = [character(len=65536)::] +#else outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=[character(len=65536)::]) +#endif allocate(prm%outputID(0)) do i=1_pInt, size(outputs) select case(outputs(i))