From 8867322713cb704eaf575c7ade9a77081d12660c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 10:02:37 +0200 Subject: [PATCH 1/6] data structure to store material.config chained list data structure to store string and stringPos. Performance-wise not 100% optimal as searching requires to parse all elements in the list. However, secions are typically rather small (usually Order 1 to 3) and parsing from file is much slower. Also, only the actual length of the array is stored (thats wy I preferred the list over a 2D array) --- src/CMakeLists.txt | 6 +- src/commercialFEM_fileList.f90 | 1 + src/list.f90 | 171 +++++++++++++++++++++++++++++++++ 3 files changed, 177 insertions(+), 1 deletion(-) create mode 100644 src/list.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9789ec67d..7b013fe5f 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -30,6 +30,10 @@ add_library(IO OBJECT "IO.f90") add_dependencies(IO DAMASK_INTERFACE) list(APPEND OBJECTFILES $) +add_library(CHAINED_LIST OBJECT "list.f90") +add_dependencies(CHAINED_LIST IO) +list(APPEND OBJECTFILES $) + add_library(NUMERICS OBJECT "numerics.f90") add_dependencies(NUMERICS IO) list(APPEND OBJECTFILES $) @@ -61,7 +65,7 @@ elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM") endif() add_library(MATERIAL OBJECT "material.f90") -add_dependencies(MATERIAL MESH) +add_dependencies(MATERIAL MESH CHAINED_LIST) list(APPEND OBJECTFILES $) add_library(DAMASK_HELPERS OBJECT "lattice.f90") diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index f57f03467..f1651dea8 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -4,6 +4,7 @@ !> @details List of files needed by MSC.Marc, Abaqus/Explicit, and Abaqus/Standard !-------------------------------------------------------------------------------------------------- #include "IO.f90" +#include "list.f90" #include "numerics.f90" #include "debug.f90" #include "math.f90" diff --git a/src/list.f90 b/src/list.f90 new file mode 100644 index 000000000..516f001f6 --- /dev/null +++ b/src/list.f90 @@ -0,0 +1,171 @@ +module chained_list + use prec + implicit none + + type tPartitionedString + character(len=:), allocatable :: val + integer(pInt), dimension(:), allocatable :: pos + end type + + type, public :: tPartitionedStringList + type(tPartitionedString) :: string + type(tPartitionedStringList), pointer :: next => null() + contains + procedure :: add => add + procedure :: getFloat => getFloat + procedure :: getFloatArray => getFloatArray + procedure :: getStrings => getStrings + procedure :: keyExists => keyExists + end type tPartitionedStringList + + + contains + subroutine add(self,string,stringPos) + implicit none + class(tPartitionedStringList) :: self + type(tPartitionedStringList), pointer :: new,tmp + character(len=*), intent(in) :: string + integer(pInt), dimension(:), intent(in) :: stringPos + + allocate(new) + + new%string%val=string + new%string%pos=stringPos + + if (.not. associated(self%next)) then + self%next => new + else + tmp => self%next + self%next => new + self%next%next => tmp + end if + + end subroutine add + + +! gets float value, if key is not found exits with error unless default is given + function getFloat(self,key,default) + use IO + + implicit none + real(pReal) :: getFloat + + class(tPartitionedStringList), intent(in) :: self + character(len=*), intent(in) :: key + real(pReal), intent(in), optional :: default + type(tPartitionedStringList), pointer :: tmp + + tmp => self%next + do + if (.not. associated(tmp)) then + if(present(default)) then + getFloat = default + exit + else + call IO_error(1_pInt,ext_msg=key) + endif + endif + if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + if (tmp%string%pos(1) > 2) call IO_error(1_pInt,ext_msg=key) + getFloat = IO_FloatValue(tmp%string%val,tmp%string%pos,2) + exit + endif + tmp => tmp%next + end do + end function + +! reports wether a key exists at least once + function keyExists(self,key) + use IO + + implicit none + logical :: keyExists + + class(tPartitionedStringList), intent(in) :: self + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: tmp + + keyExists = .false. + + tmp => self%next + do + if (.not. associated(tmp)) exit + if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + keyExists = .true. + exit + endif + tmp => tmp%next + end do + end function + + function getFloatArray(self,key) + use IO + + implicit none + real(pReal),dimension(:),allocatable :: getFloatArray + + class(tPartitionedStringList), intent(in) :: self + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: tmp + integer(pInt) :: i + + allocate(getFloatArray(0)) + + tmp => self%next + do + if (.not. associated(tmp)) exit + if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + do i = 2_pInt, tmp%string%pos(1) + getFloatArray = [getFloatArray,IO_FloatValue(tmp%string%val,tmp%string%pos,i)] + enddo + exit + endif + tmp => tmp%next + end do + end function + + + function getStrings(self,key) + use IO + + implicit none + character(len=64),dimension(:),allocatable :: getStrings + character(len=64) :: str + + class(tPartitionedStringList), intent(in) :: self + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: tmp + integer(pInt) :: i + + tmp => self%next + do + if (.not. associated(tmp)) exit + if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + if (tmp%string%pos(1) < 2) print*, "NOT WORKKING" + str = IO_StringValue(tmp%string%val,tmp%string%pos,2) + if (.not. allocated(getStrings)) then + getStrings = [str] + else + getStrings = [getStrings,str] + endif + endif + tmp => tmp%next + end do + end function + +! subroutine free_all() +! implicit none +! +! type(node), pointer :: tmp +! +! do +! tmp => first +! +! if (associated(tmp) .eqv. .FALSE.) exit +! +! first => first%next +! deallocate(tmp) +! end do +! end subroutine free_all + +end module chained_list From 052a0af2acdbf89df020e9002b6318f08557e608 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 10:14:46 +0200 Subject: [PATCH 2/6] storing phase part of material.config per section in chained list --- src/material.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/material.f90 b/src/material.f90 index 25d115520..cbfff1e78 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -7,6 +7,7 @@ !! 'phase', 'texture', and 'microstucture' !-------------------------------------------------------------------------------------------------- module material + use chained_list use prec, only: & pReal, & pInt, & @@ -304,6 +305,8 @@ module material vacancyConcRate, & !< vacancy conc change field hydrogenConcRate !< hydrogen conc change field + type(tPartitionedStringList), public,protected, allocatable, dimension(:) :: phaseConfig + public :: & material_init, & ELASTICITY_hooke_ID ,& @@ -933,6 +936,8 @@ subroutine material_parsePhase(fileUnit,myPart) allocate(phase_Noutput(Nsections), source=0_pInt) allocate(phase_localPlasticity(Nsections), source=.false.) + allocate(phaseConfig(Nsections)) + phase_Noutput = IO_countTagInPart(fileUnit,myPart,'(output)',Nsections) phase_Nsources = IO_countTagInPart(fileUnit,myPart,'(source)',Nsections) phase_Nkinematics = IO_countTagInPart(fileUnit,myPart,'(kinematics)',Nsections) @@ -970,6 +975,7 @@ subroutine material_parsePhase(fileUnit,myPart) if (section > 0_pInt) then chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + call phaseConfig(section)%add(trim(line),chunkPos) select case(tag) case ('elasticity') select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) From 5de4b47438cf33405866684642757e675fdf3c0c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 10:24:42 +0200 Subject: [PATCH 3/6] plastic isotropic parses material.config from main memory, not from file --- src/constitutive.f90 | 2 +- src/plastic_isotropic.f90 | 220 ++++++++++++-------------------------- 2 files changed, 69 insertions(+), 153 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index a62245f99..424d53b7e 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -157,7 +157,7 @@ subroutine constitutive_init() !-------------------------------------------------------------------------------------------------- ! parse plasticities from config file if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init - if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT) diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index ad62ed398..206462ca9 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -40,17 +40,17 @@ module plastic_isotropic gdot0, & n, & h0, & - h0_slopeLnRate = 0.0_pReal, & + h0_slopeLnRate, & tausat, & a, & - aTolFlowstress = 1.0_pReal, & - aTolShear = 1.0e-6_pReal, & - tausat_SinhFitA= 0.0_pReal, & - tausat_SinhFitB= 0.0_pReal, & - tausat_SinhFitC= 0.0_pReal, & - tausat_SinhFitD= 0.0_pReal + aTolFlowstress, & + aTolShear, & + tausat_SinhFitA, & + tausat_SinhFitB, & + tausat_SinhFitC, & + tausat_SinhFitD logical :: & - dilatation = .false. + dilatation end type type(tParameters), dimension(:), allocatable, target, private :: param !< containers of constitutive parameters (len Ninstance) @@ -79,12 +79,13 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine plastic_isotropic_init(fileUnit) +subroutine plastic_isotropic_init() #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & compiler_options #endif +use IO use debug, only: & debug_level, & debug_constitutive, & @@ -94,17 +95,6 @@ subroutine plastic_isotropic_init(fileUnit) use math, only: & math_Mandel3333to66, & math_Voigt66to3333 - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_error, & - IO_timeStamp, & - IO_EOF use material, only: & phase_plasticity, & phase_plasticityInstance, & @@ -113,16 +103,15 @@ subroutine plastic_isotropic_init(fileUnit) PLASTICITY_ISOTROPIC_ID, & material_phase, & plasticState, & - MATERIAL_partPhase + MATERIAL_partPhase, & + phaseConfig use lattice implicit none - integer(pInt), intent(in) :: fileUnit type(tParameters), pointer :: p - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & o, & phase, & @@ -133,160 +122,90 @@ subroutine plastic_isotropic_init(fileUnit) sizeState, & sizeDeltaState character(len=65536) :: & - tag = '', & - line = '', & extmsg = '' - character(len=64) :: & - outputtag = '' - integer(pInt) :: NipcMyPhase + integer(pInt) :: NipcMyPhase,i + character(len=64), dimension(:), allocatable :: outputs write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_ISOTROPIC_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" maxNinstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt) - if (maxNinstance == 0_pInt) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance +! public variables allocate(plastic_isotropic_sizePostResults(maxNinstance), source=0_pInt) allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt) allocate(plastic_isotropic_output(maxval(phase_Noutput), maxNinstance)) plastic_isotropic_output = '' allocate(plastic_isotropic_Noutput(maxNinstance), source=0_pInt) +! inernal variable allocate(param(maxNinstance)) ! one container of parameters per instance - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next section - phase = phase + 1_pInt ! advance section counter - cycle ! skip to next line - endif - if (phase > 0_pInt) then; if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran - instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - p => param(instance) ! shorthand pointer to parameter object of my constitutive law - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - - select case(tag) - case ('(output)') - outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case(outputtag) - case ('flowstress') - plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt - plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputtag - p%outputID = [p%outputID,flowstress_ID] - case ('strainrate') - plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt - plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputtag - p%outputID = [p%outputID,strainrate_ID] - end select - - case ('/dilatation/') - p%dilatation = .true. - - case ('tau0') - p%tau0 = IO_floatValue(line,chunkPos,2_pInt) - - case ('gdot0') - p%gdot0 = IO_floatValue(line,chunkPos,2_pInt) - - case ('n') - p%n = IO_floatValue(line,chunkPos,2_pInt) - - case ('h0') - p%h0 = IO_floatValue(line,chunkPos,2_pInt) - - case ('h0_slope','slopelnrate') - p%h0_slopeLnRate = IO_floatValue(line,chunkPos,2_pInt) - - case ('tausat') - p%tausat = IO_floatValue(line,chunkPos,2_pInt) - - case ('tausat_sinhfita') - p%tausat_SinhFitA = IO_floatValue(line,chunkPos,2_pInt) - - case ('tausat_sinhfitb') - p%tausat_SinhFitB = IO_floatValue(line,chunkPos,2_pInt) - - case ('tausat_sinhfitc') - p%tausat_SinhFitC = IO_floatValue(line,chunkPos,2_pInt) - - case ('tausat_sinhfitd') - p%tausat_SinhFitD = IO_floatValue(line,chunkPos,2_pInt) - - case ('a', 'w0') - p%a = IO_floatValue(line,chunkPos,2_pInt) - - case ('taylorfactor') - p%fTaylor = IO_floatValue(line,chunkPos,2_pInt) - - case ('atol_flowstress') - p%aTolFlowstress = IO_floatValue(line,chunkPos,2_pInt) - - case ('atol_shear') - p%aTolShear = IO_floatValue(line,chunkPos,2_pInt) - - case default - - end select - endif; endif - enddo parsingFile - allocate(state(maxNinstance)) ! internal state aliases allocate(dotState(maxNinstance)) - initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop over every plasticity - myPhase: if (phase_plasticity(phase) == PLASTICITY_isotropic_ID) then ! isolate instances of own constitutive description - NipcMyPhase = count(material_phase == phase) ! number of own material points (including point components ipc) + do phase = 1_pInt, size(phase_plasticityInstance) + if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then instance = phase_plasticityInstance(phase) - p => param(instance) + 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('taylorfactor') + p%h0_slopeLnRate = phaseConfig(phase)%getFloat('h0_slopelnrate', default=0.0_pReal) ! ToDo: alias allowed? + p%tausat_SinhFitA = phaseConfig(phase)%getFloat('tausat_sinhfita',default=0.0_pReal) + p%tausat_SinhFitB = phaseConfig(phase)%getFloat('tausat_sinhfitb',default=0.0_pReal) + p%tausat_SinhFitC = phaseConfig(phase)%getFloat('tausat_sinhfitc',default=0.0_pReal) + p%tausat_SinhFitD = phaseConfig(phase)%getFloat('tausat_sinhfitd',default=0.0_pReal) + p%a = phaseConfig(phase)%getFloat('a') ! ToDo: alias + p%aTolFlowStress = phaseConfig(phase)%getFloat('atol_flowstress',default=1.0_pReal) + p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',default=1.0e-6_pReal) + + p%dilatation = phaseConfig(phase)%keyExists('/dilatation/') + outputs = phaseConfig(phase)%getStrings('(output)') + allocate(p%outputID(0)) + do i=1_pInt, size(outputs) + select case(outputs(i)) + case ('flowstress') + plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt + plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i) + plastic_isotropic_sizePostResults(instance) = & + plastic_isotropic_sizePostResults(instance) + 1_pInt + plastic_isotropic_sizePostResult(i,instance) = 1_pInt + p%outputID = [p%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) + plastic_isotropic_sizePostResults(instance) = & + plastic_isotropic_sizePostResults(instance) + 1_pInt + plastic_isotropic_sizePostResult(i,instance) = 1_pInt + p%outputID = [p%outputID,strainrate_ID] + end select + enddo extmsg = '' !-------------------------------------------------------------------------------------------------- ! sanity checks - if (p%aTolShear <= 0.0_pReal) p%aTolShear = 1.0e-6_pReal ! default absolute tolerance 1e-6 - 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 <= 0.0_pReal) extmsg = trim(extmsg)//' tausat' - if (p%a <= 0.0_pReal) extmsg = trim(extmsg)//' a' - if (p%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//' taylorfactor' - if (p%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//' atol_flowstress' + 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 <= 0.0_pReal) extmsg = trim(extmsg)//"'tausat' " + if (p%a <= 0.0_pReal) extmsg = trim(extmsg)//"'a' " + if (p%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//"'taylorfactor' " + if (p%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//"'atol_flowstress' " if (extmsg /= '') then extmsg = trim(extmsg)//' ('//PLASTICITY_ISOTROPIC_label//')' ! prepare error message identifier call IO_error(211_pInt,ip=instance,ext_msg=extmsg) endif -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,plastic_isotropic_Noutput(instance) - select case(p%outputID(o)) - case(flowstress_ID,strainrate_ID) - mySize = 1_pInt - case default - end select - - outputFound: if (mySize > 0_pInt) then - plastic_isotropic_sizePostResult(o,instance) = mySize - plastic_isotropic_sizePostResults(instance) = & - plastic_isotropic_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop !-------------------------------------------------------------------------------------------------- ! allocate state arrays + NipcMyPhase = count(material_phase == phase) ! number of own material points (including point components ipc) + sizeDotState = size(["flowstress ","accumulated_shear"]) sizeDeltaState = 0_pInt ! no sudden jumps in state sizeState = sizeDotState + sizeDeltaState @@ -295,12 +214,8 @@ subroutine plastic_isotropic_init(fileUnit) plasticState(phase)%sizeDeltaState = sizeDeltaState plasticState(phase)%sizePostResults = plastic_isotropic_sizePostResults(instance) plasticState(phase)%nSlip = 1 - plasticState(phase)%nTwin = 0 - plasticState(phase)%nTrans= 0 allocate(plasticState(phase)%aTolState ( sizeState)) - allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase),source=0.0_pReal) allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase),source=0.0_pReal) allocate(plasticState(phase)%state ( sizeState,NipcMyPhase),source=0.0_pReal) @@ -331,11 +246,12 @@ subroutine plastic_isotropic_init(fileUnit) plasticState(phase)%slipRate => plasticState(phase)%dotState(2:2,1:NipcMyPhase) plasticState(phase)%accumulatedSlip => plasticState(phase)%state (2:2,1:NipcMyPhase) - endif myPhase - enddo initializeInstances +endif + enddo end subroutine plastic_isotropic_init + !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- From 48851c00f653968a4b302b38edcdf91a886b767f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 11:24:00 +0200 Subject: [PATCH 4/6] sizePostResults not needed, transpose33 has no advantage over transpose: --- src/plastic_isotropic.f90 | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 206462ca9..5f1fa6ad2 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -13,15 +13,10 @@ module plastic_isotropic implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_isotropic_sizePostResults !< cumulative size of post results - integer(pInt), dimension(:,:), allocatable, target, public :: & plastic_isotropic_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & plastic_isotropic_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & plastic_isotropic_Noutput !< number of outputs per instance @@ -135,7 +130,6 @@ use IO write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance ! public variables - allocate(plastic_isotropic_sizePostResults(maxNinstance), source=0_pInt) allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt) allocate(plastic_isotropic_output(maxval(phase_Noutput), maxNinstance)) plastic_isotropic_output = '' @@ -173,15 +167,15 @@ use IO case ('flowstress') plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i) - plastic_isotropic_sizePostResults(instance) = & - plastic_isotropic_sizePostResults(instance) + 1_pInt + plasticState(phase)%sizePostResults = & + plasticState(phase)%sizePostResults + 1_pInt plastic_isotropic_sizePostResult(i,instance) = 1_pInt p%outputID = [p%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) - plastic_isotropic_sizePostResults(instance) = & - plastic_isotropic_sizePostResults(instance) + 1_pInt + plasticState(phase)%sizePostResults = & + plasticState(phase)%sizePostResults + 1_pInt plastic_isotropic_sizePostResult(i,instance) = 1_pInt p%outputID = [p%outputID,strainrate_ID] end select @@ -212,7 +206,6 @@ use IO plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = plastic_isotropic_sizePostResults(instance) plasticState(phase)%nSlip = 1 allocate(plasticState(phase)%aTolState ( sizeState)) allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase),source=0.0_pReal) @@ -270,8 +263,7 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) math_Mandel6to33, & math_Plain3333to99, & math_deviatoric33, & - math_mul33xx33, & - math_transpose33 + math_mul33xx33 use material, only: & phasememberAt, & material_phase, & @@ -327,7 +319,7 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then write(6,'(a,i8,1x,i2,1x,i3)') '<< CONST isotropic >> at el ip g ',el,ip,ipc write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CONST isotropic >> Tstar (dev) / MPa', & - math_transpose33(Tstar_dev_33(1:3,1:3))*1.0e-6_pReal + transpose(Tstar_dev_33(1:3,1:3))*1.0e-6_pReal write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Tstar_dev*1.0e-6_pReal write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> gdot', gamma_dot end if @@ -500,6 +492,7 @@ function plastic_isotropic_postResults(Tstar_v,ipc,ip,el) use math, only: & math_mul6x6 use material, only: & + plasticState, & material_phase, & phasememberAt, & phase_plasticityInstance @@ -514,7 +507,7 @@ function plastic_isotropic_postResults(Tstar_v,ipc,ip,el) type(tParameters), pointer :: p - real(pReal), dimension(plastic_isotropic_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & plastic_isotropic_postResults real(pReal), dimension(6) :: & From cfefcaebb8308fd81cd01718e91b2ef2581e2407 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 11:33:13 +0200 Subject: [PATCH 5/6] simplifying --- src/plastic_isotropic.f90 | 43 +++++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 5f1fa6ad2..2e904410c 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -160,41 +160,40 @@ use IO p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',default=1.0e-6_pReal) p%dilatation = phaseConfig(phase)%keyExists('/dilatation/') + outputs = phaseConfig(phase)%getStrings('(output)') allocate(p%outputID(0)) do i=1_pInt, size(outputs) - select case(outputs(i)) - case ('flowstress') - 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,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] - end select + select case(outputs(i)) + case ('flowstress') + 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,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] + end select enddo - extmsg = '' + !-------------------------------------------------------------------------------------------------- ! 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 <= 0.0_pReal) extmsg = trim(extmsg)//"'tausat' " + 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)//"'taylorfactor' " if (p%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//"'atol_flowstress' " - if (extmsg /= '') then - extmsg = trim(extmsg)//' ('//PLASTICITY_ISOTROPIC_label//')' ! prepare error message identifier - call IO_error(211_pInt,ip=instance,ext_msg=extmsg) - endif + if (extmsg /= '') call IO_error(211_pInt,ip=instance,& + ext_msg=trim(extmsg)//'('//PLASTICITY_ISOTROPIC_label//')') !-------------------------------------------------------------------------------------------------- ! allocate state arrays From c8cec5a1213d22fc7fd6d3b52dd6197a487ad906 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 14:14:53 +0200 Subject: [PATCH 6/6] some more functions to parse material.config from memory --- src/list.f90 | 383 ++++++++++++++++++++++++++++---------- src/plastic_isotropic.f90 | 14 +- 2 files changed, 293 insertions(+), 104 deletions(-) diff --git a/src/list.f90 b/src/list.f90 index 516f001f6..e56d86067 100644 --- a/src/list.f90 +++ b/src/list.f90 @@ -1,93 +1,308 @@ module chained_list - use prec + 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 :: getRaw => getRaw + procedure :: getRaws => getRaws + + procedure :: getFloat => getFloat + procedure :: getFloatArray => getFloatArray + + procedure :: getInt => getInt + procedure :: getIntArray => getIntArray + + procedure :: getStrings => getStrings + procedure :: keyExists => keyExists + + end type tPartitionedStringList + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief add element +!> @details adds raw string and start/end position of chunks in this string +!-------------------------------------------------------------------------------------------------- +subroutine add(this,string,stringPos) implicit none - - type tPartitionedString - character(len=:), allocatable :: val - integer(pInt), dimension(:), allocatable :: pos - end type - - type, public :: tPartitionedStringList - type(tPartitionedString) :: string - type(tPartitionedStringList), pointer :: next => null() - contains - procedure :: add => add - procedure :: getFloat => getFloat - procedure :: getFloatArray => getFloatArray - procedure :: getStrings => getStrings - procedure :: keyExists => keyExists - end type tPartitionedStringList - + class(tPartitionedStringList) :: this + type(tPartitionedStringList), pointer :: & + new, & + tmp + character(len=*), intent(in) :: string + integer(pInt), dimension(:), intent(in) :: stringPos - contains - subroutine add(self,string,stringPos) - implicit none - class(tPartitionedStringList) :: self - type(tPartitionedStringList), pointer :: new,tmp - character(len=*), intent(in) :: string - integer(pInt), dimension(:), intent(in) :: stringPos + allocate(new) + new%string%val=string + new%string%pos=stringPos - allocate(new) + if (.not. associated(this%next)) then + this%next => new + else + tmp => this%next + this%next => new + this%next%next => tmp + end if - new%string%val=string - new%string%pos=stringPos - - if (.not. associated(self%next)) then - self%next => new - else - tmp => self%next - self%next => new - self%next%next => tmp - end if - - end subroutine add +end subroutine add -! gets float value, if key is not found exits with error unless default is given - function getFloat(self,key,default) - use IO +!-------------------------------------------------------------------------------------------------- +!> @brief gets raw data +!> @details returns raw string and start/end position of chunks in this string +!-------------------------------------------------------------------------------------------------- +subroutine getRaw(this,key,string,stringPos) + use IO, only : & + IO_error, & + IO_stringValue - implicit none - real(pReal) :: getFloat + implicit none + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + integer(pInt), dimension(:),allocatable, intent(out) :: stringPos + character(len=*), intent(out) :: string + type(tPartitionedStringList), pointer :: tmp - class(tPartitionedStringList), intent(in) :: self - character(len=*), intent(in) :: key - real(pReal), intent(in), optional :: default - type(tPartitionedStringList), pointer :: tmp + tmp => this%next + do + if (.not. associated(tmp)) call IO_error(1_pInt,ext_msg=key) + foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + stringPos = tmp%string%pos + string = tmp%string%val + exit + endif foundKey + tmp => tmp%next + end do +end subroutine getRaw - tmp => self%next - do - if (.not. associated(tmp)) then - if(present(default)) then - getFloat = default - exit - else - call IO_error(1_pInt,ext_msg=key) - endif - endif - if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then - if (tmp%string%pos(1) > 2) call IO_error(1_pInt,ext_msg=key) - getFloat = IO_FloatValue(tmp%string%val,tmp%string%pos,2) - exit - endif - tmp => tmp%next - end do - end function + +!-------------------------------------------------------------------------------------------------- +!> @brief gets raw data +!> @details returns raw string and start/end position of chunks in this string +!-------------------------------------------------------------------------------------------------- +subroutine getRaws(this,key,string,stringPos) + use IO, only: & + IO_error, & + IO_stringValue + + implicit none + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + integer(pInt), dimension(:,:),allocatable, intent(out) :: stringPos + character(len=256), dimension(:),allocatable, intent(out) :: string + character(len=256) :: stringTmp + integer(pInt) :: posSize + integer(pInt), dimension(:),allocatable :: stringPosFlat + type(tPartitionedStringList), pointer :: tmp + + posSize = -1_pInt + tmp => this%next + do + if (.not. associated(tmp)) then + if(posSize < 0_pInt) call IO_error(1_pInt,ext_msg=key) + stringPos = reshape(stringPosFlat,[posSize,size(string)]) + exit + endif + foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + if (posSize < 0_pInt) then + posSize = size(tmp%string%pos) + stringPosFlat = tmp%string%pos + allocate(string(1)) + string(1) = tmp%string%val + else + if (size(tmp%string%pos) /= posSize) call IO_error(1_pInt,ext_msg=key) + stringPosFlat = [stringPosFlat,tmp%string%pos] + stringTmp = tmp%string%val + string = [string,stringTmp] + endif + endif foundKey + tmp => tmp%next + end do +end subroutine getRaws + + +!-------------------------------------------------------------------------------------------------- +!> @brief gets float value for given key +!> @details 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 :: tmp + + tmp => this%next + do + endOfList: if (.not. associated(tmp)) then + if(present(defaultVal)) then + getFloat = defaultVal + exit + else + call IO_error(1_pInt,ext_msg=key) + endif + endif endOfList + foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key) + getFloat = IO_FloatValue(tmp%string%val,tmp%string%pos,2) + exit + endif foundKey + tmp => tmp%next + end do +end function getFloat + + +!-------------------------------------------------------------------------------------------------- +!> @brief gets float value for given key +!> @details 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 :: tmp + + tmp => this%next + do + endOfList: if (.not. associated(tmp)) then + if(present(defaultVal)) then + getInt = defaultVal + exit + else + call IO_error(1_pInt,ext_msg=key) + endif + endif endOfList + foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key) + getInt = IO_IntValue(tmp%string%val,tmp%string%pos,2) + exit + endif foundKey + tmp => tmp%next + end do +end function getInt + + +!-------------------------------------------------------------------------------------------------- +!> @brief gets array of int values for given key +!> @details if key is not found exits with error unless default is given +!-------------------------------------------------------------------------------------------------- +function getIntArray(this,key,defaultVal) + use IO, only: & + IO_error, & + IO_stringValue, & + IO_IntValue + + implicit none + integer(pInt), dimension(:), allocatable :: getIntArray + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + integer(pInt),dimension(:), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: tmp + integer(pInt) :: i + + allocate(getIntArray(0)) + + tmp => this%next + do + endOfList: if (.not. associated(tmp)) then + if(present(defaultVal)) then + getIntArray = defaultVal + exit + else + call IO_error(1_pInt,ext_msg=key) + endif + endif endOfList + foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key) + do i = 2_pInt, tmp%string%pos(1) + getIntArray = [getIntArray,IO_IntValue(tmp%string%val,tmp%string%pos,i)] + enddo + exit + endif foundKey + tmp => tmp%next + end do +end function getIntArray + + + +!-------------------------------------------------------------------------------------------------- +!> @brief gets array of float values for given key +!> @details if key is not found exits with error unless default is given +!-------------------------------------------------------------------------------------------------- +function getFloatArray(this,key,defaultVal) + use IO, only: & + IO_error, & + IO_stringValue, & + IO_FloatValue + + implicit none + real(pReal), dimension(:), allocatable :: getFloatArray + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + real(pReal),dimension(:), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: tmp + integer(pInt) :: i + + allocate(getFloatArray(0)) + + tmp => this%next + do + endOfList: if (.not. associated(tmp)) then + if(present(defaultVal)) then + getFloatArray = defaultVal + exit + else + call IO_error(1_pInt,ext_msg=key) + endif + endif endOfList + foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key) + do i = 2_pInt, tmp%string%pos(1) + getFloatArray = [getFloatArray,IO_FloatValue(tmp%string%val,tmp%string%pos,i)] + enddo + exit + endif foundKey + tmp => tmp%next + end do +end function getFloatArray ! reports wether a key exists at least once - function keyExists(self,key) + function keyExists(this,key) use IO implicit none logical :: keyExists - class(tPartitionedStringList), intent(in) :: self + class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key type(tPartitionedStringList), pointer :: tmp keyExists = .false. - tmp => self%next + tmp => this%next do if (.not. associated(tmp)) exit if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then @@ -98,46 +313,20 @@ module chained_list end do end function - function getFloatArray(self,key) - use IO - implicit none - real(pReal),dimension(:),allocatable :: getFloatArray - - class(tPartitionedStringList), intent(in) :: self - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: tmp - integer(pInt) :: i - - allocate(getFloatArray(0)) - - tmp => self%next - do - if (.not. associated(tmp)) exit - if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then - do i = 2_pInt, tmp%string%pos(1) - getFloatArray = [getFloatArray,IO_FloatValue(tmp%string%val,tmp%string%pos,i)] - enddo - exit - endif - tmp => tmp%next - end do - end function - - - function getStrings(self,key) + function getStrings(this,key) use IO implicit none character(len=64),dimension(:),allocatable :: getStrings character(len=64) :: str - class(tPartitionedStringList), intent(in) :: self + class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key type(tPartitionedStringList), pointer :: tmp integer(pInt) :: i - tmp => self%next + tmp => this%next do if (.not. associated(tmp)) exit if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 2e904410c..31312d936 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -150,14 +150,14 @@ use IO p%n = phaseConfig(phase)%getFloat('n') p%h0 = phaseConfig(phase)%getFloat('h0') p%fTaylor = phaseConfig(phase)%getFloat('taylorfactor') - p%h0_slopeLnRate = phaseConfig(phase)%getFloat('h0_slopelnrate', default=0.0_pReal) ! ToDo: alias allowed? - p%tausat_SinhFitA = phaseConfig(phase)%getFloat('tausat_sinhfita',default=0.0_pReal) - p%tausat_SinhFitB = phaseConfig(phase)%getFloat('tausat_sinhfitb',default=0.0_pReal) - p%tausat_SinhFitC = phaseConfig(phase)%getFloat('tausat_sinhfitc',default=0.0_pReal) - p%tausat_SinhFitD = phaseConfig(phase)%getFloat('tausat_sinhfitd',default=0.0_pReal) + 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',default=1.0_pReal) - p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',default=1.0e-6_pReal) + p%aTolFlowStress = phaseConfig(phase)%getFloat('atol_flowstress',defaultVal=1.0_pReal) + p%aTolShear = phaseConfig(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) p%dilatation = phaseConfig(phase)%keyExists('/dilatation/')