From 8867322713cb704eaf575c7ade9a77081d12660c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 10:02:37 +0200 Subject: [PATCH 01/94] 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 02/94] 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 03/94] 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 04/94] 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 05/94] 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 06/94] 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/') From f8432542338fe21daac001e1ad0694cf02ee99ac Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 20:54:40 +0200 Subject: [PATCH 07/94] Noutput not needed, using size ensures consistency --- src/constitutive.f90 | 23 +++-------------------- 1 file changed, 3 insertions(+), 20 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 424d53b7e..a7ca64506 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -143,7 +143,6 @@ subroutine constitutive_init() ins !< instance of plasticity/source integer(pInt), dimension(:,:), pointer :: thisSize - integer(pInt), dimension(:) , pointer :: thisNoutput character(len=64), dimension(:,:), pointer :: thisOutput character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready logical :: knownPlasticity, knownSource, nonlocalConstitutionPresent @@ -158,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 - if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(FILEUNIT) @@ -205,37 +204,30 @@ subroutine constitutive_init() plasticityType: select case(phase_plasticity(p)) case (PLASTICITY_NONE_ID) plasticityType outputName = PLASTICITY_NONE_label - thisNoutput => null() thisOutput => null() thisSize => null() case (PLASTICITY_ISOTROPIC_ID) plasticityType outputName = PLASTICITY_ISOTROPIC_label - thisNoutput => plastic_isotropic_Noutput thisOutput => plastic_isotropic_output thisSize => plastic_isotropic_sizePostResult case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType outputName = PLASTICITY_PHENOPOWERLAW_label - thisNoutput => plastic_phenopowerlaw_Noutput thisOutput => plastic_phenopowerlaw_output thisSize => plastic_phenopowerlaw_sizePostResult case (PLASTICITY_KINEHARDENING_ID) plasticityType outputName = PLASTICITY_KINEHARDENING_label - thisNoutput => plastic_kinehardening_Noutput thisOutput => plastic_kinehardening_output thisSize => plastic_kinehardening_sizePostResult case (PLASTICITY_DISLOTWIN_ID) plasticityType outputName = PLASTICITY_DISLOTWIN_label - thisNoutput => plastic_dislotwin_Noutput thisOutput => plastic_dislotwin_output thisSize => plastic_dislotwin_sizePostResult case (PLASTICITY_DISLOUCLA_ID) plasticityType outputName = PLASTICITY_DISLOUCLA_label - thisNoutput => plastic_disloucla_Noutput thisOutput => plastic_disloucla_output thisSize => plastic_disloucla_sizePostResult case (PLASTICITY_NONLOCAL_ID) plasticityType outputName = PLASTICITY_NONLOCAL_label - thisNoutput => plastic_nonlocal_Noutput thisOutput => plastic_nonlocal_output thisSize => plastic_nonlocal_sizePostResult case default plasticityType @@ -246,7 +238,7 @@ subroutine constitutive_init() write(FILEUNIT,'(a)') '(plasticity)'//char(9)//trim(outputName) if (phase_plasticity(p) /= PLASTICITY_NONE_ID) then - OutputPlasticityLoop: do o = 1_pInt,thisNoutput(ins) + OutputPlasticityLoop: do o = 1_pInt,size(thisOutput(:,ins)) write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins) enddo OutputPlasticityLoop endif @@ -257,55 +249,46 @@ subroutine constitutive_init() case (SOURCE_thermal_dissipation_ID) sourceType ins = source_thermal_dissipation_instance(p) outputName = SOURCE_thermal_dissipation_label - thisNoutput => source_thermal_dissipation_Noutput thisOutput => source_thermal_dissipation_output thisSize => source_thermal_dissipation_sizePostResult case (SOURCE_thermal_externalheat_ID) sourceType ins = source_thermal_externalheat_instance(p) outputName = SOURCE_thermal_externalheat_label - thisNoutput => source_thermal_externalheat_Noutput thisOutput => source_thermal_externalheat_output thisSize => source_thermal_externalheat_sizePostResult case (SOURCE_damage_isoBrittle_ID) sourceType ins = source_damage_isoBrittle_instance(p) outputName = SOURCE_damage_isoBrittle_label - thisNoutput => source_damage_isoBrittle_Noutput thisOutput => source_damage_isoBrittle_output thisSize => source_damage_isoBrittle_sizePostResult case (SOURCE_damage_isoDuctile_ID) sourceType ins = source_damage_isoDuctile_instance(p) outputName = SOURCE_damage_isoDuctile_label - thisNoutput => source_damage_isoDuctile_Noutput thisOutput => source_damage_isoDuctile_output thisSize => source_damage_isoDuctile_sizePostResult case (SOURCE_damage_anisoBrittle_ID) sourceType ins = source_damage_anisoBrittle_instance(p) outputName = SOURCE_damage_anisoBrittle_label - thisNoutput => source_damage_anisoBrittle_Noutput thisOutput => source_damage_anisoBrittle_output thisSize => source_damage_anisoBrittle_sizePostResult case (SOURCE_damage_anisoDuctile_ID) sourceType ins = source_damage_anisoDuctile_instance(p) outputName = SOURCE_damage_anisoDuctile_label - thisNoutput => source_damage_anisoDuctile_Noutput thisOutput => source_damage_anisoDuctile_output thisSize => source_damage_anisoDuctile_sizePostResult case (SOURCE_vacancy_phenoplasticity_ID) sourceType ins = source_vacancy_phenoplasticity_instance(p) outputName = SOURCE_vacancy_phenoplasticity_label - thisNoutput => source_vacancy_phenoplasticity_Noutput thisOutput => source_vacancy_phenoplasticity_output thisSize => source_vacancy_phenoplasticity_sizePostResult case (SOURCE_vacancy_irradiation_ID) sourceType ins = source_vacancy_irradiation_instance(p) outputName = SOURCE_vacancy_irradiation_label - thisNoutput => source_vacancy_irradiation_Noutput thisOutput => source_vacancy_irradiation_output thisSize => source_vacancy_irradiation_sizePostResult case (SOURCE_vacancy_thermalfluc_ID) sourceType ins = source_vacancy_thermalfluc_instance(p) outputName = SOURCE_vacancy_thermalfluc_label - thisNoutput => source_vacancy_thermalfluc_Noutput thisOutput => source_vacancy_thermalfluc_output thisSize => source_vacancy_thermalfluc_sizePostResult case default sourceType @@ -313,7 +296,7 @@ subroutine constitutive_init() end select sourceType if (knownSource) then write(FILEUNIT,'(a)') '(source)'//char(9)//trim(outputName) - OutputSourceLoop: do o = 1_pInt,thisNoutput(ins) + OutputSourceLoop: do o = 1_pInt,size(thisOutput(:,ins)) write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins) enddo OutputSourceLoop endif From 64270f6c9596bf0baa8a9c339b0604374b38317a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 21:22:19 +0200 Subject: [PATCH 08/94] no need to store trailing whitespace --- src/material.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/material.f90 b/src/material.f90 index cbfff1e78..89a5d9504 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -975,7 +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) + call phaseConfig(section)%add(IO_lc(trim(line)),chunkPos) select case(tag) case ('elasticity') select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) From cd9fb1c5446d85d2086072a61e9e1f771a487a2f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 21:23:25 +0200 Subject: [PATCH 09/94] adjusting variable names in isotropic to DAMASK paper --- PRIVATE | 2 +- src/plastic_isotropic.f90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/PRIVATE b/PRIVATE index cd02f6c1a..076a65960 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit cd02f6c1a481491eb4517651516b8311348b4777 +Subproject commit 076a65960f8df7ab52b4fe67249f0824e003d7eb diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 31312d936..eb3120562 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -149,7 +149,7 @@ use IO 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%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) @@ -190,7 +190,7 @@ use IO 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)//"'taylorfactor' " + if (p%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//"'m' " if (p%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//')') From 70166657a98b12a107d838ad1bac2c62e79d1a61 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 21:25:08 +0200 Subject: [PATCH 10/94] FILEUNIT still needed --- src/constitutive.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index a7ca64506..e2a3f0260 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 - if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_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) if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(FILEUNIT) From 8e0a3ff389c6025abe10f6367f2f190c745c0fdd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Jun 2018 23:14:43 +0200 Subject: [PATCH 11/94] arrays have no variable length, need to check for empty string --- src/constitutive.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e2a3f0260..75906c380 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -239,7 +239,8 @@ subroutine constitutive_init() write(FILEUNIT,'(a)') '(plasticity)'//char(9)//trim(outputName) if (phase_plasticity(p) /= PLASTICITY_NONE_ID) then OutputPlasticityLoop: do o = 1_pInt,size(thisOutput(:,ins)) - write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins) + if(len(trim(thisOutput(o,ins))) > 0_pInt) & + write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins) enddo OutputPlasticityLoop endif endif @@ -297,7 +298,8 @@ subroutine constitutive_init() if (knownSource) then write(FILEUNIT,'(a)') '(source)'//char(9)//trim(outputName) OutputSourceLoop: do o = 1_pInt,size(thisOutput(:,ins)) - write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins) + if(len(trim(thisOutput(o,ins))) > 0_pInt) & + write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins) enddo OutputSourceLoop endif enddo SourceLoop From cbd59fc7812f599ccb4f96549c9aca3671747f04 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 05:50:13 +0200 Subject: [PATCH 12/94] change required due to keyword change --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 076a65960..a11897e49 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 076a65960f8df7ab52b4fe67249f0824e003d7eb +Subproject commit a11897e49af7c0e71ccc74d222a6d502990f730b From bf43156112764edef8d61ad9560ae5a11e064eeb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 06:32:16 +0200 Subject: [PATCH 13/94] search for global tags can stop once first section is found --- src/IO.f90 | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 7291f36ad..d1b039c1e 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -900,10 +900,10 @@ function IO_spotTagInPart(fileUnit,part,tag,Nsections) do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part + foundNextPart: if (IO_getTag(line,'<','>') /= '') then line = IO_read(fileUnit, .true.) ! reset IO_read exit - endif + endif foundNextPart if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (section > 0_pInt) then chunkPos = IO_stringPos(line) @@ -925,13 +925,10 @@ logical function IO_globalTagInPart(fileUnit,part,tag) character(len=*),intent(in) :: part, & !< part in which tag is searched for tag !< tag to search for - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: section character(len=65536) :: line IO_globalTagInPart = .false. ! assume to nowhere spot tag - section = 0_pInt line ='' rewind(fileUnit) @@ -942,16 +939,20 @@ logical function IO_globalTagInPart(fileUnit,part,tag) do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part + foundNextPart: if (IO_getTag(line,'<','>') /= '') then line = IO_read(fileUnit, .true.) ! reset IO_read exit - endif - if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier - if (section == 0_pInt) then - chunkPos = IO_stringPos(line) - if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match - IO_globalTagInPart = .true. - endif + endif foundNextPart + foundFirstSection: if (IO_getTag(line,'[',']') /= '') then + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif foundFirstSection + chunkPos = IO_stringPos(line) + match: if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) then + IO_globalTagInPart = .true. + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif match enddo end function IO_globalTagInPart From 69aee3ccddc2b94d0af47f09b3214147f561a2f5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 09:39:05 +0200 Subject: [PATCH 14/94] read phase part in material.f90 only once and operate then on data in main memory --- src/list.f90 | 89 +++++++++++++++-- src/material.f90 | 254 ++++++++++++++++++++++++----------------------- 2 files changed, 215 insertions(+), 128 deletions(-) diff --git a/src/list.f90 b/src/list.f90 index e56d86067..e4ff83f1d 100644 --- a/src/list.f90 +++ b/src/list.f90 @@ -13,8 +13,10 @@ module chained_list type, public :: tPartitionedStringList type(tPartitionedString) :: string type(tPartitionedStringList), pointer :: next => null() + type(tPartitionedStringList), pointer :: prev => null() contains procedure :: add => add + procedure :: show => show procedure :: getRaw => getRaw procedure :: getRaws => getRaws @@ -24,11 +26,15 @@ module chained_list procedure :: getInt => getInt procedure :: getIntArray => getIntArray + procedure :: getString => getString procedure :: getStrings => getStrings procedure :: keyExists => keyExists + procedure :: countKeys => countKeys end type tPartitionedStringList - + + type(tPartitionedStringList), public :: emptyList + contains !-------------------------------------------------------------------------------------------------- @@ -59,6 +65,24 @@ subroutine add(this,string,stringPos) end subroutine add +!-------------------------------------------------------------------------------------------------- +!> @brief add element +!> @details adds raw string and start/end position of chunks in this string +!-------------------------------------------------------------------------------------------------- +subroutine show(this) + implicit none + class(tPartitionedStringList) :: this + type(tPartitionedStringList), pointer :: tmp + + tmp => this%next + do + if (.not. associated(tmp)) exit + write(6,*) trim(tmp%string%val) + tmp => tmp%next + end do + +end subroutine show + !-------------------------------------------------------------------------------------------------- !> @brief gets raw data !> @details returns raw string and start/end position of chunks in this string @@ -205,6 +229,40 @@ integer(pInt) function getInt(this,key,defaultVal) 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=64) function getString(this,key,defaultVal) + use IO, only: & + IO_error, & + IO_stringValue + + implicit none + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + character(len=64), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: tmp + + tmp => this%next + do + endOfList: if (.not. associated(tmp)) then + if(present(defaultVal)) then + getString = 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) + getString = IO_StringValue(tmp%string%val,tmp%string%pos,2) + exit + endif foundKey + tmp => tmp%next + end do +end function getString + !-------------------------------------------------------------------------------------------------- !> @brief gets array of int values for given key !> @details if key is not found exits with error unless default is given @@ -314,6 +372,27 @@ end function getFloatArray end function + integer(pInt) function countKeys(this,key) + use IO + + implicit none + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: tmp + integer(pInt) :: i + + countKeys = 0_pInt + + tmp => this%next + do + if (.not. associated(tmp)) exit + if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + countKeys = countKeys + 1_pInt + endif + tmp => tmp%next + end do + end function + function getStrings(this,key) use IO @@ -326,17 +405,15 @@ end function getFloatArray type(tPartitionedStringList), pointer :: tmp integer(pInt) :: i + allocate(getStrings(0)) + tmp => this%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 + getStrings = [getStrings,str] endif tmp => tmp%next end do diff --git a/src/material.f90 b/src/material.f90 index 89a5d9504..b8cef8a1a 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -388,8 +388,6 @@ subroutine material_init() mesh_element, & FE_Nips, & FE_geomtype - use numerics, only: & - worldrank implicit none integer(pInt), parameter :: FILEUNIT = 200_pInt @@ -405,11 +403,9 @@ subroutine material_init() myDebug = debug_level(debug_material) - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- material init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- material init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file @@ -894,6 +890,8 @@ end subroutine material_parseCrystallite !> @brief parses the phase part in the material configuration file !-------------------------------------------------------------------------------------------------- subroutine material_parsePhase(fileUnit,myPart) + use chained_list, only: & + emptyList use IO, only: & IO_read, & IO_globalTagInPart, & @@ -917,141 +915,153 @@ subroutine material_parsePhase(fileUnit,myPart) integer(pInt) :: Nsections, section, sourceCtr, kinematicsCtr, stiffDegradationCtr, p character(len=65536) :: & tag,line + character(len=64), dimension(:), allocatable :: & + str logical :: echo - echo = IO_globalTagInPart(fileUnit,myPart,'/echo/') + allocate(phase_name(0)) + allocate(phaseConfig(0)) + line = '' ! to have it initialized + section = 0_pInt ! - " - + echo =.false. - Nsections = IO_countSections(fileUnit,myPart) + rewind(fileUnit) + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to + line = IO_read(fileUnit) + enddo + + do while (trim(line) /= IO_EOF) ! read through sections of material part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + foundNextPart: if (IO_getTag(line,'<','>') /= '') then + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif foundNextPart + nextSection: if (IO_getTag(line,'[',']') /= '') then + section = section + 1_pInt + phaseConfig = [phaseConfig, emptyList] + phase_name = [phase_Name,IO_getTag(line,'[',']')] + endif nextSection + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key + inSection: if (section > 0_pInt) then + chunkPos = IO_stringPos(line) + call phaseConfig(section)%add(IO_lc(trim(line)),chunkPos) + else inSection + echo = (trim(tag) == '/echo/') + endif inSection + enddo + + Nsections = size(phaseConfig) material_Nphase = Nsections if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) - allocate(phase_name(Nsections)); phase_name = '' - allocate(phase_elasticity(Nsections), source=ELASTICITY_undefined_ID) - allocate(phase_elasticityInstance(Nsections), source=0_pInt) - allocate(phase_plasticity(Nsections) , source=PLASTICITY_undefined_ID) - allocate(phase_plasticityInstance(Nsections), source=0_pInt) - allocate(phase_Nsources(Nsections), source=0_pInt) - allocate(phase_Nkinematics(Nsections), source=0_pInt) + allocate(phase_elasticity(Nsections),source=ELASTICITY_undefined_ID) + allocate(phase_plasticity(Nsections),source=PLASTICITY_undefined_ID) + allocate(phase_Nsources(Nsections), source=0_pInt) + allocate(phase_Nkinematics(Nsections), source=0_pInt) allocate(phase_NstiffnessDegradations(Nsections),source=0_pInt) - allocate(phase_Noutput(Nsections), source=0_pInt) - allocate(phase_localPlasticity(Nsections), source=.false.) + allocate(phase_Noutput(Nsections), source=0_pInt) + allocate(phase_localPlasticity(Nsections), source=.false.) - allocate(phaseConfig(Nsections)) + do p=1_pInt, Nsections + phase_Noutput(p) = phaseConfig(p)%countKeys('(output)') + phase_Nsources(p) = phaseConfig(p)%countKeys('(source)') + phase_Nkinematics(p) = phaseConfig(p)%countKeys('(kinematics)') + phase_NstiffnessDegradations(p) = phaseConfig(p)%countKeys('(stiffness_degradation)') + !phase_localPlasticity(p) = .not. IO_spotTagInPart(fileUnit,myPart,'/nonlocal/') - phase_Noutput = IO_countTagInPart(fileUnit,myPart,'(output)',Nsections) - phase_Nsources = IO_countTagInPart(fileUnit,myPart,'(source)',Nsections) - phase_Nkinematics = IO_countTagInPart(fileUnit,myPart,'(kinematics)',Nsections) - phase_NstiffnessDegradations = IO_countTagInPart(fileUnit,myPart,'(stiffness_degradation)',Nsections) - phase_localPlasticity = .not. IO_spotTagInPart(fileUnit,myPart,'/nonlocal/',Nsections) + select case (phaseConfig(p)%getString('elasticity')) + case (ELASTICITY_HOOKE_label) + phase_elasticity(p) = ELASTICITY_HOOKE_ID + case default + call IO_error(200_pInt,ext_msg=trim(phaseConfig(p)%getString('elasticity'))) + end select + + select case (phaseConfig(p)%getString('plasticity')) + case (PLASTICITY_NONE_label) + phase_plasticity(p) = PLASTICITY_NONE_ID + case (PLASTICITY_ISOTROPIC_label) + phase_plasticity(p) = PLASTICITY_ISOTROPIC_ID + case (PLASTICITY_PHENOPOWERLAW_label) + phase_plasticity(p) = PLASTICITY_PHENOPOWERLAW_ID + case (PLASTICITY_KINEHARDENING_label) + phase_plasticity(p) = PLASTICITY_KINEHARDENING_ID + case (PLASTICITY_DISLOTWIN_label) + phase_plasticity(p) = PLASTICITY_DISLOTWIN_ID + case (PLASTICITY_DISLOUCLA_label) + phase_plasticity(p) = PLASTICITY_DISLOUCLA_ID + case (PLASTICITY_NONLOCAL_label) + phase_plasticity(p) = PLASTICITY_NONLOCAL_ID + case default + call IO_error(201_pInt,ext_msg=trim(phaseConfig(p)%getString('plasticity'))) + end select + + enddo allocate(phase_source(maxval(phase_Nsources),Nsections), source=SOURCE_undefined_ID) allocate(phase_kinematics(maxval(phase_Nkinematics),Nsections), source=KINEMATICS_undefined_ID) allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),Nsections), & source=STIFFNESS_DEGRADATION_undefined_ID) - - rewind(fileUnit) - line = '' ! to have it initialized - section = 0_pInt ! - " - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to - line = IO_read(fileUnit) - enddo - if (echo) write(6,'(/,1x,a)') trim(line) ! echo part header - - do while (trim(line) /= IO_EOF) ! read through sections of material 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 + do p=1_pInt, Nsections + 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,section) = SOURCE_thermal_dissipation_ID + case (SOURCE_thermal_externalheat_label) + phase_source(sourceCtr,section) = SOURCE_thermal_externalheat_ID + case (SOURCE_damage_isoBrittle_label) + phase_source(sourceCtr,section) = SOURCE_damage_isoBrittle_ID + case (SOURCE_damage_isoDuctile_label) + phase_source(sourceCtr,section) = SOURCE_damage_isoDuctile_ID + case (SOURCE_damage_anisoBrittle_label) + phase_source(sourceCtr,section) = SOURCE_damage_anisoBrittle_ID + case (SOURCE_damage_anisoDuctile_label) + phase_source(sourceCtr,section) = SOURCE_damage_anisoDuctile_ID + case (SOURCE_vacancy_phenoplasticity_label) + phase_source(sourceCtr,section) = SOURCE_vacancy_phenoplasticity_ID + case (SOURCE_vacancy_irradiation_label) + phase_source(sourceCtr,section) = SOURCE_vacancy_irradiation_ID + case (SOURCE_vacancy_thermalfluc_label) + phase_source(sourceCtr,section) = SOURCE_vacancy_thermalfluc_ID + end select + enddo endif - if (echo) write(6,'(2x,a)') trim(line) ! echo back read lines - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - sourceCtr = 0_pInt - kinematicsCtr = 0_pInt - stiffDegradationCtr = 0_pInt - phase_name(section) = IO_getTag(line,'[',']') + 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,section) = KINEMATICS_cleavage_opening_ID + case (KINEMATICS_slipplane_opening_label) + phase_kinematics(kinematicsCtr,section) = KINEMATICS_slipplane_opening_ID + case (KINEMATICS_thermal_expansion_label) + phase_kinematics(kinematicsCtr,section) = KINEMATICS_thermal_expansion_ID + case (KINEMATICS_vacancy_strain_label) + phase_kinematics(kinematicsCtr,section) = KINEMATICS_vacancy_strain_ID + case (KINEMATICS_hydrogen_strain_label) + phase_kinematics(kinematicsCtr,section) = KINEMATICS_hydrogen_strain_ID + end select + enddo endif - if (section > 0_pInt) then - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - call phaseConfig(section)%add(IO_lc(trim(line)),chunkPos) - select case(tag) - case ('elasticity') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case (ELASTICITY_HOOKE_label) - phase_elasticity(section) = ELASTICITY_HOOKE_ID - case default - call IO_error(200_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - case ('plasticity') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case (PLASTICITY_NONE_label) - phase_plasticity(section) = PLASTICITY_NONE_ID - case (PLASTICITY_ISOTROPIC_label) - phase_plasticity(section) = PLASTICITY_ISOTROPIC_ID - case (PLASTICITY_PHENOPOWERLAW_label) - phase_plasticity(section) = PLASTICITY_PHENOPOWERLAW_ID - case (PLASTICITY_KINEHARDENING_label) - phase_plasticity(section) = PLASTICITY_KINEHARDENING_ID - case (PLASTICITY_DISLOTWIN_label) - phase_plasticity(section) = PLASTICITY_DISLOTWIN_ID - case (PLASTICITY_DISLOUCLA_label) - phase_plasticity(section) = PLASTICITY_DISLOUCLA_ID - case (PLASTICITY_NONLOCAL_label) - phase_plasticity(section) = PLASTICITY_NONLOCAL_ID - case default - call IO_error(201_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - case ('(source)') - sourceCtr = sourceCtr + 1_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case (SOURCE_thermal_dissipation_label) - phase_source(sourceCtr,section) = SOURCE_thermal_dissipation_ID - case (SOURCE_thermal_externalheat_label) - phase_source(sourceCtr,section) = SOURCE_thermal_externalheat_ID - case (SOURCE_damage_isoBrittle_label) - phase_source(sourceCtr,section) = SOURCE_damage_isoBrittle_ID - case (SOURCE_damage_isoDuctile_label) - phase_source(sourceCtr,section) = SOURCE_damage_isoDuctile_ID - case (SOURCE_damage_anisoBrittle_label) - phase_source(sourceCtr,section) = SOURCE_damage_anisoBrittle_ID - case (SOURCE_damage_anisoDuctile_label) - phase_source(sourceCtr,section) = SOURCE_damage_anisoDuctile_ID - case (SOURCE_vacancy_phenoplasticity_label) - phase_source(sourceCtr,section) = SOURCE_vacancy_phenoplasticity_ID - case (SOURCE_vacancy_irradiation_label) - phase_source(sourceCtr,section) = SOURCE_vacancy_irradiation_ID - case (SOURCE_vacancy_thermalfluc_label) - phase_source(sourceCtr,section) = SOURCE_vacancy_thermalfluc_ID - end select - case ('(kinematics)') - kinematicsCtr = kinematicsCtr + 1_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case (KINEMATICS_cleavage_opening_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_cleavage_opening_ID - case (KINEMATICS_slipplane_opening_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_slipplane_opening_ID - case (KINEMATICS_thermal_expansion_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_thermal_expansion_ID - case (KINEMATICS_vacancy_strain_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_vacancy_strain_ID - case (KINEMATICS_hydrogen_strain_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_hydrogen_strain_ID - end select - case ('(stiffness_degradation)') - stiffDegradationCtr = stiffDegradationCtr + 1_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case (STIFFNESS_DEGRADATION_damage_label) - phase_stiffnessDegradation(stiffDegradationCtr,section) = STIFFNESS_DEGRADATION_damage_ID - case (STIFFNESS_DEGRADATION_porosity_label) - phase_stiffnessDegradation(stiffDegradationCtr,section) = STIFFNESS_DEGRADATION_porosity_ID - end select - - end select + 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,section) = STIFFNESS_DEGRADATION_damage_ID + case (STIFFNESS_DEGRADATION_porosity_label) + phase_stiffnessDegradation(stiffDegradationCtr,section) = STIFFNESS_DEGRADATION_porosity_ID + end select + enddo endif enddo + allocate(phase_plasticityInstance(Nsections), source=0_pInt) + allocate(phase_elasticityInstance(Nsections), source=0_pInt) + do p=1_pInt, Nsections phase_elasticityInstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p)) phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) From bc03b8670a8a3e04760c0d9a03401178e884e3d3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 13:23:42 +0200 Subject: [PATCH 15/94] parsing microstructure, phase, and crystallite in one loop --- src/material.f90 | 369 +++++++++++++++++++++++++---------------------- 1 file changed, 199 insertions(+), 170 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index b8cef8a1a..22b9d0677 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -305,7 +305,10 @@ module material vacancyConcRate, & !< vacancy conc change field hydrogenConcRate !< hydrogen conc change field - type(tPartitionedStringList), public,protected, allocatable, dimension(:) :: phaseConfig + type(tPartitionedStringList), public,protected, allocatable, dimension(:) :: & + phaseConfig, & + microstructureConfig, & + crystalliteConfig public :: & material_init, & @@ -375,8 +378,12 @@ subroutine material_init() use IO, only: & IO_error, & IO_open_file, & + IO_read, & + IO_lc, & IO_open_jobFile_stat, & - IO_timeStamp + IO_getTag, & + IO_timeStamp, & + IO_EOF use debug, only: & debug_level, & debug_material, & @@ -401,6 +408,9 @@ subroutine material_init() integer(pInt), dimension(:), allocatable :: CrystallitePosition integer(pInt), dimension(:), allocatable :: HomogenizationPosition + character(len=65536) :: & + line,part + myDebug = debug_level(debug_material) write(6,'(/,a)') ' <<<+- material init -+>>>' @@ -409,16 +419,36 @@ subroutine material_init() if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file + + rewind(fileUnit) + line = '' ! to have it initialized + do while (trim(line) /= IO_EOF) + part = IO_lc(IO_getTag(line,'<','>')) + + select case (trim(part)) + + case (trim(material_partPhase)) + line = material_parsePhase(FILEUNIT) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) + + case (trim(material_partMicrostructure)) + line = material_parseMicrostructure(FILEUNIT) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) + + case (trim(material_partCrystallite)) + line = material_parseCrystallite(FILEUNIT) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) + + case default + line = IO_read(fileUnit) + end select + + enddo + call material_parseHomogenization(FILEUNIT,material_partHomogenization) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) - call material_parseMicrostructure(FILEUNIT,material_partMicrostructure) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) - call material_parseCrystallite(FILEUNIT,material_partCrystallite) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) call material_parseTexture(FILEUNIT,material_partTexture) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) - call material_parsePhase(FILEUNIT,material_partPhase) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) close(FILEUNIT) allocate(plasticState (material_Nphase)) @@ -689,22 +719,22 @@ subroutine material_parseHomogenization(fileUnit,myPart) call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) end select - case ('nconstituents','ngrains') + case ('nconstituents') homogenization_Ngrains(section) = IO_intValue(line,chunkPos,2_pInt) - case ('initialtemperature','initialt') + case ('t0') thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt) case ('initialdamage') damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('initialvacancyconc','initialcv') + case ('cv0') vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt) case ('initialporosity') porosity_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('initialhydrogenconc','initialch') + case ('ch0') hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt) end select @@ -728,7 +758,7 @@ end subroutine material_parseHomogenization !-------------------------------------------------------------------------------------------------- !> @brief parses the microstructure part in the material configuration file !-------------------------------------------------------------------------------------------------- -subroutine material_parseMicrostructure(fileUnit,myPart) +character(len=65536) function material_parseMicrostructure(fileUnit) use prec, only: & dNeq use IO @@ -737,159 +767,163 @@ subroutine material_parseMicrostructure(fileUnit,myPart) mesh_NcpElems implicit none - character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: fileUnit + character(len=64), dimension(:), allocatable :: & + str integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, section, constituent, e, i + integer(pInt), allocatable, dimension(:,:) :: chunkPoss + integer(pInt) :: e, m, constituent, i character(len=65536) :: & - tag, line + tag,line,devNull logical :: echo - echo = IO_globalTagInPart(fileUnit,myPart,'/echo/') - - Nsections = IO_countSections(fileUnit,myPart) - material_Nmicrostructure = Nsections - if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) - - allocate(microstructure_name(Nsections)); microstructure_name = '' - allocate(microstructure_crystallite(Nsections), source=0_pInt) - allocate(microstructure_Nconstituents(Nsections), source=0_pInt) - allocate(microstructure_active(Nsections), source=.false.) - allocate(microstructure_elemhomo(Nsections), source=.false.) - - if(any(mesh_element(4,1:mesh_NcpElems) > Nsections)) & - call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config') - - forall (e = 1_pInt:mesh_NcpElems) microstructure_active(mesh_element(4,e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements - - microstructure_Nconstituents = IO_countTagInPart(fileUnit,myPart,'(constituent)',Nsections) - microstructure_maxNconstituents = maxval(microstructure_Nconstituents) - microstructure_elemhomo = IO_spotTagInPart(fileUnit,myPart,'/elementhomogeneous/',Nsections) - - allocate(microstructure_phase (microstructure_maxNconstituents,Nsections),source=0_pInt) - allocate(microstructure_texture (microstructure_maxNconstituents,Nsections),source=0_pInt) - allocate(microstructure_fraction(microstructure_maxNconstituents,Nsections),source=0.0_pReal) - - rewind(fileUnit) - line = '' ! to have it initialized - section = 0_pInt ! - " - - constituent = 0_pInt ! - " - - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to - line = IO_read(fileUnit) - enddo - if (echo) write(6,'(/,1x,a)') trim(line) ! echo part header + allocate(microstructure_name(0)) + allocate(MicrostructureConfig(0)) + line = '' ! to have it initialized + m = 0_pInt + echo =.false. do while (trim(line) /= IO_EOF) ! read through sections of material 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 + foundNextPart: if (IO_getTag(line,'<','>') /= '') then + devNull = IO_read(fileUnit, .true.) ! reset IO_read exit - endif - if (echo) write(6,'(2x,a)') trim(line) ! echo back read lines - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - constituent = 0_pInt - microstructure_name(section) = IO_getTag(line,'[',']') - endif - if (section > 0_pInt) then + endif foundNextPart + nextSection: if (IO_getTag(line,'[',']') /= '') then + m = m + 1_pInt + microstructureConfig = [microstructureConfig, emptyList] + microstructure_name = [microstructure_Name,IO_getTag(line,'[',']')] + endif nextSection + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key + inSection: if (m > 0_pInt) then chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('crystallite') - microstructure_crystallite(section) = IO_intValue(line,chunkPos,2_pInt) - case ('(constituent)') - constituent = constituent + 1_pInt - do i = 2_pInt,6_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,chunkPos,i)) - select case (tag) - case('phase') - microstructure_phase(constituent,section) = IO_intValue(line,chunkPos,i+1_pInt) - case('texture') - microstructure_texture(constituent,section) = IO_intValue(line,chunkPos,i+1_pInt) - case('fraction') - microstructure_fraction(constituent,section) = IO_floatValue(line,chunkPos,i+1_pInt) - end select - enddo - end select - endif + call microstructureConfig(m)%add(IO_lc(trim(line)),chunkPos) + else inSection + echo = (trim(tag) == '/echo/') + endif inSection enddo - !sanity check -do section = 1_pInt, Nsections - if (dNeq(sum(microstructure_fraction(:,section)),1.0_pReal)) & - call IO_error(153_pInt,ext_msg=microstructure_name(section)) -enddo + material_Nmicrostructure = size(microstructureConfig) + if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure) -end subroutine material_parseMicrostructure + allocate(microstructure_crystallite(material_Nmicrostructure), source=0_pInt) + allocate(microstructure_Nconstituents(material_Nmicrostructure), source=0_pInt) + allocate(microstructure_active(material_Nmicrostructure), source=.false.) + allocate(microstructure_elemhomo(material_Nmicrostructure), source=.false.) + + if(any(mesh_element(4,1:mesh_NcpElems) > material_Nmicrostructure)) & + call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config') + + forall (e = 1_pInt:mesh_NcpElems) microstructure_active(mesh_element(4,e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements + + do m=1_pInt, material_Nmicrostructure + microstructure_Nconstituents(m) = microstructureConfig(m)%countKeys('(constituent)') + microstructure_crystallite(m) = microstructureConfig(m)%getInt('crystallite') + ! microstructure_elemhomo = IO_spotTagInPart(fileUnit,myPart,'/elementhomogeneous/',Nsections) + enddo + + microstructure_maxNconstituents = maxval(microstructure_Nconstituents) + allocate(microstructure_phase (microstructure_maxNconstituents,material_Nmicrostructure),source=0_pInt) + allocate(microstructure_texture (microstructure_maxNconstituents,material_Nmicrostructure),source=0_pInt) + allocate(microstructure_fraction(microstructure_maxNconstituents,material_Nmicrostructure),source=0.0_pReal) + + do m=1_pInt, material_Nmicrostructure + call microstructureConfig(m)%getRaws('(constituent)',str,chunkPoss) + do constituent = 1_pInt, size(str) + print*, trim(str(constituent)) + do i = 2_pInt,6_pInt,2_pInt + tag = IO_lc(IO_stringValue(str(constituent),chunkPoss(:,constituent),i)) + + select case (tag) + case('phase') + microstructure_phase(constituent,m) = IO_intValue(str(constituent),chunkPos,i+1_pInt) + + case('texture') + microstructure_texture(constituent,m) = IO_intValue(str(constituent),chunkPos,i+1_pInt) + + case('fraction') + microstructure_fraction(constituent,m) = IO_floatValue(str(constituent),chunkPos,i+1_pInt) + + end select + enddo +enddo +enddo + !sanity check + do m = 1_pInt, material_Nmicrostructure + if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) & + call IO_error(153_pInt,ext_msg=microstructure_name(m)) + enddo + + material_parseMicrostructure = line +end function material_parseMicrostructure !-------------------------------------------------------------------------------------------------- !> @brief parses the crystallite part in the material configuration file !-------------------------------------------------------------------------------------------------- -subroutine material_parseCrystallite(fileUnit,myPart) +character(len=65536) function material_parseCrystallite(fileUnit) use IO, only: & IO_read, & - IO_countSections, & IO_error, & - IO_countTagInPart, & - IO_globalTagInPart, & IO_getTag, & IO_lc, & + IO_stringPos, & + IO_stringValue, & IO_isBlank, & IO_EOF implicit none - character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, & - section - character(len=65536) :: line + integer(pInt) :: c + character(len=65536) :: line, tag,devNull logical :: echo - echo = IO_globalTagInPart(fileUnit,myPart,'/echo/') - - Nsections = IO_countSections(fileUnit,myPart) - material_Ncrystallite = Nsections - if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) - - allocate(crystallite_name(Nsections)); crystallite_name = '' - allocate(crystallite_Noutput(Nsections), source=0_pInt) - - crystallite_Noutput = IO_countTagInPart(fileUnit,myPart,'(output)',Nsections) - - rewind(fileUnit) - line = '' ! to have it initialized - section = 0_pInt ! - " - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to - line = IO_read(fileUnit) - enddo - if (echo) write(6,'(/,1x,a)') trim(line) ! echo part header - + allocate(crystallite_name(0)) + allocate(crystalliteConfig(0)) + c = 0_pInt do while (trim(line) /= IO_EOF) ! read through sections of material 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 + foundNextPart: if (IO_getTag(line,'<','>') /= '') then + devNull = IO_read(fileUnit, .true.) ! reset IO_read exit - endif - if (echo) write(6,'(2x,a)') trim(line) ! echo back read lines - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - crystallite_name(section) = IO_getTag(line,'[',']') - endif + endif foundNextPart + nextSection: if (IO_getTag(line,'[',']') /= '') then + c = c + 1_pInt + crystalliteConfig = [crystalliteConfig, emptyList] + crystallite_name = [crystallite_name,IO_getTag(line,'[',']')] + endif nextSection + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key + inSection: if (c > 0_pInt) then + chunkPos = IO_stringPos(line) + call crystalliteConfig(c)%add(IO_lc(trim(line)),chunkPos) + else inSection + echo = (trim(tag) == '/echo/') + endif inSection enddo -end subroutine material_parseCrystallite + material_Ncrystallite = size(crystalliteConfig) + if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite) + + allocate(crystallite_Noutput(material_Ncrystallite), source=0_pInt) + do c=1_pInt, material_Ncrystallite + crystallite_Noutput(c) = crystalliteConfig(c)%countKeys('(output)') + enddo + + material_parseCrystallite = line +end function material_parseCrystallite !-------------------------------------------------------------------------------------------------- !> @brief parses the phase part in the material configuration file !-------------------------------------------------------------------------------------------------- -subroutine material_parsePhase(fileUnit,myPart) +character(len=65536) function material_parsePhase(fileUnit) use chained_list, only: & emptyList use IO, only: & @@ -907,14 +941,13 @@ subroutine material_parsePhase(fileUnit,myPart) IO_EOF implicit none - character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, section, sourceCtr, kinematicsCtr, stiffDegradationCtr, p + integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p character(len=65536) :: & - tag,line + tag,line,devNull character(len=64), dimension(:), allocatable :: & str logical :: echo @@ -922,49 +955,44 @@ subroutine material_parsePhase(fileUnit,myPart) allocate(phase_name(0)) allocate(phaseConfig(0)) line = '' ! to have it initialized - section = 0_pInt ! - " - + p = 0_pInt ! - " - echo =.false. - rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to - line = IO_read(fileUnit) - enddo - do while (trim(line) /= IO_EOF) ! read through sections of material part line = IO_read(fileUnit) if (IO_isBlank(line)) cycle ! skip empty lines foundNextPart: if (IO_getTag(line,'<','>') /= '') then - line = IO_read(fileUnit, .true.) ! reset IO_read + devNull = IO_read(fileUnit, .true.) ! reset IO_read exit endif foundNextPart nextSection: if (IO_getTag(line,'[',']') /= '') then - section = section + 1_pInt + p = p + 1_pInt phaseConfig = [phaseConfig, emptyList] phase_name = [phase_Name,IO_getTag(line,'[',']')] endif nextSection chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key - inSection: if (section > 0_pInt) then + inSection: if (p > 0_pInt) then chunkPos = IO_stringPos(line) - call phaseConfig(section)%add(IO_lc(trim(line)),chunkPos) + call phaseConfig(p)%add(IO_lc(trim(line)),chunkPos) else inSection echo = (trim(tag) == '/echo/') endif inSection enddo - Nsections = size(phaseConfig) - material_Nphase = Nsections - if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) - allocate(phase_elasticity(Nsections),source=ELASTICITY_undefined_ID) - allocate(phase_plasticity(Nsections),source=PLASTICITY_undefined_ID) - allocate(phase_Nsources(Nsections), source=0_pInt) - allocate(phase_Nkinematics(Nsections), source=0_pInt) - allocate(phase_NstiffnessDegradations(Nsections),source=0_pInt) - allocate(phase_Noutput(Nsections), source=0_pInt) - allocate(phase_localPlasticity(Nsections), source=.false.) + material_Nphase = size(phaseConfig) + if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase) - do p=1_pInt, Nsections + allocate(phase_elasticity(material_Nphase),source=ELASTICITY_undefined_ID) + allocate(phase_plasticity(material_Nphase),source=PLASTICITY_undefined_ID) + allocate(phase_Nsources(material_Nphase), source=0_pInt) + allocate(phase_Nkinematics(material_Nphase), source=0_pInt) + allocate(phase_NstiffnessDegradations(material_Nphase),source=0_pInt) + allocate(phase_Noutput(material_Nphase), source=0_pInt) + allocate(phase_localPlasticity(material_Nphase), source=.false.) + + do p=1_pInt, material_Nphase phase_Noutput(p) = phaseConfig(p)%countKeys('(output)') phase_Nsources(p) = phaseConfig(p)%countKeys('(source)') phase_Nkinematics(p) = phaseConfig(p)%countKeys('(kinematics)') @@ -999,33 +1027,33 @@ subroutine material_parsePhase(fileUnit,myPart) enddo - allocate(phase_source(maxval(phase_Nsources),Nsections), source=SOURCE_undefined_ID) - allocate(phase_kinematics(maxval(phase_Nkinematics),Nsections), source=KINEMATICS_undefined_ID) - allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),Nsections), & + allocate(phase_source(maxval(phase_Nsources),material_Nphase), source=SOURCE_undefined_ID) + allocate(phase_kinematics(maxval(phase_Nkinematics),material_Nphase), source=KINEMATICS_undefined_ID) + allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),material_Nphase), & source=STIFFNESS_DEGRADATION_undefined_ID) - do p=1_pInt, Nsections + 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,section) = SOURCE_thermal_dissipation_ID + phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID case (SOURCE_thermal_externalheat_label) - phase_source(sourceCtr,section) = SOURCE_thermal_externalheat_ID + phase_source(sourceCtr,p) = SOURCE_thermal_externalheat_ID case (SOURCE_damage_isoBrittle_label) - phase_source(sourceCtr,section) = SOURCE_damage_isoBrittle_ID + phase_source(sourceCtr,p) = SOURCE_damage_isoBrittle_ID case (SOURCE_damage_isoDuctile_label) - phase_source(sourceCtr,section) = SOURCE_damage_isoDuctile_ID + phase_source(sourceCtr,p) = SOURCE_damage_isoDuctile_ID case (SOURCE_damage_anisoBrittle_label) - phase_source(sourceCtr,section) = SOURCE_damage_anisoBrittle_ID + phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID case (SOURCE_damage_anisoDuctile_label) - phase_source(sourceCtr,section) = SOURCE_damage_anisoDuctile_ID + phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID case (SOURCE_vacancy_phenoplasticity_label) - phase_source(sourceCtr,section) = SOURCE_vacancy_phenoplasticity_ID + phase_source(sourceCtr,p) = SOURCE_vacancy_phenoplasticity_ID case (SOURCE_vacancy_irradiation_label) - phase_source(sourceCtr,section) = SOURCE_vacancy_irradiation_ID + phase_source(sourceCtr,p) = SOURCE_vacancy_irradiation_ID case (SOURCE_vacancy_thermalfluc_label) - phase_source(sourceCtr,section) = SOURCE_vacancy_thermalfluc_ID + phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID end select enddo endif @@ -1034,15 +1062,15 @@ subroutine material_parsePhase(fileUnit,myPart) do kinematicsCtr = 1_pInt, size(str) select case (trim(str(kinematicsCtr))) case (KINEMATICS_cleavage_opening_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_cleavage_opening_ID + phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID case (KINEMATICS_slipplane_opening_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_slipplane_opening_ID + phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID case (KINEMATICS_thermal_expansion_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_thermal_expansion_ID + phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID case (KINEMATICS_vacancy_strain_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_vacancy_strain_ID + phase_kinematics(kinematicsCtr,p) = KINEMATICS_vacancy_strain_ID case (KINEMATICS_hydrogen_strain_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_hydrogen_strain_ID + phase_kinematics(kinematicsCtr,p) = KINEMATICS_hydrogen_strain_ID end select enddo endif @@ -1051,23 +1079,24 @@ subroutine material_parsePhase(fileUnit,myPart) do stiffDegradationCtr = 1_pInt, size(str) select case (trim(str(stiffDegradationCtr))) case (STIFFNESS_DEGRADATION_damage_label) - phase_stiffnessDegradation(stiffDegradationCtr,section) = STIFFNESS_DEGRADATION_damage_ID + phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID case (STIFFNESS_DEGRADATION_porosity_label) - phase_stiffnessDegradation(stiffDegradationCtr,section) = STIFFNESS_DEGRADATION_porosity_ID + phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_porosity_ID end select enddo endif enddo - allocate(phase_plasticityInstance(Nsections), source=0_pInt) - allocate(phase_elasticityInstance(Nsections), source=0_pInt) + allocate(phase_plasticityInstance(material_Nphase), source=0_pInt) + allocate(phase_elasticityInstance(material_Nphase), source=0_pInt) - do p=1_pInt, Nsections + do p=1_pInt, material_Nphase phase_elasticityInstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p)) phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) enddo -end subroutine material_parsePhase + material_parsePhase = line +end function material_parsePhase !-------------------------------------------------------------------------------------------------- !> @brief parses the texture part in the material configuration file From fdf8833c36623fb39053ba1fd2290811068b0c8e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 13:31:21 +0200 Subject: [PATCH 16/94] debug output not needed any more --- .../Polycrystal/20grains16x16x16.geom | 259 +----------------- .../SpectralMethod/Polycrystal/tensionX.load | 3 +- src/material.f90 | 1 - 3 files changed, 3 insertions(+), 260 deletions(-) diff --git a/examples/SpectralMethod/Polycrystal/20grains16x16x16.geom b/examples/SpectralMethod/Polycrystal/20grains16x16x16.geom index 23fe46f8e..46926dc1f 100644 --- a/examples/SpectralMethod/Polycrystal/20grains16x16x16.geom +++ b/examples/SpectralMethod/Polycrystal/20grains16x16x16.geom @@ -1,262 +1,7 @@ 5 header -grid a 16 b 16 c 16 +grid a 2 b 2 c 5 size x 1.000000 y 1.000000 z 1.000000 origin x 0.000000 y 0.000000 z 0.000000 microstructures 20 homogenization 1 - 2 2 2 4 4 4 4 1 1 15 15 15 15 15 19 19 -19 4 4 4 4 4 1 1 1 15 15 15 15 15 15 19 - 8 8 4 4 4 1 1 1 1 15 15 15 15 15 15 3 -13 8 4 4 1 1 1 1 9 15 15 15 3 3 3 3 -13 13 13 13 1 1 1 9 9 9 3 3 3 3 3 3 -13 13 13 13 13 1 1 9 9 3 3 3 3 3 3 3 -13 13 13 13 13 13 9 9 9 3 3 3 3 3 3 10 -10 13 13 13 13 13 9 9 9 3 3 3 3 3 10 10 -10 10 13 13 13 13 17 17 3 3 3 3 10 10 10 10 -10 10 10 13 2 17 17 17 17 7 7 7 7 10 10 10 -10 10 2 2 2 2 17 17 17 7 7 7 7 7 10 10 -10 2 2 2 2 2 17 17 17 7 7 7 7 7 7 10 - 2 2 2 2 2 2 2 17 17 7 7 7 7 7 7 7 - 2 2 2 2 2 2 2 17 17 7 7 7 7 7 7 7 - 2 2 2 2 2 2 2 4 17 7 7 7 7 7 7 19 - 2 2 2 2 2 4 4 4 1 15 15 15 7 19 19 19 - 8 8 8 8 4 4 4 1 9 15 15 15 15 15 19 19 - 8 8 8 8 4 4 1 1 9 9 15 15 15 15 15 8 - 8 8 8 8 8 1 1 9 9 9 9 15 15 15 3 8 - 8 8 8 8 8 1 9 9 9 9 9 3 3 3 3 13 -13 13 13 13 8 1 9 9 9 9 9 3 3 3 3 13 -13 13 13 13 13 9 9 9 9 9 9 3 3 3 3 13 -13 13 13 13 13 13 9 9 9 9 3 3 3 3 3 13 -13 13 13 13 13 13 9 9 9 9 3 3 3 3 10 10 -10 13 13 13 13 13 17 17 9 9 3 7 7 10 10 10 -10 10 13 13 13 17 17 17 17 17 7 7 7 7 10 10 -10 10 2 2 17 17 17 17 17 17 7 7 7 7 7 10 -10 2 2 2 2 17 17 17 17 17 7 7 7 7 7 7 - 2 2 2 2 2 17 17 17 17 17 7 7 7 7 7 7 - 2 2 2 2 2 2 17 17 17 17 7 7 7 7 7 7 - 2 2 2 2 2 2 17 17 17 17 7 7 7 7 7 7 - 2 2 2 2 2 2 4 4 17 15 15 7 7 7 7 19 - 8 8 8 8 8 8 8 9 9 9 9 15 15 15 8 8 - 8 8 8 8 8 8 9 9 9 9 9 9 15 15 8 8 - 8 8 8 8 8 8 9 9 9 9 9 9 9 3 8 8 - 8 8 8 8 8 8 9 9 9 9 9 9 9 3 3 8 -13 13 13 8 8 9 9 9 9 9 9 9 3 3 13 13 -13 13 13 13 13 9 9 9 9 9 9 9 3 3 13 13 -13 13 13 13 13 13 9 9 9 9 9 9 3 3 13 13 -13 13 13 13 13 13 9 9 9 9 9 3 3 3 13 13 -13 13 13 13 13 17 17 17 17 9 9 7 7 10 10 13 -13 13 13 13 17 17 17 17 17 17 7 7 7 7 10 10 -10 13 13 17 17 17 17 17 17 17 7 7 7 7 7 10 -10 2 2 2 17 17 17 17 17 17 7 7 7 7 7 7 - 2 2 2 2 17 17 17 17 17 17 7 7 7 7 7 7 - 2 2 2 2 2 17 17 17 17 17 7 7 7 7 7 7 - 2 2 2 2 2 17 17 17 17 17 7 7 7 7 7 7 - 8 8 8 8 8 8 17 17 17 17 7 7 7 7 7 8 - 8 8 8 8 8 8 8 9 9 9 9 9 9 7 8 8 - 8 8 8 8 8 8 8 9 9 9 9 9 9 9 8 8 - 8 8 8 8 8 8 9 9 9 9 9 9 9 9 8 8 - 8 8 8 8 8 8 9 9 9 9 9 9 9 9 8 8 -13 13 8 8 8 8 9 9 9 9 9 9 9 9 13 13 -13 13 13 13 13 9 9 9 9 9 9 9 9 3 13 13 -13 13 13 13 13 13 9 9 9 9 9 9 9 13 13 13 -13 13 13 13 13 13 9 9 9 9 9 9 9 13 13 13 -13 13 13 13 13 17 17 17 17 9 9 12 12 12 13 13 -13 13 13 13 17 17 17 17 17 17 17 7 7 7 7 13 -13 13 13 17 17 17 17 17 17 17 17 7 7 7 7 7 - 7 13 17 17 17 17 17 17 17 17 17 7 7 7 7 7 - 7 2 2 17 17 17 17 17 17 17 17 7 7 7 7 7 - 2 2 2 17 17 17 17 17 17 17 17 7 7 7 7 7 - 8 8 8 8 17 17 17 17 17 17 17 7 7 7 7 7 - 8 8 8 8 8 8 17 17 17 17 17 7 7 7 7 8 - 8 8 8 8 8 8 8 9 9 9 9 9 9 8 8 8 - 8 8 8 8 8 8 8 9 9 9 9 9 9 9 8 8 - 8 8 8 8 8 8 9 9 9 9 9 9 9 9 8 8 - 8 8 8 8 8 8 9 9 9 9 9 9 9 9 8 8 -13 8 8 8 8 8 9 9 9 9 9 9 9 9 13 13 -13 13 13 13 13 9 9 9 9 9 9 9 9 9 13 13 -13 13 13 13 13 13 9 9 9 9 9 9 9 13 13 13 -13 13 13 13 13 13 20 9 9 9 9 9 12 12 13 13 -13 13 13 13 13 17 17 17 17 17 12 12 12 12 12 13 -13 13 13 13 17 17 17 17 17 17 12 12 12 12 12 12 -13 13 13 17 17 17 17 17 17 17 17 12 12 12 12 12 -12 13 17 17 17 17 17 17 17 17 17 12 12 12 12 12 -12 2 17 17 17 17 17 17 17 17 17 12 12 12 12 12 -12 8 17 17 17 17 17 17 17 17 17 12 12 12 12 12 - 8 8 8 8 17 17 17 17 17 17 17 12 12 12 12 8 - 8 8 8 8 8 8 17 17 17 17 17 9 12 12 8 8 - 8 8 8 8 8 8 8 9 9 9 14 6 6 6 8 8 - 8 8 8 8 8 8 8 9 9 9 9 14 6 6 8 8 - 8 8 8 8 8 8 8 9 9 9 9 9 14 11 8 8 - 8 8 8 8 8 8 9 9 9 9 9 9 9 11 11 8 - 8 8 8 8 8 8 9 9 9 9 9 9 9 11 11 11 -13 13 13 13 8 20 20 9 9 9 9 9 9 11 11 13 -13 13 13 13 13 20 20 20 9 9 9 9 12 11 11 13 -13 13 13 13 13 20 20 20 20 9 9 12 12 12 12 13 -13 13 13 13 13 17 17 17 17 17 12 12 12 12 12 12 -13 13 13 13 17 17 17 17 17 17 12 12 12 12 12 12 -12 13 13 17 17 17 17 17 17 17 12 12 12 12 12 12 -12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 -12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 -12 8 17 17 17 17 17 17 17 17 17 12 12 12 12 12 - 8 8 8 8 17 17 17 17 17 17 17 12 12 12 12 12 - 8 8 8 8 8 8 17 17 17 17 6 6 6 6 12 8 - 8 8 8 8 8 8 18 18 18 14 6 6 6 6 6 8 - 8 8 8 8 8 8 18 18 14 14 14 14 6 6 6 8 - 8 8 8 8 8 8 18 14 14 14 14 14 14 11 11 8 - 8 8 8 8 8 8 20 20 14 14 14 14 14 11 11 11 -11 8 8 8 8 20 20 20 20 14 14 14 14 11 11 11 -11 13 13 8 20 20 20 20 20 20 14 14 11 11 11 11 -11 13 13 13 20 20 20 20 20 20 20 14 11 11 11 11 -11 13 13 13 20 20 20 20 20 20 20 12 12 12 11 11 -13 13 13 13 20 20 20 20 20 20 12 12 12 12 12 12 -12 13 13 13 17 17 17 17 17 12 12 12 12 12 12 12 -12 12 13 17 17 17 17 17 17 17 12 12 12 12 12 12 -12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 -12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 -12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 - 8 8 8 8 17 17 17 17 17 17 6 12 12 12 12 12 - 8 8 8 8 8 18 18 18 18 6 6 6 6 6 6 8 - 8 8 8 8 18 18 18 18 18 14 6 6 6 6 6 6 - 8 8 8 8 18 18 18 18 14 14 14 6 6 6 6 11 -11 8 8 8 8 18 18 18 14 14 14 14 14 6 11 11 -11 8 8 8 8 20 20 14 14 14 14 14 14 11 11 11 -11 11 8 8 20 20 20 20 14 14 14 14 14 11 11 11 -11 11 11 20 20 20 20 20 20 14 14 14 11 11 11 11 -11 11 11 20 20 20 20 20 20 20 14 14 11 11 11 11 -11 11 11 20 20 20 20 20 20 20 20 12 12 11 11 11 -11 11 13 20 20 20 20 20 20 20 12 12 12 12 12 12 -12 12 13 20 20 20 20 20 20 12 12 12 12 12 12 12 -12 12 12 17 17 17 17 17 17 12 12 12 12 12 12 12 -12 12 17 17 17 17 17 17 17 12 12 12 12 12 12 12 -12 12 17 17 17 17 17 17 17 12 12 12 12 12 12 12 -12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 -12 8 8 8 18 18 18 18 18 6 6 6 6 6 12 12 - 8 8 8 8 18 18 18 18 18 6 6 6 6 6 6 6 - 6 8 8 18 18 18 18 18 18 6 6 6 6 6 6 6 -11 8 8 18 18 18 18 18 18 14 14 6 6 6 6 6 -11 11 8 18 18 18 18 18 14 14 14 14 6 6 11 11 -11 11 11 18 18 18 18 14 14 14 14 14 14 11 11 11 -11 11 11 20 20 20 20 20 14 14 14 14 14 11 11 11 -11 11 11 20 20 20 20 20 20 14 14 14 11 11 11 11 -11 11 11 20 20 20 20 20 20 20 14 14 11 11 11 11 -11 11 11 20 20 20 20 20 20 20 5 12 11 11 11 11 -11 11 11 20 20 20 20 20 20 5 5 12 12 12 12 11 -12 11 11 20 20 20 20 20 5 5 12 12 12 12 12 12 -12 12 12 20 20 20 20 5 5 5 12 12 12 12 12 12 -12 12 12 17 17 17 17 17 5 12 12 12 12 12 12 12 -12 12 12 17 17 17 17 17 17 12 12 12 12 12 12 12 -12 19 19 18 18 18 18 18 18 6 6 12 12 12 12 12 -19 19 18 18 18 18 18 18 18 6 6 6 6 6 6 6 - 6 19 18 18 18 18 18 18 18 6 6 6 6 6 6 6 -19 19 18 18 18 18 18 18 18 6 6 6 6 6 6 6 -11 11 18 18 18 18 18 18 18 14 6 6 6 6 6 6 -11 11 18 18 18 18 18 18 14 14 14 14 6 6 11 11 -11 11 11 18 18 18 18 18 14 14 14 14 14 11 11 11 -11 11 11 20 20 20 20 20 14 14 14 14 14 11 11 11 -11 11 11 20 20 20 20 20 20 14 14 14 11 11 11 11 -11 11 11 20 20 20 20 20 20 5 14 14 11 11 11 11 -11 11 11 20 20 20 20 20 5 5 5 5 11 11 11 11 -11 11 11 20 20 20 20 5 5 5 5 5 12 12 11 11 -11 11 11 20 20 20 5 5 5 5 5 12 12 12 12 12 -12 12 12 20 20 5 5 5 5 5 5 12 12 12 12 12 -12 12 19 2 5 5 5 5 5 5 12 12 12 12 12 12 -19 19 19 2 18 18 5 5 5 5 12 12 12 12 12 12 -19 19 19 18 18 18 18 18 18 6 6 6 6 6 19 19 -19 19 19 18 18 18 18 18 18 6 6 6 6 6 6 19 -19 19 18 18 18 18 18 18 18 6 6 6 6 6 6 6 -19 19 18 18 18 18 18 18 18 6 6 6 6 6 6 19 -19 19 18 18 18 18 18 18 18 16 6 6 6 6 6 6 -11 11 18 18 18 18 18 18 18 14 14 6 6 6 6 11 -11 11 11 18 18 18 18 18 14 14 14 14 14 11 11 11 -11 11 11 18 18 18 18 14 14 14 14 14 14 11 11 11 -11 11 11 20 20 20 20 20 14 14 14 14 11 11 11 11 -11 11 11 20 20 20 20 20 5 5 5 5 11 11 11 11 -11 11 11 20 20 20 20 5 5 5 5 5 11 11 11 11 -11 11 11 20 20 20 5 5 5 5 5 5 5 11 11 11 -11 11 11 20 20 5 5 5 5 5 5 5 12 12 12 11 -12 10 2 2 5 5 5 5 5 5 5 5 12 12 12 12 -19 19 2 2 2 5 5 5 5 5 5 12 12 12 12 19 -19 19 2 2 2 5 5 5 5 5 5 12 12 19 19 19 -19 19 19 2 18 18 18 18 18 6 6 6 6 19 19 19 -19 19 19 18 18 18 18 18 18 6 6 6 6 6 19 19 -19 19 19 18 18 18 18 18 18 6 6 6 6 6 6 19 -19 19 4 4 18 18 18 18 18 16 6 6 6 6 19 19 -19 19 4 4 18 18 18 18 18 16 16 6 6 6 6 19 -11 4 4 4 18 18 18 18 16 16 16 16 6 6 6 11 -11 11 4 4 1 18 18 18 16 16 16 16 16 11 11 11 -11 11 11 1 1 1 18 18 16 16 16 16 16 11 11 11 -11 11 11 1 20 20 20 5 5 14 14 14 11 11 11 11 -11 11 11 20 20 20 5 5 5 5 5 5 11 11 11 11 -11 11 11 20 20 5 5 5 5 5 5 5 5 11 11 11 -11 11 11 20 5 5 5 5 5 5 5 5 5 11 11 11 -10 10 10 2 5 5 5 5 5 5 5 5 5 10 10 10 -10 10 2 2 5 5 5 5 5 5 5 5 5 10 10 10 -19 19 2 2 2 5 5 5 5 5 5 5 19 19 19 19 -19 19 2 2 2 2 5 5 5 5 5 6 19 19 19 19 -19 19 2 2 2 2 18 18 18 6 6 6 19 19 19 19 -19 19 2 2 2 18 18 18 18 6 6 6 6 19 19 19 -19 19 19 4 18 18 18 18 18 6 6 6 6 6 19 19 -19 19 4 4 4 4 18 18 16 16 16 6 6 19 19 19 -19 19 4 4 4 4 1 18 16 16 16 16 6 6 19 19 -19 4 4 4 4 1 1 1 16 16 16 16 15 15 6 19 -11 4 4 4 1 1 1 1 16 16 16 16 15 15 11 11 -11 11 4 1 1 1 1 1 16 16 16 16 15 3 11 11 -11 11 11 1 1 1 1 5 16 16 16 3 3 3 11 11 -11 11 11 1 1 5 5 5 5 5 5 3 3 3 11 11 -10 10 10 20 5 5 5 5 5 5 5 5 3 3 10 10 -10 10 10 10 5 5 5 5 5 5 5 5 5 10 10 10 -10 10 10 2 5 5 5 5 5 5 5 5 10 10 10 10 -10 10 2 2 2 5 5 5 5 5 5 5 10 10 10 10 -19 2 2 2 2 2 5 5 5 5 5 5 7 19 19 19 -19 2 2 2 2 2 2 5 5 5 5 7 19 19 19 19 -19 19 2 2 2 2 2 18 18 6 6 19 19 19 19 19 -19 19 2 2 2 4 18 18 18 6 6 6 19 19 19 19 -19 19 2 4 4 4 18 18 18 16 6 6 6 19 19 19 -19 19 4 4 4 4 4 1 16 16 15 15 15 19 19 19 -19 4 4 4 4 4 1 1 16 16 15 15 15 15 19 19 -19 4 4 4 4 1 1 1 16 16 15 15 15 15 15 19 - 4 4 4 4 1 1 1 1 16 16 15 15 15 15 15 3 -11 4 4 1 1 1 1 1 16 16 15 15 3 3 3 3 -11 11 1 1 1 1 1 1 16 3 3 3 3 3 3 3 -10 10 10 1 1 1 5 5 5 5 3 3 3 3 3 10 -10 10 10 10 5 5 5 5 5 5 5 3 3 3 10 10 -10 10 10 10 5 5 5 5 5 5 5 5 10 10 10 10 -10 10 10 2 2 5 5 5 5 5 5 5 10 10 10 10 -10 10 2 2 2 2 5 5 5 5 5 7 7 10 10 10 -10 2 2 2 2 2 2 5 5 5 7 7 7 7 10 10 -19 2 2 2 2 2 2 5 5 5 7 7 7 19 19 19 -19 2 2 2 2 2 2 2 5 7 7 7 19 19 19 19 -19 2 2 2 2 2 4 4 16 16 6 19 19 19 19 19 -19 19 2 2 4 4 4 4 16 16 15 15 19 19 19 19 -19 2 4 4 4 4 4 1 1 15 15 15 15 19 19 19 -19 4 4 4 4 4 1 1 1 15 15 15 15 15 19 19 -19 4 4 4 4 1 1 1 1 15 15 15 15 15 15 19 - 4 4 4 4 1 1 1 1 1 15 15 15 15 15 3 3 - 3 4 4 1 1 1 1 1 1 15 15 3 3 3 3 3 -10 10 1 1 1 1 1 1 3 3 3 3 3 3 3 3 -10 10 10 1 1 1 1 5 3 3 3 3 3 3 3 10 -10 10 10 10 1 5 5 5 5 3 3 3 3 3 10 10 -10 10 10 10 2 5 5 5 5 5 3 3 10 10 10 10 -10 10 10 2 2 2 5 5 5 5 5 7 10 10 10 10 -10 10 2 2 2 2 5 5 5 5 7 7 7 10 10 10 -10 2 2 2 2 2 2 5 5 7 7 7 7 7 10 10 - 2 2 2 2 2 2 2 2 7 7 7 7 7 7 7 19 -19 2 2 2 2 2 2 2 7 7 7 7 7 19 19 19 -19 2 2 2 2 2 4 4 4 15 15 7 19 19 19 19 -19 2 2 2 4 4 4 4 1 15 15 15 19 19 19 19 -19 2 2 4 4 4 4 1 1 15 15 15 15 19 19 19 -19 4 4 4 4 4 1 1 1 15 15 15 15 15 19 19 -19 4 4 4 4 1 1 1 1 15 15 15 15 15 15 19 - 3 4 4 4 1 1 1 1 1 15 15 15 15 3 3 3 -13 13 4 1 1 1 1 1 1 15 3 3 3 3 3 3 -13 13 13 1 1 1 1 1 3 3 3 3 3 3 3 3 -10 13 13 13 1 1 1 1 3 3 3 3 3 3 3 10 -10 10 13 13 13 1 5 5 3 3 3 3 3 3 10 10 -10 10 10 13 13 13 5 5 5 3 3 3 10 10 10 10 -10 10 10 2 2 2 5 5 5 7 7 7 7 10 10 10 -10 10 2 2 2 2 2 5 5 7 7 7 7 7 10 10 -10 2 2 2 2 2 2 17 7 7 7 7 7 7 7 10 - 2 2 2 2 2 2 2 2 7 7 7 7 7 7 7 7 - 2 2 2 2 2 2 2 2 7 7 7 7 7 7 7 19 - 2 2 2 2 2 2 2 4 4 15 7 7 7 19 19 19 -19 2 2 2 2 4 4 4 1 15 15 15 19 19 19 19 +1 to 20 diff --git a/examples/SpectralMethod/Polycrystal/tensionX.load b/examples/SpectralMethod/Polycrystal/tensionX.load index b0af80ea8..4e625e996 100644 --- a/examples/SpectralMethod/Polycrystal/tensionX.load +++ b/examples/SpectralMethod/Polycrystal/tensionX.load @@ -1,2 +1 @@ -fdot 1.0e-3 0 0 0 * 0 0 0 * stress * * * * 0 * * * 0 time 10 incs 40 freq 4 -fdot 1.0e-3 0 0 0 * 0 0 0 * stress * * * * 0 * * * 0 time 60 incs 60 +fdot 1.0e-3 0 0 0 * 0 0 0 * stress * * * * 0 * * * 0 time 0.001 incs 1 diff --git a/src/material.f90 b/src/material.f90 index 22b9d0677..cc7dcbf05 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -833,7 +833,6 @@ character(len=65536) function material_parseMicrostructure(fileUnit) do m=1_pInt, material_Nmicrostructure call microstructureConfig(m)%getRaws('(constituent)',str,chunkPoss) do constituent = 1_pInt, size(str) - print*, trim(str(constituent)) do i = 2_pInt,6_pInt,2_pInt tag = IO_lc(IO_stringValue(str(constituent),chunkPoss(:,constituent),i)) From b412aded7554d1d624716c1de29b20ccd87ce85c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 14:15:34 +0200 Subject: [PATCH 17/94] fix for previous commit, should not be changed at all --- .../Polycrystal/20grains16x16x16.geom | 259 +++++++++++++++++- .../SpectralMethod/Polycrystal/tensionX.load | 3 +- 2 files changed, 259 insertions(+), 3 deletions(-) diff --git a/examples/SpectralMethod/Polycrystal/20grains16x16x16.geom b/examples/SpectralMethod/Polycrystal/20grains16x16x16.geom index 46926dc1f..23fe46f8e 100644 --- a/examples/SpectralMethod/Polycrystal/20grains16x16x16.geom +++ b/examples/SpectralMethod/Polycrystal/20grains16x16x16.geom @@ -1,7 +1,262 @@ 5 header -grid a 2 b 2 c 5 +grid a 16 b 16 c 16 size x 1.000000 y 1.000000 z 1.000000 origin x 0.000000 y 0.000000 z 0.000000 microstructures 20 homogenization 1 -1 to 20 + 2 2 2 4 4 4 4 1 1 15 15 15 15 15 19 19 +19 4 4 4 4 4 1 1 1 15 15 15 15 15 15 19 + 8 8 4 4 4 1 1 1 1 15 15 15 15 15 15 3 +13 8 4 4 1 1 1 1 9 15 15 15 3 3 3 3 +13 13 13 13 1 1 1 9 9 9 3 3 3 3 3 3 +13 13 13 13 13 1 1 9 9 3 3 3 3 3 3 3 +13 13 13 13 13 13 9 9 9 3 3 3 3 3 3 10 +10 13 13 13 13 13 9 9 9 3 3 3 3 3 10 10 +10 10 13 13 13 13 17 17 3 3 3 3 10 10 10 10 +10 10 10 13 2 17 17 17 17 7 7 7 7 10 10 10 +10 10 2 2 2 2 17 17 17 7 7 7 7 7 10 10 +10 2 2 2 2 2 17 17 17 7 7 7 7 7 7 10 + 2 2 2 2 2 2 2 17 17 7 7 7 7 7 7 7 + 2 2 2 2 2 2 2 17 17 7 7 7 7 7 7 7 + 2 2 2 2 2 2 2 4 17 7 7 7 7 7 7 19 + 2 2 2 2 2 4 4 4 1 15 15 15 7 19 19 19 + 8 8 8 8 4 4 4 1 9 15 15 15 15 15 19 19 + 8 8 8 8 4 4 1 1 9 9 15 15 15 15 15 8 + 8 8 8 8 8 1 1 9 9 9 9 15 15 15 3 8 + 8 8 8 8 8 1 9 9 9 9 9 3 3 3 3 13 +13 13 13 13 8 1 9 9 9 9 9 3 3 3 3 13 +13 13 13 13 13 9 9 9 9 9 9 3 3 3 3 13 +13 13 13 13 13 13 9 9 9 9 3 3 3 3 3 13 +13 13 13 13 13 13 9 9 9 9 3 3 3 3 10 10 +10 13 13 13 13 13 17 17 9 9 3 7 7 10 10 10 +10 10 13 13 13 17 17 17 17 17 7 7 7 7 10 10 +10 10 2 2 17 17 17 17 17 17 7 7 7 7 7 10 +10 2 2 2 2 17 17 17 17 17 7 7 7 7 7 7 + 2 2 2 2 2 17 17 17 17 17 7 7 7 7 7 7 + 2 2 2 2 2 2 17 17 17 17 7 7 7 7 7 7 + 2 2 2 2 2 2 17 17 17 17 7 7 7 7 7 7 + 2 2 2 2 2 2 4 4 17 15 15 7 7 7 7 19 + 8 8 8 8 8 8 8 9 9 9 9 15 15 15 8 8 + 8 8 8 8 8 8 9 9 9 9 9 9 15 15 8 8 + 8 8 8 8 8 8 9 9 9 9 9 9 9 3 8 8 + 8 8 8 8 8 8 9 9 9 9 9 9 9 3 3 8 +13 13 13 8 8 9 9 9 9 9 9 9 3 3 13 13 +13 13 13 13 13 9 9 9 9 9 9 9 3 3 13 13 +13 13 13 13 13 13 9 9 9 9 9 9 3 3 13 13 +13 13 13 13 13 13 9 9 9 9 9 3 3 3 13 13 +13 13 13 13 13 17 17 17 17 9 9 7 7 10 10 13 +13 13 13 13 17 17 17 17 17 17 7 7 7 7 10 10 +10 13 13 17 17 17 17 17 17 17 7 7 7 7 7 10 +10 2 2 2 17 17 17 17 17 17 7 7 7 7 7 7 + 2 2 2 2 17 17 17 17 17 17 7 7 7 7 7 7 + 2 2 2 2 2 17 17 17 17 17 7 7 7 7 7 7 + 2 2 2 2 2 17 17 17 17 17 7 7 7 7 7 7 + 8 8 8 8 8 8 17 17 17 17 7 7 7 7 7 8 + 8 8 8 8 8 8 8 9 9 9 9 9 9 7 8 8 + 8 8 8 8 8 8 8 9 9 9 9 9 9 9 8 8 + 8 8 8 8 8 8 9 9 9 9 9 9 9 9 8 8 + 8 8 8 8 8 8 9 9 9 9 9 9 9 9 8 8 +13 13 8 8 8 8 9 9 9 9 9 9 9 9 13 13 +13 13 13 13 13 9 9 9 9 9 9 9 9 3 13 13 +13 13 13 13 13 13 9 9 9 9 9 9 9 13 13 13 +13 13 13 13 13 13 9 9 9 9 9 9 9 13 13 13 +13 13 13 13 13 17 17 17 17 9 9 12 12 12 13 13 +13 13 13 13 17 17 17 17 17 17 17 7 7 7 7 13 +13 13 13 17 17 17 17 17 17 17 17 7 7 7 7 7 + 7 13 17 17 17 17 17 17 17 17 17 7 7 7 7 7 + 7 2 2 17 17 17 17 17 17 17 17 7 7 7 7 7 + 2 2 2 17 17 17 17 17 17 17 17 7 7 7 7 7 + 8 8 8 8 17 17 17 17 17 17 17 7 7 7 7 7 + 8 8 8 8 8 8 17 17 17 17 17 7 7 7 7 8 + 8 8 8 8 8 8 8 9 9 9 9 9 9 8 8 8 + 8 8 8 8 8 8 8 9 9 9 9 9 9 9 8 8 + 8 8 8 8 8 8 9 9 9 9 9 9 9 9 8 8 + 8 8 8 8 8 8 9 9 9 9 9 9 9 9 8 8 +13 8 8 8 8 8 9 9 9 9 9 9 9 9 13 13 +13 13 13 13 13 9 9 9 9 9 9 9 9 9 13 13 +13 13 13 13 13 13 9 9 9 9 9 9 9 13 13 13 +13 13 13 13 13 13 20 9 9 9 9 9 12 12 13 13 +13 13 13 13 13 17 17 17 17 17 12 12 12 12 12 13 +13 13 13 13 17 17 17 17 17 17 12 12 12 12 12 12 +13 13 13 17 17 17 17 17 17 17 17 12 12 12 12 12 +12 13 17 17 17 17 17 17 17 17 17 12 12 12 12 12 +12 2 17 17 17 17 17 17 17 17 17 12 12 12 12 12 +12 8 17 17 17 17 17 17 17 17 17 12 12 12 12 12 + 8 8 8 8 17 17 17 17 17 17 17 12 12 12 12 8 + 8 8 8 8 8 8 17 17 17 17 17 9 12 12 8 8 + 8 8 8 8 8 8 8 9 9 9 14 6 6 6 8 8 + 8 8 8 8 8 8 8 9 9 9 9 14 6 6 8 8 + 8 8 8 8 8 8 8 9 9 9 9 9 14 11 8 8 + 8 8 8 8 8 8 9 9 9 9 9 9 9 11 11 8 + 8 8 8 8 8 8 9 9 9 9 9 9 9 11 11 11 +13 13 13 13 8 20 20 9 9 9 9 9 9 11 11 13 +13 13 13 13 13 20 20 20 9 9 9 9 12 11 11 13 +13 13 13 13 13 20 20 20 20 9 9 12 12 12 12 13 +13 13 13 13 13 17 17 17 17 17 12 12 12 12 12 12 +13 13 13 13 17 17 17 17 17 17 12 12 12 12 12 12 +12 13 13 17 17 17 17 17 17 17 12 12 12 12 12 12 +12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 +12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 +12 8 17 17 17 17 17 17 17 17 17 12 12 12 12 12 + 8 8 8 8 17 17 17 17 17 17 17 12 12 12 12 12 + 8 8 8 8 8 8 17 17 17 17 6 6 6 6 12 8 + 8 8 8 8 8 8 18 18 18 14 6 6 6 6 6 8 + 8 8 8 8 8 8 18 18 14 14 14 14 6 6 6 8 + 8 8 8 8 8 8 18 14 14 14 14 14 14 11 11 8 + 8 8 8 8 8 8 20 20 14 14 14 14 14 11 11 11 +11 8 8 8 8 20 20 20 20 14 14 14 14 11 11 11 +11 13 13 8 20 20 20 20 20 20 14 14 11 11 11 11 +11 13 13 13 20 20 20 20 20 20 20 14 11 11 11 11 +11 13 13 13 20 20 20 20 20 20 20 12 12 12 11 11 +13 13 13 13 20 20 20 20 20 20 12 12 12 12 12 12 +12 13 13 13 17 17 17 17 17 12 12 12 12 12 12 12 +12 12 13 17 17 17 17 17 17 17 12 12 12 12 12 12 +12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 +12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 +12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 + 8 8 8 8 17 17 17 17 17 17 6 12 12 12 12 12 + 8 8 8 8 8 18 18 18 18 6 6 6 6 6 6 8 + 8 8 8 8 18 18 18 18 18 14 6 6 6 6 6 6 + 8 8 8 8 18 18 18 18 14 14 14 6 6 6 6 11 +11 8 8 8 8 18 18 18 14 14 14 14 14 6 11 11 +11 8 8 8 8 20 20 14 14 14 14 14 14 11 11 11 +11 11 8 8 20 20 20 20 14 14 14 14 14 11 11 11 +11 11 11 20 20 20 20 20 20 14 14 14 11 11 11 11 +11 11 11 20 20 20 20 20 20 20 14 14 11 11 11 11 +11 11 11 20 20 20 20 20 20 20 20 12 12 11 11 11 +11 11 13 20 20 20 20 20 20 20 12 12 12 12 12 12 +12 12 13 20 20 20 20 20 20 12 12 12 12 12 12 12 +12 12 12 17 17 17 17 17 17 12 12 12 12 12 12 12 +12 12 17 17 17 17 17 17 17 12 12 12 12 12 12 12 +12 12 17 17 17 17 17 17 17 12 12 12 12 12 12 12 +12 12 17 17 17 17 17 17 17 17 12 12 12 12 12 12 +12 8 8 8 18 18 18 18 18 6 6 6 6 6 12 12 + 8 8 8 8 18 18 18 18 18 6 6 6 6 6 6 6 + 6 8 8 18 18 18 18 18 18 6 6 6 6 6 6 6 +11 8 8 18 18 18 18 18 18 14 14 6 6 6 6 6 +11 11 8 18 18 18 18 18 14 14 14 14 6 6 11 11 +11 11 11 18 18 18 18 14 14 14 14 14 14 11 11 11 +11 11 11 20 20 20 20 20 14 14 14 14 14 11 11 11 +11 11 11 20 20 20 20 20 20 14 14 14 11 11 11 11 +11 11 11 20 20 20 20 20 20 20 14 14 11 11 11 11 +11 11 11 20 20 20 20 20 20 20 5 12 11 11 11 11 +11 11 11 20 20 20 20 20 20 5 5 12 12 12 12 11 +12 11 11 20 20 20 20 20 5 5 12 12 12 12 12 12 +12 12 12 20 20 20 20 5 5 5 12 12 12 12 12 12 +12 12 12 17 17 17 17 17 5 12 12 12 12 12 12 12 +12 12 12 17 17 17 17 17 17 12 12 12 12 12 12 12 +12 19 19 18 18 18 18 18 18 6 6 12 12 12 12 12 +19 19 18 18 18 18 18 18 18 6 6 6 6 6 6 6 + 6 19 18 18 18 18 18 18 18 6 6 6 6 6 6 6 +19 19 18 18 18 18 18 18 18 6 6 6 6 6 6 6 +11 11 18 18 18 18 18 18 18 14 6 6 6 6 6 6 +11 11 18 18 18 18 18 18 14 14 14 14 6 6 11 11 +11 11 11 18 18 18 18 18 14 14 14 14 14 11 11 11 +11 11 11 20 20 20 20 20 14 14 14 14 14 11 11 11 +11 11 11 20 20 20 20 20 20 14 14 14 11 11 11 11 +11 11 11 20 20 20 20 20 20 5 14 14 11 11 11 11 +11 11 11 20 20 20 20 20 5 5 5 5 11 11 11 11 +11 11 11 20 20 20 20 5 5 5 5 5 12 12 11 11 +11 11 11 20 20 20 5 5 5 5 5 12 12 12 12 12 +12 12 12 20 20 5 5 5 5 5 5 12 12 12 12 12 +12 12 19 2 5 5 5 5 5 5 12 12 12 12 12 12 +19 19 19 2 18 18 5 5 5 5 12 12 12 12 12 12 +19 19 19 18 18 18 18 18 18 6 6 6 6 6 19 19 +19 19 19 18 18 18 18 18 18 6 6 6 6 6 6 19 +19 19 18 18 18 18 18 18 18 6 6 6 6 6 6 6 +19 19 18 18 18 18 18 18 18 6 6 6 6 6 6 19 +19 19 18 18 18 18 18 18 18 16 6 6 6 6 6 6 +11 11 18 18 18 18 18 18 18 14 14 6 6 6 6 11 +11 11 11 18 18 18 18 18 14 14 14 14 14 11 11 11 +11 11 11 18 18 18 18 14 14 14 14 14 14 11 11 11 +11 11 11 20 20 20 20 20 14 14 14 14 11 11 11 11 +11 11 11 20 20 20 20 20 5 5 5 5 11 11 11 11 +11 11 11 20 20 20 20 5 5 5 5 5 11 11 11 11 +11 11 11 20 20 20 5 5 5 5 5 5 5 11 11 11 +11 11 11 20 20 5 5 5 5 5 5 5 12 12 12 11 +12 10 2 2 5 5 5 5 5 5 5 5 12 12 12 12 +19 19 2 2 2 5 5 5 5 5 5 12 12 12 12 19 +19 19 2 2 2 5 5 5 5 5 5 12 12 19 19 19 +19 19 19 2 18 18 18 18 18 6 6 6 6 19 19 19 +19 19 19 18 18 18 18 18 18 6 6 6 6 6 19 19 +19 19 19 18 18 18 18 18 18 6 6 6 6 6 6 19 +19 19 4 4 18 18 18 18 18 16 6 6 6 6 19 19 +19 19 4 4 18 18 18 18 18 16 16 6 6 6 6 19 +11 4 4 4 18 18 18 18 16 16 16 16 6 6 6 11 +11 11 4 4 1 18 18 18 16 16 16 16 16 11 11 11 +11 11 11 1 1 1 18 18 16 16 16 16 16 11 11 11 +11 11 11 1 20 20 20 5 5 14 14 14 11 11 11 11 +11 11 11 20 20 20 5 5 5 5 5 5 11 11 11 11 +11 11 11 20 20 5 5 5 5 5 5 5 5 11 11 11 +11 11 11 20 5 5 5 5 5 5 5 5 5 11 11 11 +10 10 10 2 5 5 5 5 5 5 5 5 5 10 10 10 +10 10 2 2 5 5 5 5 5 5 5 5 5 10 10 10 +19 19 2 2 2 5 5 5 5 5 5 5 19 19 19 19 +19 19 2 2 2 2 5 5 5 5 5 6 19 19 19 19 +19 19 2 2 2 2 18 18 18 6 6 6 19 19 19 19 +19 19 2 2 2 18 18 18 18 6 6 6 6 19 19 19 +19 19 19 4 18 18 18 18 18 6 6 6 6 6 19 19 +19 19 4 4 4 4 18 18 16 16 16 6 6 19 19 19 +19 19 4 4 4 4 1 18 16 16 16 16 6 6 19 19 +19 4 4 4 4 1 1 1 16 16 16 16 15 15 6 19 +11 4 4 4 1 1 1 1 16 16 16 16 15 15 11 11 +11 11 4 1 1 1 1 1 16 16 16 16 15 3 11 11 +11 11 11 1 1 1 1 5 16 16 16 3 3 3 11 11 +11 11 11 1 1 5 5 5 5 5 5 3 3 3 11 11 +10 10 10 20 5 5 5 5 5 5 5 5 3 3 10 10 +10 10 10 10 5 5 5 5 5 5 5 5 5 10 10 10 +10 10 10 2 5 5 5 5 5 5 5 5 10 10 10 10 +10 10 2 2 2 5 5 5 5 5 5 5 10 10 10 10 +19 2 2 2 2 2 5 5 5 5 5 5 7 19 19 19 +19 2 2 2 2 2 2 5 5 5 5 7 19 19 19 19 +19 19 2 2 2 2 2 18 18 6 6 19 19 19 19 19 +19 19 2 2 2 4 18 18 18 6 6 6 19 19 19 19 +19 19 2 4 4 4 18 18 18 16 6 6 6 19 19 19 +19 19 4 4 4 4 4 1 16 16 15 15 15 19 19 19 +19 4 4 4 4 4 1 1 16 16 15 15 15 15 19 19 +19 4 4 4 4 1 1 1 16 16 15 15 15 15 15 19 + 4 4 4 4 1 1 1 1 16 16 15 15 15 15 15 3 +11 4 4 1 1 1 1 1 16 16 15 15 3 3 3 3 +11 11 1 1 1 1 1 1 16 3 3 3 3 3 3 3 +10 10 10 1 1 1 5 5 5 5 3 3 3 3 3 10 +10 10 10 10 5 5 5 5 5 5 5 3 3 3 10 10 +10 10 10 10 5 5 5 5 5 5 5 5 10 10 10 10 +10 10 10 2 2 5 5 5 5 5 5 5 10 10 10 10 +10 10 2 2 2 2 5 5 5 5 5 7 7 10 10 10 +10 2 2 2 2 2 2 5 5 5 7 7 7 7 10 10 +19 2 2 2 2 2 2 5 5 5 7 7 7 19 19 19 +19 2 2 2 2 2 2 2 5 7 7 7 19 19 19 19 +19 2 2 2 2 2 4 4 16 16 6 19 19 19 19 19 +19 19 2 2 4 4 4 4 16 16 15 15 19 19 19 19 +19 2 4 4 4 4 4 1 1 15 15 15 15 19 19 19 +19 4 4 4 4 4 1 1 1 15 15 15 15 15 19 19 +19 4 4 4 4 1 1 1 1 15 15 15 15 15 15 19 + 4 4 4 4 1 1 1 1 1 15 15 15 15 15 3 3 + 3 4 4 1 1 1 1 1 1 15 15 3 3 3 3 3 +10 10 1 1 1 1 1 1 3 3 3 3 3 3 3 3 +10 10 10 1 1 1 1 5 3 3 3 3 3 3 3 10 +10 10 10 10 1 5 5 5 5 3 3 3 3 3 10 10 +10 10 10 10 2 5 5 5 5 5 3 3 10 10 10 10 +10 10 10 2 2 2 5 5 5 5 5 7 10 10 10 10 +10 10 2 2 2 2 5 5 5 5 7 7 7 10 10 10 +10 2 2 2 2 2 2 5 5 7 7 7 7 7 10 10 + 2 2 2 2 2 2 2 2 7 7 7 7 7 7 7 19 +19 2 2 2 2 2 2 2 7 7 7 7 7 19 19 19 +19 2 2 2 2 2 4 4 4 15 15 7 19 19 19 19 +19 2 2 2 4 4 4 4 1 15 15 15 19 19 19 19 +19 2 2 4 4 4 4 1 1 15 15 15 15 19 19 19 +19 4 4 4 4 4 1 1 1 15 15 15 15 15 19 19 +19 4 4 4 4 1 1 1 1 15 15 15 15 15 15 19 + 3 4 4 4 1 1 1 1 1 15 15 15 15 3 3 3 +13 13 4 1 1 1 1 1 1 15 3 3 3 3 3 3 +13 13 13 1 1 1 1 1 3 3 3 3 3 3 3 3 +10 13 13 13 1 1 1 1 3 3 3 3 3 3 3 10 +10 10 13 13 13 1 5 5 3 3 3 3 3 3 10 10 +10 10 10 13 13 13 5 5 5 3 3 3 10 10 10 10 +10 10 10 2 2 2 5 5 5 7 7 7 7 10 10 10 +10 10 2 2 2 2 2 5 5 7 7 7 7 7 10 10 +10 2 2 2 2 2 2 17 7 7 7 7 7 7 7 10 + 2 2 2 2 2 2 2 2 7 7 7 7 7 7 7 7 + 2 2 2 2 2 2 2 2 7 7 7 7 7 7 7 19 + 2 2 2 2 2 2 2 4 4 15 7 7 7 19 19 19 +19 2 2 2 2 4 4 4 1 15 15 15 19 19 19 19 diff --git a/examples/SpectralMethod/Polycrystal/tensionX.load b/examples/SpectralMethod/Polycrystal/tensionX.load index 4e625e996..b0af80ea8 100644 --- a/examples/SpectralMethod/Polycrystal/tensionX.load +++ b/examples/SpectralMethod/Polycrystal/tensionX.load @@ -1 +1,2 @@ -fdot 1.0e-3 0 0 0 * 0 0 0 * stress * * * * 0 * * * 0 time 0.001 incs 1 +fdot 1.0e-3 0 0 0 * 0 0 0 * stress * * * * 0 * * * 0 time 10 incs 40 freq 4 +fdot 1.0e-3 0 0 0 * 0 0 0 * stress * * * * 0 * * * 0 time 60 incs 60 From c2d30aec4322baa0ca58b2103ca202749b3a7300 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 19:24:53 +0200 Subject: [PATCH 18/94] gfortran has issues with zero-sized string arrays: --- src/list.f90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/list.f90 b/src/list.f90 index e4ff83f1d..973e21dc2 100644 --- a/src/list.f90 +++ b/src/list.f90 @@ -405,7 +405,6 @@ end function getFloatArray type(tPartitionedStringList), pointer :: tmp integer(pInt) :: i - allocate(getStrings(0)) tmp => this%next do @@ -413,7 +412,12 @@ end function getFloatArray 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) - getStrings = [getStrings,str] + + GfortranBug86033: if (.not. allocated(getStrings)) then + allocate(getStrings(1),source=str) + else GfortranBug86033 + getStrings = [getStrings,str] + endif GfortranBug86033 endif tmp => tmp%next end do From 4fd2338d357b184cea8d5c70dc7550208b2994f5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 19:27:03 +0200 Subject: [PATCH 19/94] added parsing of homogenization and workaround for gfortran --- src/material.f90 | 317 ++++++++++++++++++++++++++--------------------- 1 file changed, 173 insertions(+), 144 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index cc7dcbf05..54085b7ca 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -173,6 +173,7 @@ module material integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: & homogenization_type !< type of each homogenization +!ToDo: should be private character(len=64), dimension(:), allocatable, public, protected :: & phase_name, & !< name of each phase @@ -308,6 +309,7 @@ module material type(tPartitionedStringList), public,protected, allocatable, dimension(:) :: & phaseConfig, & microstructureConfig, & + homogenizationConfig, & crystalliteConfig public :: & @@ -439,14 +441,17 @@ subroutine material_init() line = material_parseCrystallite(FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) + case (trim(material_partHomogenization)) + line = material_parseHomogenization(FILEUNIT) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) + case default line = IO_read(fileUnit) + end select enddo - call material_parseHomogenization(FILEUNIT,material_partHomogenization) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) call material_parseTexture(FILEUNIT,material_partTexture) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) close(FILEUNIT) @@ -559,14 +564,14 @@ subroutine material_init() allocate(vacancyConcRate (myHomog)%p(1), source=0.0_pReal) allocate(hydrogenConcRate(myHomog)%p(1), source=0.0_pReal) enddo - + end subroutine material_init !-------------------------------------------------------------------------------------------------- !> @brief parses the homogenization part in the material configuration file !-------------------------------------------------------------------------------------------------- -subroutine material_parseHomogenization(fileUnit,myPart) +character(len=65536) function material_parseHomogenization(fileUnit) use IO, only: & IO_read, & IO_globalTagInPart, & @@ -585,174 +590,183 @@ subroutine material_parseHomogenization(fileUnit,myPart) mesh_element implicit none - character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, section, s, p - character(len=65536) :: & - tag, line + integer(pInt) :: Nsections, h + character(len=65536) :: line, tag,devNull + character(len=64) :: tag2 logical :: echo + + allocate(homogenizationConfig(0)) - echo = IO_globalTagInPart(fileUnit,myPart,'/echo/') - Nsections = IO_countSections(fileUnit,myPart) - material_Nhomogenization = Nsections - if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) - - allocate(homogenization_name(Nsections)); homogenization_name = '' - allocate(homogenization_type(Nsections), source=HOMOGENIZATION_undefined_ID) - allocate(thermal_type(Nsections), source=THERMAL_isothermal_ID) - allocate(damage_type (Nsections), source=DAMAGE_none_ID) - allocate(vacancyflux_type(Nsections), source=VACANCYFLUX_isoconc_ID) - allocate(porosity_type (Nsections), source=POROSITY_none_ID) - allocate(hydrogenflux_type(Nsections), source=HYDROGENFLUX_isoconc_ID) - allocate(homogenization_typeInstance(Nsections), source=0_pInt) - allocate(thermal_typeInstance(Nsections), source=0_pInt) - allocate(damage_typeInstance(Nsections), source=0_pInt) - allocate(vacancyflux_typeInstance(Nsections), source=0_pInt) - allocate(porosity_typeInstance(Nsections), source=0_pInt) - allocate(hydrogenflux_typeInstance(Nsections), source=0_pInt) - allocate(homogenization_Ngrains(Nsections), source=0_pInt) - allocate(homogenization_Noutput(Nsections), source=0_pInt) - allocate(homogenization_active(Nsections), source=.false.) !!!!!!!!!!!!!!! - allocate(thermal_initialT(Nsections), source=300.0_pReal) - allocate(damage_initialPhi(Nsections), source=1.0_pReal) - allocate(vacancyflux_initialCv(Nsections), source=0.0_pReal) - allocate(porosity_initialPhi(Nsections), source=1.0_pReal) - allocate(hydrogenflux_initialCh(Nsections), source=0.0_pReal) - - forall (s = 1_pInt:Nsections) homogenization_active(s) = any(mesh_element(3,:) == s) ! current homogenization used in model? Homogenization view, maximum operations depend on maximum number of homog schemes - homogenization_Noutput = IO_countTagInPart(fileUnit,myPart,'(output)',Nsections) - - rewind(fileUnit) - line = '' ! to have it initialized - section = 0_pInt ! - " - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to - line = IO_read(fileUnit) - enddo - if (echo) write(6,'(/,1x,a)') trim(line) ! echo part header - + h = 0_pInt do while (trim(line) /= IO_EOF) ! read through sections of material 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 + foundNextPart: if (IO_getTag(line,'<','>') /= '') then + devNull = IO_read(fileUnit, .true.) ! reset IO_read exit - endif - if (echo) write(6,'(2x,a)') trim(line) ! echo back read lines - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - homogenization_name(section) = IO_getTag(line,'[',']') - endif - if (section > 0_pInt) then + endif foundNextPart + nextSection: if (IO_getTag(line,'[',']') /= '') then + h = h + 1_pInt + homogenizationConfig = [homogenizationConfig, emptyList] + tag2 = IO_getTag(line,'[',']') + GfortranBug86033: if (.not. allocated(homogenization_name)) then + allocate(homogenization_name(1),source=tag2) + else GfortranBug86033 + homogenization_name = [homogenization_name,tag2] + endif GfortranBug86033 + endif nextSection + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key + inSection: if (h > 0_pInt) then chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('type','mech','mechanical') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + call homogenizationConfig(h)%add(IO_lc(trim(line)),chunkPos) + else inSection + echo = (trim(tag) == '/echo/') + endif inSection + enddo + + material_Nhomogenization = size(homogenizationConfig) + if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) + + allocate(homogenization_type(material_Nhomogenization), source=HOMOGENIZATION_undefined_ID) + allocate(thermal_type(material_Nhomogenization), source=THERMAL_isothermal_ID) + allocate(damage_type (material_Nhomogenization), source=DAMAGE_none_ID) + allocate(vacancyflux_type(material_Nhomogenization), source=VACANCYFLUX_isoconc_ID) + allocate(porosity_type (material_Nhomogenization), source=POROSITY_none_ID) + allocate(hydrogenflux_type(material_Nhomogenization), source=HYDROGENFLUX_isoconc_ID) + allocate(homogenization_typeInstance(material_Nhomogenization), source=0_pInt) + allocate(thermal_typeInstance(material_Nhomogenization), source=0_pInt) + allocate(damage_typeInstance(material_Nhomogenization), source=0_pInt) + allocate(vacancyflux_typeInstance(material_Nhomogenization), source=0_pInt) + allocate(porosity_typeInstance(material_Nhomogenization), source=0_pInt) + allocate(hydrogenflux_typeInstance(material_Nhomogenization), source=0_pInt) + allocate(homogenization_Ngrains(material_Nhomogenization), source=0_pInt) + allocate(homogenization_Noutput(material_Nhomogenization), source=0_pInt) + allocate(homogenization_active(material_Nhomogenization), source=.false.) !!!!!!!!!!!!!!! + allocate(thermal_initialT(material_Nhomogenization), source=300.0_pReal) + allocate(damage_initialPhi(material_Nhomogenization), source=1.0_pReal) + allocate(vacancyflux_initialCv(material_Nhomogenization), source=0.0_pReal) + allocate(porosity_initialPhi(material_Nhomogenization), source=1.0_pReal) + allocate(hydrogenflux_initialCh(material_Nhomogenization), source=0.0_pReal) + + forall (h = 1_pInt:material_Nhomogenization) homogenization_active(h) = any(mesh_element(3,:) == h) + + + ! homogenization_Noutput = IO_countTagInPart(fileUnit,myPart,'(output)',Nsections) + + do h=1_pInt, material_Nhomogenization + tag = homogenizationConfig(h)%getString('mech') + + select case (trim(tag)) case(HOMOGENIZATION_NONE_label) - homogenization_type(section) = HOMOGENIZATION_NONE_ID - homogenization_Ngrains(section) = 1_pInt + homogenization_type(h) = HOMOGENIZATION_NONE_ID + homogenization_Ngrains(h) = 1_pInt case(HOMOGENIZATION_ISOSTRAIN_label) - homogenization_type(section) = HOMOGENIZATION_ISOSTRAIN_ID + homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID + homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents') case(HOMOGENIZATION_RGC_label) - homogenization_type(section) = HOMOGENIZATION_RGC_ID + homogenization_type(h) = HOMOGENIZATION_RGC_ID + homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents') case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) + call IO_error(500_pInt,ext_msg=trim(tag)) end select - homogenization_typeInstance(section) = & - count(homogenization_type==homogenization_type(section)) ! count instances - case ('thermal') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + homogenization_typeInstance(h) = & + count(homogenization_type==homogenization_type(h)) ! count instances + if (homogenizationConfig(h)%keyExists('thermal')) then + tag = homogenizationConfig(h)%getString('thermal') + + select case (trim(tag)) case(THERMAL_isothermal_label) - thermal_type(section) = THERMAL_isothermal_ID + thermal_type(h) = THERMAL_isothermal_ID case(THERMAL_adiabatic_label) - thermal_type(section) = THERMAL_adiabatic_ID + thermal_type(h) = THERMAL_adiabatic_ID case(THERMAL_conduction_label) - thermal_type(section) = THERMAL_conduction_ID + thermal_type(h) = THERMAL_conduction_ID case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) + call IO_error(500_pInt,ext_msg=trim(tag)) end select - case ('damage') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case(DAMAGE_NONE_label) - damage_type(section) = DAMAGE_none_ID - case(DAMAGE_LOCAL_label) - damage_type(section) = DAMAGE_local_ID - case(DAMAGE_NONLOCAL_label) - damage_type(section) = DAMAGE_nonlocal_ID + tag = homogenizationConfig(h)%getString('damage') + select case (trim(tag)) +! case(DAMAGE_NONE_label) +! damage_type(section) = DAMAGE_none_ID +! case(DAMAGE_LOCAL_label) +! damage_type(section) = DAMAGE_local_ID +! case(DAMAGE_NONLOCAL_label) +! damage_type(section) = DAMAGE_nonlocal_ID case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) + call IO_error(500_pInt,ext_msg=trim(tag)) end select - - case ('vacancyflux') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case(VACANCYFLUX_isoconc_label) - vacancyflux_type(section) = VACANCYFLUX_isoconc_ID - case(VACANCYFLUX_isochempot_label) - vacancyflux_type(section) = VACANCYFLUX_isochempot_ID - case(VACANCYFLUX_cahnhilliard_label) - vacancyflux_type(section) = VACANCYFLUX_cahnhilliard_ID +! + tag = homogenizationConfig(h)%getString('vacancyflux') + select case (trim(tag)) +! case(VACANCYFLUX_isoconc_label) +! vacancyflux_type(section) = VACANCYFLUX_isoconc_ID +! case(VACANCYFLUX_isochempot_label) +! vacancyflux_type(section) = VACANCYFLUX_isochempot_ID +! case(VACANCYFLUX_cahnhilliard_label) +! vacancyflux_type(section) = VACANCYFLUX_cahnhilliard_ID case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - - case ('porosity') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case(POROSITY_NONE_label) - porosity_type(section) = POROSITY_none_ID - case(POROSITY_phasefield_label) - porosity_type(section) = POROSITY_phasefield_ID + call IO_error(500_pInt,ext_msg=trim(tag)) + end select +! + tag = homogenizationConfig(h)%getString('porosity') + select case (trim(tag)) +! case(POROSITY_NONE_label) +! porosity_type(section) = POROSITY_none_ID +! case(POROSITY_phasefield_label) +! porosity_type(section) = POROSITY_phasefield_ID case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - - case ('hydrogenflux') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case(HYDROGENFLUX_isoconc_label) - hydrogenflux_type(section) = HYDROGENFLUX_isoconc_ID - case(HYDROGENFLUX_cahnhilliard_label) - hydrogenflux_type(section) = HYDROGENFLUX_cahnhilliard_ID + call IO_error(500_pInt,ext_msg=trim(tag)) + end select +! + tag = homogenizationConfig(h)%getString('hydrogenflux') + select case (trim(tag)) +! case(HYDROGENFLUX_isoconc_label) +! hydrogenflux_type(section) = HYDROGENFLUX_isoconc_ID +! case(HYDROGENFLUX_cahnhilliard_label) +! hydrogenflux_type(section) = HYDROGENFLUX_cahnhilliard_ID case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) + call IO_error(500_pInt,ext_msg=trim(tag)) end select - - case ('nconstituents') - homogenization_Ngrains(section) = IO_intValue(line,chunkPos,2_pInt) - - case ('t0') - thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt) - - case ('initialdamage') - damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) - - case ('cv0') - vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt) - - case ('initialporosity') - porosity_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) - - case ('ch0') - hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt) - - end select endif enddo - do p=1_pInt, Nsections - homogenization_typeInstance(p) = count(homogenization_type(1:p) == homogenization_type(p)) - thermal_typeInstance(p) = count(thermal_type (1:p) == thermal_type (p)) - damage_typeInstance(p) = count(damage_type (1:p) == damage_type (p)) - vacancyflux_typeInstance(p) = count(vacancyflux_type (1:p) == vacancyflux_type (p)) - porosity_typeInstance(p) = count(porosity_type (1:p) == porosity_type (p)) - hydrogenflux_typeInstance(p) = count(hydrogenflux_type (1:p) == hydrogenflux_type (p)) +! +! case ('t0') +! thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt) +! +! case ('initialdamage') +! damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) +! +! case ('cv0') +! vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt) +! +! +! case ('ch0') +! hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt) +! +! end select +! endif +! enddo + + do h=1_pInt, material_Nhomogenization + homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h)) + thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h)) + damage_typeInstance(h) = count(damage_type (1:h) == damage_type (h)) + vacancyflux_typeInstance(h) = count(vacancyflux_type (1:h) == vacancyflux_type (h)) + porosity_typeInstance(h) = count(porosity_type (1:h) == porosity_type (h)) + hydrogenflux_typeInstance(h) = count(hydrogenflux_type (1:h) == hydrogenflux_type (h)) enddo homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active) + material_parseHomogenization=line -end subroutine material_parseHomogenization +end function material_parseHomogenization !-------------------------------------------------------------------------------------------------- @@ -769,8 +783,9 @@ character(len=65536) function material_parseMicrostructure(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - character(len=64), dimension(:), allocatable :: & + character(len=256), dimension(:), allocatable :: & str + character(len=64) :: tag2 integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt), allocatable, dimension(:,:) :: chunkPoss integer(pInt) :: e, m, constituent, i @@ -778,7 +793,6 @@ character(len=65536) function material_parseMicrostructure(fileUnit) tag,line,devNull logical :: echo - allocate(microstructure_name(0)) allocate(MicrostructureConfig(0)) line = '' ! to have it initialized m = 0_pInt @@ -794,7 +808,12 @@ character(len=65536) function material_parseMicrostructure(fileUnit) nextSection: if (IO_getTag(line,'[',']') /= '') then m = m + 1_pInt microstructureConfig = [microstructureConfig, emptyList] - microstructure_name = [microstructure_Name,IO_getTag(line,'[',']')] + tag2 = IO_getTag(line,'[',']') + GfortranBug86033: if (.not. allocated(microstructure_name)) then + allocate(microstructure_name(1),source=tag2) + else GfortranBug86033 + microstructure_name = [microstructure_name,tag2] + endif GfortranBug86033 endif nextSection chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key @@ -878,11 +897,11 @@ character(len=65536) function material_parseCrystallite(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=64) :: tag2 integer(pInt) :: c character(len=65536) :: line, tag,devNull logical :: echo - allocate(crystallite_name(0)) allocate(crystalliteConfig(0)) c = 0_pInt do while (trim(line) /= IO_EOF) ! read through sections of material part @@ -895,7 +914,12 @@ character(len=65536) function material_parseCrystallite(fileUnit) nextSection: if (IO_getTag(line,'[',']') /= '') then c = c + 1_pInt crystalliteConfig = [crystalliteConfig, emptyList] - crystallite_name = [crystallite_name,IO_getTag(line,'[',']')] + tag2 = IO_getTag(line,'[',']') + GfortranBug86033: if (.not. allocated(crystallite_name)) then + allocate(crystallite_name(1),source=tag2) + else GfortranBug86033 + crystallite_name = [crystallite_name,tag2] + endif GfortranBug86033 endif nextSection chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key @@ -947,11 +971,11 @@ character(len=65536) function material_parsePhase(fileUnit) integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p character(len=65536) :: & tag,line,devNull + character(len=64) :: tag2 character(len=64), dimension(:), allocatable :: & str logical :: echo - allocate(phase_name(0)) allocate(phaseConfig(0)) line = '' ! to have it initialized p = 0_pInt ! - " - @@ -967,7 +991,12 @@ character(len=65536) function material_parsePhase(fileUnit) nextSection: if (IO_getTag(line,'[',']') /= '') then p = p + 1_pInt phaseConfig = [phaseConfig, emptyList] - phase_name = [phase_Name,IO_getTag(line,'[',']')] + tag2 = IO_getTag(line,'[',']') + GfortranBug86033: if (.not. allocated(phase_name)) then + allocate(phase_name(1),source=tag2) + else GfortranBug86033 + phase_name = [phase_name,tag2] + endif GfortranBug86033 endif nextSection chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key From 142ce51c9c2d728ab26560f64dc847c9025ba8d0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 19:28:08 +0200 Subject: [PATCH 20/94] homogenization and crystallite use new structure math_transpose33 has no advantage over transpose intrinsic --- PRIVATE | 2 +- src/crystallite.f90 | 204 +++++++++++++++++------------------------ src/homogenization.f90 | 8 +- 3 files changed, 86 insertions(+), 128 deletions(-) diff --git a/PRIVATE b/PRIVATE index a11897e49..55a1fd701 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit a11897e49af7c0e71ccc74d222a6d502990f730b +Subproject commit 55a1fd701720fdd8caa53c058f651e009ab9e4aa diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 12bf19871..787d56fd7 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -155,7 +155,6 @@ subroutine crystallite_init math_I3, & math_EulerToR, & math_inv33, & - math_transpose33, & math_mul33xx33, & math_mul33x33 use FEsolving, only: & @@ -167,28 +166,18 @@ subroutine crystallite_init mesh_maxNips, & mesh_maxNipNeighbors use IO, only: & - IO_read, & IO_timeStamp, & - IO_open_jobFile_stat, & - IO_open_file, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & IO_stringValue, & IO_write_jobFile, & - IO_error, & - IO_EOF + IO_error use material use constitutive, only: & constitutive_initialFi, & constitutive_microstructure ! derived (shortcut) quantities of given state implicit none - integer(pInt), parameter :: & - FILEUNIT = 200_pInt - integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt), parameter :: FILEUNIT=434_pInt integer(pInt) :: & c, & !< counter in integration point component loop i, & !< counter in integration point loop @@ -200,12 +189,11 @@ subroutine crystallite_init eMax, & !< maximum number of elements nMax, & !< maximum number of ip neighbors myNcomponents, & !< number of components at current IP - section = 0_pInt, & mySize + character(len=64), dimension(:), allocatable :: str character(len=65536) :: & - tag = '', & - line= '' + tag = '' write(6,'(/,a)') ' <<<+- crystallite init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -277,85 +265,61 @@ subroutine crystallite_init allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), & material_Ncrystallite), source=0_pInt) - if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... - call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partCrystallite) ! wind forward to - line = IO_read(FILEUNIT) - enddo - - do while (trim(line) /= IO_EOF) ! read through sections of crystallite 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 - section = section + 1_pInt - o = 0_pInt ! reset output counter - cycle ! skip to next line - endif - if (section > 0_pInt) then - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - o = o + 1_pInt - crystallite_output(o,section) = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - outputName: select case(crystallite_output(o,section)) + do c = 1_pInt, material_Ncrystallite + str = crystalliteConfig(c)%getStrings('(output)')!,defaultVal=[]) + do o = 1_pInt, size(str) + outputName: select case(str(o)) case ('phase') outputName - crystallite_outputID(o,section) = phase_ID + crystallite_outputID(o,c) = phase_ID case ('texture') outputName - crystallite_outputID(o,section) = texture_ID + crystallite_outputID(o,c) = texture_ID case ('volume') outputName - crystallite_outputID(o,section) = volume_ID + crystallite_outputID(o,c) = volume_ID case ('grainrotationx') outputName - crystallite_outputID(o,section) = grainrotationx_ID + crystallite_outputID(o,c) = grainrotationx_ID case ('grainrotationy') outputName - crystallite_outputID(o,section) = grainrotationy_ID + crystallite_outputID(o,c) = grainrotationy_ID case ('grainrotationz') outputName - crystallite_outputID(o,section) = grainrotationx_ID + crystallite_outputID(o,c) = grainrotationx_ID case ('orientation') outputName - crystallite_outputID(o,section) = orientation_ID + crystallite_outputID(o,c) = orientation_ID case ('grainrotation') outputName - crystallite_outputID(o,section) = grainrotation_ID + crystallite_outputID(o,c) = grainrotation_ID case ('eulerangles') outputName - crystallite_outputID(o,section) = eulerangles_ID + crystallite_outputID(o,c) = eulerangles_ID case ('defgrad','f') outputName - crystallite_outputID(o,section) = defgrad_ID + crystallite_outputID(o,c) = defgrad_ID case ('fe') outputName - crystallite_outputID(o,section) = fe_ID + crystallite_outputID(o,c) = fe_ID case ('fp') outputName - crystallite_outputID(o,section) = fp_ID + crystallite_outputID(o,c) = fp_ID case ('fi') outputName - crystallite_outputID(o,section) = fi_ID + crystallite_outputID(o,c) = fi_ID case ('lp') outputName - crystallite_outputID(o,section) = lp_ID + crystallite_outputID(o,c) = lp_ID case ('li') outputName - crystallite_outputID(o,section) = li_ID + crystallite_outputID(o,c) = li_ID case ('e') outputName - crystallite_outputID(o,section) = e_ID + crystallite_outputID(o,c) = e_ID case ('ee') outputName - crystallite_outputID(o,section) = ee_ID + crystallite_outputID(o,c) = ee_ID case ('p','firstpiola','1stpiola') outputName - crystallite_outputID(o,section) = p_ID + crystallite_outputID(o,c) = p_ID case ('s','tstar','secondpiola','2ndpiola') outputName - crystallite_outputID(o,section) = s_ID + crystallite_outputID(o,c) = s_ID case ('elasmatrix') outputName - crystallite_outputID(o,section) = elasmatrix_ID + crystallite_outputID(o,c) = elasmatrix_ID case ('neighboringip') outputName - crystallite_outputID(o,section) = neighboringip_ID + crystallite_outputID(o,c) = neighboringip_ID case ('neighboringelement') outputName - crystallite_outputID(o,section) = neighboringelement_ID + crystallite_outputID(o,c) = neighboringelement_ID case default outputName - call IO_error(105_pInt,ext_msg=IO_stringValue(line,chunkPos,2_pInt)//' (Crystallite)') + call IO_error(105_pInt,ext_msg=tag//' (Crystallite)') end select outputName - end select - endif +enddo enddo - close(FILEUNIT) do r = 1_pInt,material_Ncrystallite do o = 1_pInt,crystallite_Noutput(r) @@ -537,7 +501,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) use math, only: & math_inv33, & math_identity2nd, & - math_transpose33, & math_mul33x33, & math_mul66x6, & math_Mandel6to33, & @@ -616,17 +579,17 @@ subroutine crystallite_stressAndItsTangent(updateJaco) write(6,'(/,a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> boundary values at el ip ipc ', & debug_e,'(',mesh_element(1,debug_e), ')',debug_i, debug_g write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> F ', & - math_transpose33(crystallite_partionedF(1:3,1:3,debug_g,debug_i,debug_e)) + transpose(crystallite_partionedF(1:3,1:3,debug_g,debug_i,debug_e)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> F0 ', & - math_transpose33(crystallite_partionedF0(1:3,1:3,debug_g,debug_i,debug_e)) + transpose(crystallite_partionedF0(1:3,1:3,debug_g,debug_i,debug_e)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp0', & - math_transpose33(crystallite_partionedFp0(1:3,1:3,debug_g,debug_i,debug_e)) + transpose(crystallite_partionedFp0(1:3,1:3,debug_g,debug_i,debug_e)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fi0', & - math_transpose33(crystallite_partionedFi0(1:3,1:3,debug_g,debug_i,debug_e)) + transpose(crystallite_partionedFi0(1:3,1:3,debug_g,debug_i,debug_e)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Lp0', & - math_transpose33(crystallite_partionedLp0(1:3,1:3,debug_g,debug_i,debug_e)) + transpose(crystallite_partionedLp0(1:3,1:3,debug_g,debug_i,debug_e)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Li0', & - math_transpose33(crystallite_partionedLi0(1:3,1:3,debug_g,debug_i,debug_e)) + transpose(crystallite_partionedLi0(1:3,1:3,debug_g,debug_i,debug_e)) endif !-------------------------------------------------------------------------------------------------- @@ -1107,15 +1070,15 @@ subroutine crystallite_stressAndItsTangent(updateJaco) .or. .not. iand(debug_level(debug_crystallite),debug_levelSelective) /= 0_pInt)) then write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> central solution of cryst_StressAndTangent at el ip ipc ',e,i,c write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CRYST >> P / MPa', & - math_transpose33(crystallite_P(1:3,1:3,c,i,e))*1.0e-6_pReal + transpose(crystallite_P(1:3,1:3,c,i,e))*1.0e-6_pReal write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp', & - math_transpose33(crystallite_Fp(1:3,1:3,c,i,e)) + transpose(crystallite_Fp(1:3,1:3,c,i,e)) write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fi', & - math_transpose33(crystallite_Fi(1:3,1:3,c,i,e)) + transpose(crystallite_Fi(1:3,1:3,c,i,e)) write(6,'(a,/,3(12x,3(f14.9,1x)/),/)') '<< CRYST >> Lp', & - math_transpose33(crystallite_Lp(1:3,1:3,c,i,e)) + transpose(crystallite_Lp(1:3,1:3,c,i,e)) write(6,'(a,/,3(12x,3(f14.9,1x)/),/)') '<< CRYST >> Li', & - math_transpose33(crystallite_Li(1:3,1:3,c,i,e)) + transpose(crystallite_Li(1:3,1:3,c,i,e)) flush(6) endif enddo @@ -1166,7 +1129,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS - temp_33 = math_transpose33(math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), & + temp_33 = transpose(math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), & crystallite_invFi(1:3,1:3,c,i,e))) rhs_3333 = 0.0_pReal forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) & @@ -1208,12 +1171,12 @@ subroutine crystallite_stressAndItsTangent(updateJaco) crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal temp_33 = math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), & math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), & - math_transpose33(crystallite_invFp(1:3,1:3,c,i,e)))) + transpose(crystallite_invFp(1:3,1:3,c,i,e)))) forall(p=1_pInt:3_pInt) & - crystallite_dPdF(p,1:3,p,1:3,c,i,e) = math_transpose33(temp_33) + crystallite_dPdF(p,1:3,p,1:3,c,i,e) = transpose(temp_33) temp_33 = math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), & - math_transpose33(crystallite_invFp(1:3,1:3,c,i,e))) + transpose(crystallite_invFp(1:3,1:3,c,i,e))) forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) & crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + & math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e),dFpinvdF(1:3,1:3,p,o)),temp_33) @@ -1223,14 +1186,14 @@ subroutine crystallite_stressAndItsTangent(updateJaco) forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) & crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + & math_mul33x33(math_mul33x33(temp_33,dSdF(1:3,1:3,p,o)), & - math_transpose33(crystallite_invFp(1:3,1:3,c,i,e))) + transpose(crystallite_invFp(1:3,1:3,c,i,e))) temp_33 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), & crystallite_invFp(1:3,1:3,c,i,e)), & math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e))) forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) & crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + & - math_mul33x33(temp_33,math_transpose33(dFpinvdF(1:3,1:3,p,o))) + math_mul33x33(temp_33,transpose(dFpinvdF(1:3,1:3,p,o))) enddo; enddo enddo elementLooping6 @@ -3195,7 +3158,6 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33) use math, only: & math_mul33x33, & math_inv33, & - math_transpose33, & math_EulerToR use material, only: & material_EulerAngles @@ -3210,8 +3172,8 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33) ipc ! grain index T = math_mul33x33(math_EulerToR(material_EulerAngles(1:3,ipc,ip,el)), & - math_transpose33(math_inv33(crystallite_subF(1:3,1:3,ipc,ip,el)))) - crystallite_push33ToRef = math_mul33x33(math_transpose33(T),math_mul33x33(tensor33,T)) + transpose(math_inv33(crystallite_subF(1:3,1:3,ipc,ip,el)))) + crystallite_push33ToRef = math_mul33x33(transpose(T),math_mul33x33(tensor33,T)) end function crystallite_push33ToRef @@ -3260,7 +3222,6 @@ logical function crystallite_integrateStress(& math_mul3333xx3333, & math_mul66x6, & math_mul99x99, & - math_transpose33, & math_inv33, & math_invert, & math_det33, & @@ -3386,7 +3347,7 @@ logical function crystallite_integrateStress(& write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fp_current at el (elFE) ip ipc ',& el,'(',mesh_element(1,el),')',ip,ipc if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) & - write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',math_transpose33(Fp_current(1:3,1:3)) + write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',transpose(Fp_current(1:3,1:3)) endif #endif return @@ -3402,7 +3363,7 @@ logical function crystallite_integrateStress(& write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fi_current at el (elFE) ip ipc ',& el,'(',mesh_element(1,el),')',ip,ipc if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) & - write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',math_transpose33(Fi_current(1:3,1:3)) + write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',transpose(Fi_current(1:3,1:3)) endif #endif return @@ -3465,9 +3426,9 @@ logical function crystallite_integrateStress(& .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then write(6,'(a,i3,/)') '<< CRYST >> stress iteration ', NiterationStressLp - write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lpguess', math_transpose33(Lpguess) - write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fi', math_transpose33(Fi_new) - write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fe', math_transpose33(Fe) + write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lpguess', transpose(Lpguess) + write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fi', transpose(Fi_new) + write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fe', transpose(Fe) write(6,'(a,/,6(e20.10,1x))') '<< CRYST >> Tstar', Tstar_v endif #endif @@ -3488,7 +3449,7 @@ logical function crystallite_integrateStress(& if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then - write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lp_constitutive', math_transpose33(Lp_constitutive) + write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lp_constitutive', transpose(Lp_constitutive) endif #endif @@ -3534,7 +3495,7 @@ logical function crystallite_integrateStress(& if (mod(jacoCounterLp, iJacoLpresiduum) == 0_pInt) then dFe_dLp3333 = 0.0_pReal forall(o=1_pInt:3_pInt,p=1_pInt:3_pInt) & - dFe_dLp3333(o,1:3,p,1:3) = A(o,p)*math_transpose33(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) + dFe_dLp3333(o,1:3,p,1:3) = A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) dFe_dLp3333 = - dt * dFe_dLp3333 dRLp_dLp = math_identity2nd(9_pInt) & - math_Plain3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dT3333,dT_dFe3333),dFe_dLp3333)) @@ -3564,10 +3525,10 @@ logical function crystallite_integrateStress(& write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLp',transpose(math_Plain3333to99(dFe_dLp3333)) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dT_dFe_constitutive',transpose(math_Plain3333to99(dT_dFe3333)) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLp_dT_constitutive',transpose(math_Plain3333to99(dLp_dT3333)) - write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> A',math_transpose33(A) - write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> B',math_transpose33(B) - write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lp_constitutive',math_transpose33(Lp_constitutive) - write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lpguess',math_transpose33(Lpguess) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> A',transpose(A) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> B',transpose(B) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lp_constitutive',transpose(Lp_constitutive) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lpguess',transpose(Lpguess) endif endif #endif @@ -3597,8 +3558,8 @@ logical function crystallite_integrateStress(& if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then - write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive', math_transpose33(Li_constitutive) - write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess', math_transpose33(Liguess) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive', transpose(Li_constitutive) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess', transpose(Liguess) endif #endif !* update current residuum and check for convergence of loop @@ -3653,8 +3614,8 @@ logical function crystallite_integrateStress(& write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLi',transpose(math_Plain3333to99(dFe_dLi3333)) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dT_dFi_constitutive',transpose(math_Plain3333to99(dT_dFi3333)) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLi_dT_constitutive',transpose(math_Plain3333to99(dLi_dT3333)) - write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive',math_transpose33(Li_constitutive) - write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess',math_transpose33(Liguess) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive',transpose(Li_constitutive) + write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess',transpose(Liguess) endif endif #endif @@ -3688,7 +3649,7 @@ logical function crystallite_integrateStress(& if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) & - write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new) + write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',transpose(invFp_new) endif #endif return @@ -3699,7 +3660,7 @@ logical function crystallite_integrateStress(& crystallite_P(1:3,1:3,ipc,ip,el) = math_mul33x33(math_mul33x33(Fg_new,invFp_new), & math_mul33x33(math_Mandel6to33(Tstar_v), & - math_transpose33(invFp_new))) + transpose(invFp_new))) !* store local values in global variables @@ -3719,13 +3680,13 @@ logical function crystallite_integrateStress(& if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then - write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> P / MPa',math_transpose33(crystallite_P(1:3,1:3,ipc,ip,el))*1.0e-6_pReal + write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> P / MPa',transpose(crystallite_P(1:3,1:3,ipc,ip,el))*1.0e-6_pReal write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Cauchy / MPa', & - math_mul33x33(crystallite_P(1:3,1:3,ipc,ip,el), math_transpose33(Fg_new)) * 1.0e-6_pReal / math_det33(Fg_new) + math_mul33x33(crystallite_P(1:3,1:3,ipc,ip,el), transpose(Fg_new)) * 1.0e-6_pReal / math_det33(Fg_new) write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fe Lp Fe^-1', & - math_transpose33(math_mul33x33(Fe_new, math_mul33x33(crystallite_Lp(1:3,1:3,ipc,ip,el), math_inv33(Fe_new)))) ! transpose to get correct print out order - write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp',math_transpose33(crystallite_Fp(1:3,1:3,ipc,ip,el)) - write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fi',math_transpose33(crystallite_Fi(1:3,1:3,ipc,ip,el)) + transpose(math_mul33x33(Fe_new, math_mul33x33(crystallite_Lp(1:3,1:3,ipc,ip,el), math_inv33(Fe_new)))) ! transpose to get correct print out order + write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp',transpose(crystallite_Fp(1:3,1:3,ipc,ip,el)) + write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fi',transpose(crystallite_Fi(1:3,1:3,ipc,ip,el)) endif #endif @@ -3842,7 +3803,6 @@ function crystallite_postResults(ipc, ip, el) math_qToEuler, & math_qToEulerAxisAngle, & math_mul33x33, & - math_transpose33, & math_det33, & math_I3, & inDeg, & @@ -3945,41 +3905,41 @@ function crystallite_postResults(ipc, ip, el) case (defgrad_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & - reshape(math_transpose33(crystallite_partionedF(1:3,1:3,ipc,ip,el)),[mySize]) + reshape(transpose(crystallite_partionedF(1:3,1:3,ipc,ip,el)),[mySize]) case (e_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = 0.5_pReal * reshape((math_mul33x33( & - math_transpose33(crystallite_partionedF(1:3,1:3,ipc,ip,el)), & + transpose(crystallite_partionedF(1:3,1:3,ipc,ip,el)), & crystallite_partionedF(1:3,1:3,ipc,ip,el)) - math_I3),[mySize]) case (fe_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & - reshape(math_transpose33(crystallite_Fe(1:3,1:3,ipc,ip,el)),[mySize]) + reshape(transpose(crystallite_Fe(1:3,1:3,ipc,ip,el)),[mySize]) case (ee_ID) - Ee = 0.5_pReal *(math_mul33x33(math_transpose33(crystallite_Fe(1:3,1:3,ipc,ip,el)), & + Ee = 0.5_pReal *(math_mul33x33(transpose(crystallite_Fe(1:3,1:3,ipc,ip,el)), & crystallite_Fe(1:3,1:3,ipc,ip,el)) - math_I3) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = reshape(Ee,[mySize]) case (fp_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & - reshape(math_transpose33(crystallite_Fp(1:3,1:3,ipc,ip,el)),[mySize]) + reshape(transpose(crystallite_Fp(1:3,1:3,ipc,ip,el)),[mySize]) case (fi_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & - reshape(math_transpose33(crystallite_Fi(1:3,1:3,ipc,ip,el)),[mySize]) + reshape(transpose(crystallite_Fi(1:3,1:3,ipc,ip,el)),[mySize]) case (lp_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & - reshape(math_transpose33(crystallite_Lp(1:3,1:3,ipc,ip,el)),[mySize]) + reshape(transpose(crystallite_Lp(1:3,1:3,ipc,ip,el)),[mySize]) case (li_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & - reshape(math_transpose33(crystallite_Li(1:3,1:3,ipc,ip,el)),[mySize]) + reshape(transpose(crystallite_Li(1:3,1:3,ipc,ip,el)),[mySize]) case (p_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & - reshape(math_transpose33(crystallite_P(1:3,1:3,ipc,ip,el)),[mySize]) + reshape(transpose(crystallite_P(1:3,1:3,ipc,ip,el)),[mySize]) case (s_ID) mySize = 9_pInt crystallite_postResults(c+1:c+mySize) = & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 7dbea41d5..14ffdcdd6 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -443,11 +443,9 @@ subroutine homogenization_init allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems)) #endif - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- homogenization init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- homogenization init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then #ifdef TODO @@ -475,7 +473,7 @@ subroutine homogenization_init flush(6) if (debug_g < 1 .or. debug_g > homogenization_Ngrains(mesh_element(3,debug_e))) & - call IO_error(602_pInt,ext_msg='component (grain)', el=debug_e, g=debug_g) + call IO_error(602_pInt,ext_msg='constituent', el=debug_e, g=debug_g) end subroutine homogenization_init From db32bd1fd665648e5da317ca002208acd0b40855 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 20:59:30 +0200 Subject: [PATCH 21/94] initializing lattice after materials allows to use the pre-parsed material.config --- src/CPFEM.f90 | 4 ++-- src/CPFEM2.f90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index 66aa11433..44146c90e 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -68,10 +68,10 @@ subroutine CPFEM_initAll(el,ip) math_init use mesh, only: & mesh_init - use lattice, only: & - lattice_init use material, only: & material_init + use lattice, only: & + lattice_init use constitutive, only: & constitutive_init use crystallite, only: & diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index a89bfc294..09a98aaec 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -33,10 +33,10 @@ subroutine CPFEM_initAll(el,ip) math_init use mesh, only: & mesh_init - use lattice, only: & - lattice_init use material, only: & material_init + use lattice, only: & + lattice_init use constitutive, only: & constitutive_init use crystallite, only: & From 3fec2c960d4de2052fe8611a4424b5007e523f13 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 21:00:26 +0200 Subject: [PATCH 22/94] missing initialization caused problems --- src/material.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 54085b7ca..9af08df94 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -841,7 +841,7 @@ character(len=65536) function material_parseMicrostructure(fileUnit) do m=1_pInt, material_Nmicrostructure microstructure_Nconstituents(m) = microstructureConfig(m)%countKeys('(constituent)') microstructure_crystallite(m) = microstructureConfig(m)%getInt('crystallite') - ! microstructure_elemhomo = IO_spotTagInPart(fileUnit,myPart,'/elementhomogeneous/',Nsections) + microstructure_elemhomo(m) = microstructureConfig(m)%keyExists('/elementhomogeneous/') enddo microstructure_maxNconstituents = maxval(microstructure_Nconstituents) @@ -1025,7 +1025,7 @@ character(len=65536) function material_parsePhase(fileUnit) phase_Nsources(p) = phaseConfig(p)%countKeys('(source)') phase_Nkinematics(p) = phaseConfig(p)%countKeys('(kinematics)') phase_NstiffnessDegradations(p) = phaseConfig(p)%countKeys('(stiffness_degradation)') - !phase_localPlasticity(p) = .not. IO_spotTagInPart(fileUnit,myPart,'/nonlocal/') + phase_localPlasticity(p) = .not. phaseConfig(p)%KeyExists('/nonlocal/') select case (phaseConfig(p)%getString('elasticity')) case (ELASTICITY_HOOKE_label) From e93e380ad33c14a25fe1b1d365851a47c958e7d9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 21:00:47 +0200 Subject: [PATCH 23/94] output tag was empty: --- src/crystallite.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 787d56fd7..dd166fe4c 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -269,6 +269,7 @@ subroutine crystallite_init do c = 1_pInt, material_Ncrystallite str = crystalliteConfig(c)%getStrings('(output)')!,defaultVal=[]) do o = 1_pInt, size(str) + crystallite_output(o,c) = str(o) outputName: select case(str(o)) case ('phase') outputName crystallite_outputID(o,c) = phase_ID From 2434b4d632b72ae3ef62a28431897fd87d66d10e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 21:01:03 +0200 Subject: [PATCH 24/94] adjusted to homogenization keyword 'mech' (was 'type') --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 55a1fd701..c274c8b25 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 55a1fd701720fdd8caa53c058f651e009ab9e4aa +Subproject commit c274c8b2546b3dd37c757c8dcb591678433f6352 From 5ec98f65b460de0466d046f62f272ef1269d41e5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 23:10:08 +0200 Subject: [PATCH 25/94] wrong intialization, homogenization test failed --- src/material.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 9af08df94..70631b7e5 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -857,13 +857,13 @@ character(len=65536) function material_parseMicrostructure(fileUnit) select case (tag) case('phase') - microstructure_phase(constituent,m) = IO_intValue(str(constituent),chunkPos,i+1_pInt) + microstructure_phase(constituent,m) = IO_intValue(str(constituent),chunkPoss(:,constituent),i+1_pInt) case('texture') - microstructure_texture(constituent,m) = IO_intValue(str(constituent),chunkPos,i+1_pInt) + microstructure_texture(constituent,m) = IO_intValue(str(constituent),chunkPoss(:,constituent),i+1_pInt) case('fraction') - microstructure_fraction(constituent,m) = IO_floatValue(str(constituent),chunkPos,i+1_pInt) + microstructure_fraction(constituent,m) = IO_floatValue(str(constituent),chunkPoss(:,constituent),i+1_pInt) end select enddo From 1e5106f60153ab3a5b0ea411d07d830a8f491190 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jun 2018 23:10:38 +0200 Subject: [PATCH 26/94] return empty string array if nothing found (plasticity detect changes failed) --- src/list.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/list.f90 b/src/list.f90 index 973e21dc2..26bfa151a 100644 --- a/src/list.f90 +++ b/src/list.f90 @@ -408,7 +408,10 @@ end function getFloatArray tmp => this%next do - if (.not. associated(tmp)) exit + if (.not. associated(tmp)) then + if (.not. allocated(getStrings)) allocate(getStrings(0),source=str) + exit + endif 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) From 5b5f10aecf2c1e01205f2a30ffe1b2355e33c6f2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jun 2018 00:36:34 +0200 Subject: [PATCH 27/94] parsing homogenization-related data --- src/material.f90 | 80 ++++++++++++++++++++++-------------------------- 1 file changed, 37 insertions(+), 43 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 70631b7e5..5fa123dc4 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -173,7 +173,6 @@ module material integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: & homogenization_type !< type of each homogenization -!ToDo: should be private character(len=64), dimension(:), allocatable, public, protected :: & phase_name, & !< name of each phase @@ -656,9 +655,9 @@ character(len=65536) function material_parseHomogenization(fileUnit) forall (h = 1_pInt:material_Nhomogenization) homogenization_active(h) = any(mesh_element(3,:) == h) - ! homogenization_Noutput = IO_countTagInPart(fileUnit,myPart,'(output)',Nsections) do h=1_pInt, material_Nhomogenization + homogenization_Noutput(h) = homogenizationConfig(h)%countKeys('(output)') tag = homogenizationConfig(h)%getString('mech') select case (trim(tag)) @@ -679,6 +678,8 @@ character(len=65536) function material_parseHomogenization(fileUnit) if (homogenizationConfig(h)%keyExists('thermal')) then tag = homogenizationConfig(h)%getString('thermal') +! case ('t0') +! thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt) select case (trim(tag)) case(THERMAL_isothermal_label) thermal_type(h) = THERMAL_isothermal_ID @@ -689,71 +690,64 @@ character(len=65536) function material_parseHomogenization(fileUnit) case default call IO_error(500_pInt,ext_msg=trim(tag)) end select +endif + if (homogenizationConfig(h)%keyExists('damage')) then tag = homogenizationConfig(h)%getString('damage') +! case ('initialdamage') +! damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) select case (trim(tag)) -! case(DAMAGE_NONE_label) -! damage_type(section) = DAMAGE_none_ID -! case(DAMAGE_LOCAL_label) -! damage_type(section) = DAMAGE_local_ID -! case(DAMAGE_NONLOCAL_label) -! damage_type(section) = DAMAGE_nonlocal_ID + case(DAMAGE_NONE_label) + damage_type(h) = DAMAGE_none_ID + case(DAMAGE_LOCAL_label) + damage_type(h) = DAMAGE_local_ID + case(DAMAGE_NONLOCAL_label) + damage_type(h) = DAMAGE_nonlocal_ID case default call IO_error(500_pInt,ext_msg=trim(tag)) end select -! +endif + if (homogenizationConfig(h)%keyExists('vacancyflux')) then tag = homogenizationConfig(h)%getString('vacancyflux') +! case ('cv0') +! vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt) select case (trim(tag)) -! case(VACANCYFLUX_isoconc_label) -! vacancyflux_type(section) = VACANCYFLUX_isoconc_ID -! case(VACANCYFLUX_isochempot_label) -! vacancyflux_type(section) = VACANCYFLUX_isochempot_ID -! case(VACANCYFLUX_cahnhilliard_label) -! vacancyflux_type(section) = VACANCYFLUX_cahnhilliard_ID + case(VACANCYFLUX_isoconc_label) + vacancyflux_type(h) = VACANCYFLUX_isoconc_ID + case(VACANCYFLUX_isochempot_label) + vacancyflux_type(h) = VACANCYFLUX_isochempot_ID + case(VACANCYFLUX_cahnhilliard_label) + vacancyflux_type(h) = VACANCYFLUX_cahnhilliard_ID case default call IO_error(500_pInt,ext_msg=trim(tag)) end select -! +endif + if (homogenizationConfig(h)%keyExists('porosity')) then tag = homogenizationConfig(h)%getString('porosity') select case (trim(tag)) -! case(POROSITY_NONE_label) -! porosity_type(section) = POROSITY_none_ID -! case(POROSITY_phasefield_label) -! porosity_type(section) = POROSITY_phasefield_ID + case(POROSITY_NONE_label) + porosity_type(h) = POROSITY_none_ID + case(POROSITY_phasefield_label) + porosity_type(h) = POROSITY_phasefield_ID case default call IO_error(500_pInt,ext_msg=trim(tag)) end select -! +endif + if (homogenizationConfig(h)%keyExists('hydrogenflux')) then tag = homogenizationConfig(h)%getString('hydrogenflux') +! case ('ch0') +! hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt) select case (trim(tag)) -! case(HYDROGENFLUX_isoconc_label) -! hydrogenflux_type(section) = HYDROGENFLUX_isoconc_ID -! case(HYDROGENFLUX_cahnhilliard_label) -! hydrogenflux_type(section) = HYDROGENFLUX_cahnhilliard_ID + case(HYDROGENFLUX_isoconc_label) + hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID + case(HYDROGENFLUX_cahnhilliard_label) + hydrogenflux_type(h) = HYDROGENFLUX_cahnhilliard_ID case default call IO_error(500_pInt,ext_msg=trim(tag)) end select endif enddo -! -! case ('t0') -! thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt) -! -! case ('initialdamage') -! damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) -! -! case ('cv0') -! vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt) -! -! -! case ('ch0') -! hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt) -! -! end select -! endif -! enddo - do h=1_pInt, material_Nhomogenization homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h)) thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h)) From 4943b30d471e9be89bc52140956181ec12a027e9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jun 2018 09:40:22 +0200 Subject: [PATCH 28/94] J2 test required update --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index c274c8b25..701d63b0e 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c274c8b2546b3dd37c757c8dcb591678433f6352 +Subproject commit 701d63b0e11a653797afe260d1dfc12e2a390d6f From e7d27a399185a66948bb67490b70f096972c9c75 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jun 2018 10:43:43 +0200 Subject: [PATCH 29/94] function to return plain strings (in case they have a different syntax) --- src/list.f90 | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/src/list.f90 b/src/list.f90 index 26bfa151a..e9e27b6d4 100644 --- a/src/list.f90 +++ b/src/list.f90 @@ -19,6 +19,7 @@ module chained_list procedure :: show => show procedure :: getRaw => getRaw procedure :: getRaws => getRaws + procedure :: getStringsRaw => getStringsRaw procedure :: getFloat => getFloat procedure :: getFloatArray => getFloatArray @@ -157,6 +158,37 @@ subroutine getRaws(this,key,string,stringPos) end subroutine getRaws +!-------------------------------------------------------------------------------------------------- +!> @brief gets raw data +!> @details returns raw string and start/end position of chunks in this string +!-------------------------------------------------------------------------------------------------- +function getStringsRaw(this) + use IO, only: & + IO_error, & + IO_stringValue + + implicit none + class(tPartitionedStringList), intent(in) :: this + character(len=256), dimension(:),allocatable :: getStringsRaw + character(len=256) :: stringTmp + type(tPartitionedStringList), pointer :: tmp + + tmp => this%next + do + if (.not. associated(tmp)) then + if(size(getStringsRaw) < 0_pInt) call IO_error(1_pInt,ext_msg='getallraw empty list') + exit + endif + stringTmp = tmp%string%val + if (.not. allocated(getStringsRaw)) then + allocate(getStringsRaw(1),source=stringTmp) + else + getStringsRaw = [getStringsRaw,stringTmp] + endif + tmp => tmp%next + end do +end function getStringsRaw + !-------------------------------------------------------------------------------------------------- !> @brief gets float value for given key !> @details if key is not found exits with error unless default is given From b05541602682e528e84eae47f7746e8af90fe5dd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jun 2018 10:44:20 +0200 Subject: [PATCH 30/94] also parsing texture only once --- src/material.f90 | 124 ++++++++++++++++++++++++++--------------------- 1 file changed, 69 insertions(+), 55 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 5fa123dc4..8604e52a0 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -309,6 +309,7 @@ module material phaseConfig, & microstructureConfig, & homogenizationConfig, & + textureConfig, & crystalliteConfig public :: & @@ -443,6 +444,10 @@ subroutine material_init() case (trim(material_partHomogenization)) line = material_parseHomogenization(FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) + + case (trim(material_partTexture)) + line = material_parseTexture(FILEUNIT) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) case default line = IO_read(fileUnit) @@ -451,10 +456,6 @@ subroutine material_init() enddo - call material_parseTexture(FILEUNIT,material_partTexture) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) - close(FILEUNIT) - allocate(plasticState (material_Nphase)) allocate(sourceState (material_Nphase)) do myPhase = 1,material_Nphase @@ -1002,7 +1003,6 @@ character(len=65536) function material_parsePhase(fileUnit) endif inSection enddo - material_Nphase = size(phaseConfig) if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase) @@ -1123,7 +1123,7 @@ end function material_parsePhase !-------------------------------------------------------------------------------------------------- !> @brief parses the texture part in the material configuration file !-------------------------------------------------------------------------------------------------- -subroutine material_parseTexture(fileUnit,myPart) +character(len=65536) function material_parseTexture(fileUnit) use prec, only: & dNeq use IO, only: & @@ -1148,63 +1148,77 @@ subroutine material_parseTexture(fileUnit,myPart) math_inv33 implicit none - character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, section, gauss, fiber, j - character(len=65536) :: tag - character(len=65536) :: line + integer(pInt) :: Nsections, section, gauss, fiber, j, t, i + character(len=64) :: tag2 + character(len=256), dimension(:), allocatable :: bla logical :: echo - echo = IO_globalTagInPart(fileUnit,myPart,'/echo/') + character(len=65536) :: line, tag,devNull - Nsections = IO_countSections(fileUnit,myPart) - material_Ntexture = Nsections - if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) + allocate(textureConfig(0)) - allocate(texture_name(Nsections)); texture_name='' - allocate(texture_ODFfile(Nsections)); texture_ODFfile='' - allocate(texture_symmetry(Nsections), source=1_pInt) - allocate(texture_Ngauss(Nsections), source=0_pInt) - allocate(texture_Nfiber(Nsections), source=0_pInt) - - texture_Ngauss = IO_countTagInPart(fileUnit,myPart,'(gauss)', Nsections) + & - IO_countTagInPart(fileUnit,myPart,'(random)',Nsections) - texture_Nfiber = IO_countTagInPart(fileUnit,myPart,'(fiber)', Nsections) - texture_maxNgauss = maxval(texture_Ngauss) - texture_maxNfiber = maxval(texture_Nfiber) - allocate(texture_Gauss (5,texture_maxNgauss,Nsections), source=0.0_pReal) - allocate(texture_Fiber (6,texture_maxNfiber,Nsections), source=0.0_pReal) - allocate(texture_transformation(3,3,Nsections), source=0.0_pReal) - texture_transformation = spread(math_I3,3,Nsections) - - rewind(fileUnit) - line = '' ! to have in initialized - section = 0_pInt ! - " - - gauss = 0_pInt ! - " - - fiber = 0_pInt ! - " - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to - line = IO_read(fileUnit) - enddo - if (echo) write(6,'(/,1x,a)') trim(line) ! echo part header - - do while (trim(line) /= IO_EOF) + t = 0_pInt + do while (trim(line) /= IO_EOF) ! read through sections of material 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 + foundNextPart: if (IO_getTag(line,'<','>') /= '') then + devNull = IO_read(fileUnit, .true.) ! reset IO_read exit - endif - if (echo) write(6,'(2x,a)') trim(line) ! echo back read lines - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - gauss = 0_pInt - fiber = 0_pInt - texture_name(section) = IO_getTag(line,'[',']') - endif - if (section > 0_pInt) then + endif foundNextPart + nextSection: if (IO_getTag(line,'[',']') /= '') then + t = t + 1_pInt + textureConfig = [textureConfig, emptyList] + tag2 = IO_getTag(line,'[',']') + GfortranBug86033: if (.not. allocated(texture_name)) then + allocate(texture_name(1),source=tag2) + else GfortranBug86033 + texture_name = [texture_name,tag2] + endif GfortranBug86033 + endif nextSection + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key + inSection: if (t > 0_pInt) then + chunkPos = IO_stringPos(line) + call textureConfig(t)%add(IO_lc(trim(line)),chunkPos) + else inSection + echo = (trim(tag) == '/echo/') + endif inSection + enddo + + material_Ntexture = size(textureConfig) + if (material_Ntexture < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) + + allocate(texture_ODFfile(material_Ntexture)); texture_ODFfile='' + allocate(texture_symmetry(material_Ntexture), source=1_pInt) + allocate(texture_Ngauss(material_Ntexture), source=0_pInt) + allocate(texture_Nfiber(material_Ntexture), source=0_pInt) + + do t=1_pInt, material_Ntexture + texture_Ngauss(t) = textureConfig(t)%countKeys('(gauss)') & + + textureConfig(t)%countKeys('(random)') + texture_Nfiber(t) = textureConfig(t)%countKeys('(fiber)') + enddo + + texture_maxNgauss = maxval(texture_Ngauss) + texture_maxNfiber = maxval(texture_Nfiber) + allocate(texture_Gauss (5,texture_maxNgauss,material_Ntexture), source=0.0_pReal) + allocate(texture_Fiber (6,texture_maxNfiber,material_Ntexture), source=0.0_pReal) + allocate(texture_transformation(3,3,material_Ntexture), source=0.0_pReal) + texture_transformation = spread(math_I3,3,material_Ntexture) + + do t=1_pInt, material_Ntexture + section = t + gauss = 0_pInt + fiber = 0_pInt + bla = textureConfig(t)%getStringsRaw() + + lines: do i=1_pInt, size(bla) + line = bla(i) + chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key textureType: select case(tag) @@ -1297,12 +1311,12 @@ subroutine material_parseTexture(fileUnit,myPart) texture_Fiber(6,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt) end select enddo - end select textureType - endif + enddo lines enddo -end subroutine material_parseTexture + material_parseTexture = line +end function material_parseTexture !-------------------------------------------------------------------------------------------------- From ad094f81f03f8d712dbd8dd782bb84682e6b3903 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jun 2018 12:50:43 +0200 Subject: [PATCH 31/94] label has changed --- examples/SpectralMethod/Polycrystal/material.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/SpectralMethod/Polycrystal/material.config b/examples/SpectralMethod/Polycrystal/material.config index 978e0f511..5073f165e 100644 --- a/examples/SpectralMethod/Polycrystal/material.config +++ b/examples/SpectralMethod/Polycrystal/material.config @@ -3,7 +3,7 @@ #-------------------# [SX] -type none +mech none #-------------------# From ab4f5413c609d5ad02da22bd89c3f01233c82e3c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jun 2018 14:27:43 +0200 Subject: [PATCH 32/94] line should have the correct return value --- src/material.f90 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 8604e52a0..72599f9cc 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -1157,33 +1157,33 @@ character(len=65536) function material_parseTexture(fileUnit) character(len=256), dimension(:), allocatable :: bla logical :: echo - character(len=65536) :: line, tag,devNull + character(len=65536) :: line, tag,devNull, line2 allocate(textureConfig(0)) t = 0_pInt - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then + do while (trim(line2) /= IO_EOF) ! read through sections of material part + line2 = IO_read(fileUnit) + if (IO_isBlank(line2)) cycle ! skip empty lines + foundNextPart: if (IO_getTag(line2,'<','>') /= '') then devNull = IO_read(fileUnit, .true.) ! reset IO_read exit endif foundNextPart - nextSection: if (IO_getTag(line,'[',']') /= '') then + nextSection: if (IO_getTag(line2,'[',']') /= '') then t = t + 1_pInt textureConfig = [textureConfig, emptyList] - tag2 = IO_getTag(line,'[',']') + tag2 = IO_getTag(line2,'[',']') GfortranBug86033: if (.not. allocated(texture_name)) then allocate(texture_name(1),source=tag2) else GfortranBug86033 texture_name = [texture_name,tag2] endif GfortranBug86033 endif nextSection - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key + chunkPos = IO_stringPos(line2) + tag = IO_lc(IO_stringValue(trim(line2),chunkPos,1_pInt)) ! extract key inSection: if (t > 0_pInt) then - chunkPos = IO_stringPos(line) - call textureConfig(t)%add(IO_lc(trim(line)),chunkPos) + chunkPos = IO_stringPos(line2) + call textureConfig(t)%add(IO_lc(trim(line2)),chunkPos) else inSection echo = (trim(tag) == '/echo/') endif inSection @@ -1315,7 +1315,7 @@ character(len=65536) function material_parseTexture(fileUnit) enddo lines enddo - material_parseTexture = line + material_parseTexture = line2 end function material_parseTexture From 11ab56e5d14091895028221c26b27b0579f78c07 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jun 2018 21:01:58 +0200 Subject: [PATCH 33/94] migrating reading in of material.config to own module --- src/CMakeLists.txt | 4 + src/config_material.f90 | 463 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 467 insertions(+) create mode 100644 src/config_material.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 7b013fe5f..eb5dacd46 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -34,6 +34,10 @@ add_library(CHAINED_LIST OBJECT "list.f90") add_dependencies(CHAINED_LIST IO) list(APPEND OBJECTFILES $) +add_library(CONFIG_MATERIAL OBJECT "config_material.f90") +add_dependencies(CONFIG_MATERIAL IO) +list(APPEND OBJECTFILES $) + add_library(NUMERICS OBJECT "numerics.f90") add_dependencies(NUMERICS IO) list(APPEND OBJECTFILES $) diff --git a/src/config_material.f90 b/src/config_material.f90 new file mode 100644 index 000000000..a988f2496 --- /dev/null +++ b/src/config_material.f90 @@ -0,0 +1,463 @@ +module config_material + use chained_list + use prec, only: & + pReal, & + pInt + implicit none + private + type(tPartitionedStringList), private,protected, allocatable, dimension(:) :: & + phaseConfig, & + microstructureConfig, & + homogenizationConfig, & + textureConfig, & + crystalliteConfig + character(len=64), dimension(:), allocatable, public, protected :: & + phase_name, & !< name of each phase + homogenization_name, & !< name of each homogenization + crystallite_name, & !< name of each crystallite setting + microstructure_name, & !< name of each microstructure + texture_name !< name of each texture + character(len=*), parameter :: & + MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part + MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part + MATERIAL_partPhase = 'phase',& !< keyword for phase part + MATERIAL_partMicrostructure = 'microstructure', & !< keyword for microstructure part + MATERIAL_partTexture = 'texture' !< keyword for texture part + + integer(pInt), public, protected :: & + material_Ntexture, & !< number of textures + material_Nphase, & !< number of phases + material_Nhomogenization, & !< number of homogenizations + material_Nmicrostructure, & !< number of microstructures + material_Ncrystallite !< number of crystallite settings + + +contains + +subroutine config_material_init() +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif + use IO, only: & + IO_error, & + IO_open_file, & + IO_read, & + IO_lc, & + IO_open_jobFile_stat, & + IO_getTag, & + IO_timeStamp, & + IO_EOF + use debug, only: & + debug_level, & + debug_material, & + debug_levelBasic, & + debug_levelExtensive + use mesh, only: & + mesh_maxNips, & + mesh_NcpElems, & + mesh_element, & + FE_Nips, & + FE_geomtype + + implicit none + integer(pInt), parameter :: FILEUNIT = 200_pInt + integer(pInt) :: m,c,h, myDebug, myPhase, myHomog + integer(pInt) :: & + g, & !< grain number + i, & !< integration point number + e, & !< element number + phase + integer(pInt), dimension(:), allocatable :: ConstitutivePosition + integer(pInt), dimension(:), allocatable :: CrystallitePosition + integer(pInt), dimension(:), allocatable :: HomogenizationPosition + + character(len=65536) :: & + line,part + + character(len=*), parameter :: & + MATERIAL_configFile = 'material.config', & !< generic name for material configuration file + MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file + + + myDebug = debug_level(debug_material) + + write(6,'(/,a)') ' <<<+- material init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + + if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... + call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file + + rewind(fileUnit) + line = '' ! to have it initialized + do while (trim(line) /= IO_EOF) + part = IO_lc(IO_getTag(line,'<','>')) + + select case (trim(part)) + + case (trim(material_partPhase)) + line = material_parsePhase(FILEUNIT) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) + + case (trim(material_partMicrostructure)) + line = material_parseMicrostructure(FILEUNIT) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) + + case (trim(material_partCrystallite)) + line = material_parseCrystallite(FILEUNIT) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) + + case (trim(material_partHomogenization)) + line = material_parseHomogenization(FILEUNIT) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) + + case (trim(material_partTexture)) + line = material_parseTexture(FILEUNIT) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) + + case default + line = IO_read(fileUnit) + + end select + + enddo +end subroutine config_material_init + +!-------------------------------------------------------------------------------------------------- +!> @brief parses the homogenization part in the material configuration file +!-------------------------------------------------------------------------------------------------- +character(len=65536) function material_parseHomogenization(fileUnit) + use IO, only: & + IO_read, & + IO_globalTagInPart, & + IO_countSections, & + IO_error, & + IO_countTagInPart, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringValue, & + IO_intValue, & + IO_floatValue, & + IO_stringPos, & + IO_EOF + use mesh, only: & + mesh_element + + implicit none + integer(pInt), intent(in) :: fileUnit + + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: Nsections, h + character(len=65536) :: line, tag,devNull + character(len=64) :: tag2 + logical :: echo + + allocate(homogenizationConfig(0)) + + h = 0_pInt + do while (trim(line) /= IO_EOF) ! read through sections of material part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + foundNextPart: if (IO_getTag(line,'<','>') /= '') then + devNull = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif foundNextPart + nextSection: if (IO_getTag(line,'[',']') /= '') then + h = h + 1_pInt + homogenizationConfig = [homogenizationConfig, emptyList] + tag2 = IO_getTag(line,'[',']') + GfortranBug86033: if (.not. allocated(homogenization_name)) then + allocate(homogenization_name(1),source=tag2) + else GfortranBug86033 + homogenization_name = [homogenization_name,tag2] + endif GfortranBug86033 + endif nextSection + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key + inSection: if (h > 0_pInt) then + chunkPos = IO_stringPos(line) + call homogenizationConfig(h)%add(IO_lc(trim(line)),chunkPos) + else inSection + echo = (trim(tag) == '/echo/') + endif inSection + enddo + + material_Nhomogenization = size(homogenizationConfig) + if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) + material_parseHomogenization=line + +end function material_parseHomogenization + + +!-------------------------------------------------------------------------------------------------- +!> @brief parses the microstructure part in the material configuration file +!-------------------------------------------------------------------------------------------------- +character(len=65536) function material_parseMicrostructure(fileUnit) + use prec, only: & + dNeq + use IO + use mesh, only: & + mesh_element, & + mesh_NcpElems + + implicit none + integer(pInt), intent(in) :: fileUnit + + character(len=256), dimension(:), allocatable :: & + str + character(len=64) :: tag2 + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt), allocatable, dimension(:,:) :: chunkPoss + integer(pInt) :: e, m, constituent, i + character(len=65536) :: & + tag,line,devNull + logical :: echo + + allocate(MicrostructureConfig(0)) + line = '' ! to have it initialized + m = 0_pInt + echo =.false. + + do while (trim(line) /= IO_EOF) ! read through sections of material part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + foundNextPart: if (IO_getTag(line,'<','>') /= '') then + devNull = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif foundNextPart + nextSection: if (IO_getTag(line,'[',']') /= '') then + m = m + 1_pInt + microstructureConfig = [microstructureConfig, emptyList] + tag2 = IO_getTag(line,'[',']') + GfortranBug86033: if (.not. allocated(microstructure_name)) then + allocate(microstructure_name(1),source=tag2) + else GfortranBug86033 + microstructure_name = [microstructure_name,tag2] + endif GfortranBug86033 + endif nextSection + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key + inSection: if (m > 0_pInt) then + chunkPos = IO_stringPos(line) + call microstructureConfig(m)%add(IO_lc(trim(line)),chunkPos) + else inSection + echo = (trim(tag) == '/echo/') + endif inSection + enddo + + material_Nmicrostructure = size(microstructureConfig) + if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure) + material_parseMicrostructure = line +end function material_parseMicrostructure + + +!-------------------------------------------------------------------------------------------------- +!> @brief parses the crystallite part in the material configuration file +!-------------------------------------------------------------------------------------------------- +character(len=65536) function material_parseCrystallite(fileUnit) + use IO, only: & + IO_read, & + IO_error, & + IO_getTag, & + IO_lc, & + IO_stringPos, & + IO_stringValue, & + IO_isBlank, & + IO_EOF + + implicit none + integer(pInt), intent(in) :: fileUnit + integer(pInt), allocatable, dimension(:) :: chunkPos + + character(len=64) :: tag2 + integer(pInt) :: c + character(len=65536) :: line, tag,devNull + logical :: echo + + allocate(crystalliteConfig(0)) + c = 0_pInt + do while (trim(line) /= IO_EOF) ! read through sections of material part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + foundNextPart: if (IO_getTag(line,'<','>') /= '') then + devNull = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif foundNextPart + nextSection: if (IO_getTag(line,'[',']') /= '') then + c = c + 1_pInt + crystalliteConfig = [crystalliteConfig, emptyList] + tag2 = IO_getTag(line,'[',']') + GfortranBug86033: if (.not. allocated(crystallite_name)) then + allocate(crystallite_name(1),source=tag2) + else GfortranBug86033 + crystallite_name = [crystallite_name,tag2] + endif GfortranBug86033 + endif nextSection + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key + inSection: if (c > 0_pInt) then + chunkPos = IO_stringPos(line) + call crystalliteConfig(c)%add(IO_lc(trim(line)),chunkPos) + else inSection + echo = (trim(tag) == '/echo/') + endif inSection + enddo + + material_Ncrystallite = size(crystalliteConfig) + if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite) + material_parseCrystallite = line + +end function material_parseCrystallite + + +!-------------------------------------------------------------------------------------------------- +!> @brief parses the phase part in the material configuration file +!-------------------------------------------------------------------------------------------------- +character(len=65536) function material_parsePhase(fileUnit) + use chained_list, only: & + emptyList + use IO, only: & + IO_read, & + IO_globalTagInPart, & + IO_countSections, & + IO_error, & + IO_countTagInPart, & + IO_getTag, & + IO_spotTagInPart, & + IO_lc, & + IO_isBlank, & + IO_stringValue, & + IO_stringPos, & + IO_EOF + + implicit none + integer(pInt), intent(in) :: fileUnit + + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p + character(len=65536) :: & + tag,line,devNull + character(len=64) :: tag2 + character(len=64), dimension(:), allocatable :: & + str + logical :: echo + + allocate(phaseConfig(0)) + line = '' ! to have it initialized + p = 0_pInt ! - " - + echo =.false. + + do while (trim(line) /= IO_EOF) ! read through sections of material part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + foundNextPart: if (IO_getTag(line,'<','>') /= '') then + devNull = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif foundNextPart + nextSection: if (IO_getTag(line,'[',']') /= '') then + p = p + 1_pInt + phaseConfig = [phaseConfig, emptyList] + tag2 = IO_getTag(line,'[',']') + GfortranBug86033: if (.not. allocated(phase_name)) then + allocate(phase_name(1),source=tag2) + else GfortranBug86033 + phase_name = [phase_name,tag2] + endif GfortranBug86033 + endif nextSection + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key + inSection: if (p > 0_pInt) then + chunkPos = IO_stringPos(line) + call phaseConfig(p)%add(IO_lc(trim(line)),chunkPos) + else inSection + echo = (trim(tag) == '/echo/') + endif inSection + enddo + + material_Nphase = size(phaseConfig) + if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase) + material_parsePhase = line +end function material_parsePhase + +!-------------------------------------------------------------------------------------------------- +!> @brief parses the texture part in the material configuration file +!-------------------------------------------------------------------------------------------------- +character(len=65536) function material_parseTexture(fileUnit) + use prec, only: & + dNeq + use IO, only: & + IO_read, & + IO_globalTagInPart, & + IO_countSections, & + IO_error, & + IO_countTagInPart, & + IO_getTag, & + IO_spotTagInPart, & + IO_lc, & + IO_isBlank, & + IO_floatValue, & + IO_stringValue, & + IO_stringPos, & + IO_EOF + use math, only: & + inRad, & + math_sampleRandomOri, & + math_I3, & + math_det33, & + math_inv33 + + implicit none + integer(pInt), intent(in) :: fileUnit + + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: Nsections, section, gauss, fiber, j, t, i + character(len=64) :: tag2 + character(len=256), dimension(:), allocatable :: bla + logical :: echo + + character(len=65536) :: line, tag,devNull, line2 + + allocate(textureConfig(0)) + + t = 0_pInt + do while (trim(line2) /= IO_EOF) ! read through sections of material part + line2 = IO_read(fileUnit) + if (IO_isBlank(line2)) cycle ! skip empty lines + foundNextPart: if (IO_getTag(line2,'<','>') /= '') then + devNull = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif foundNextPart + nextSection: if (IO_getTag(line2,'[',']') /= '') then + t = t + 1_pInt + textureConfig = [textureConfig, emptyList] + tag2 = IO_getTag(line2,'[',']') + GfortranBug86033: if (.not. allocated(texture_name)) then + allocate(texture_name(1),source=tag2) + else GfortranBug86033 + texture_name = [texture_name,tag2] + endif GfortranBug86033 + endif nextSection + chunkPos = IO_stringPos(line2) + tag = IO_lc(IO_stringValue(trim(line2),chunkPos,1_pInt)) ! extract key + inSection: if (t > 0_pInt) then + chunkPos = IO_stringPos(line2) + call textureConfig(t)%add(IO_lc(trim(line2)),chunkPos) + else inSection + echo = (trim(tag) == '/echo/') + endif inSection + enddo + + material_Ntexture = size(textureConfig) + if (material_Ntexture < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) + + material_parseTexture = line2 +end function material_parseTexture + + +end module config_material From cb0cb29393f3acfc04f49a305b363ae597f8a7e2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Jun 2018 13:48:37 +0200 Subject: [PATCH 34/94] reading in done by one function --- src/config_material.f90 | 321 ++++------------------------------------ 1 file changed, 29 insertions(+), 292 deletions(-) diff --git a/src/config_material.f90 b/src/config_material.f90 index a988f2496..cca6acfa4 100644 --- a/src/config_material.f90 +++ b/src/config_material.f90 @@ -80,7 +80,6 @@ subroutine config_material_init() MATERIAL_configFile = 'material.config', & !< generic name for material configuration file MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file - myDebug = debug_level(debug_material) write(6,'(/,a)') ' <<<+- material init -+>>>' @@ -98,23 +97,23 @@ subroutine config_material_init() select case (trim(part)) case (trim(material_partPhase)) - line = material_parsePhase(FILEUNIT) + call parseFile(phase_name,phaseConfig,FILEUNIT,line) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) case (trim(material_partMicrostructure)) - line = material_parseMicrostructure(FILEUNIT) + call parseFile(microstructure_name,microstructureConfig,FILEUNIT,line) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) case (trim(material_partCrystallite)) - line = material_parseCrystallite(FILEUNIT) + call parseFile(crystallite_name,crystalliteConfig,FILEUNIT,line) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) case (trim(material_partHomogenization)) - line = material_parseHomogenization(FILEUNIT) + call parseFile(homogenization_name,homogenizationConfig,FILEUNIT,line) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) case (trim(material_partTexture)) - line = material_parseTexture(FILEUNIT) + call parseFile(texture_name,textureConfig,FILEUNIT,line) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) case default @@ -123,28 +122,34 @@ subroutine config_material_init() end select enddo + + material_Nhomogenization = size(homogenizationConfig) + if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) + material_Nmicrostructure = size(microstructureConfig) + if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure) + material_Ncrystallite = size(crystalliteConfig) + if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite) + material_Nphase = size(phaseConfig) + if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase) + material_Ntexture = size(textureConfig) + if (material_Ntexture < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) + + end subroutine config_material_init !-------------------------------------------------------------------------------------------------- !> @brief parses the homogenization part in the material configuration file !-------------------------------------------------------------------------------------------------- -character(len=65536) function material_parseHomogenization(fileUnit) +subroutine parseFile(partLabel,part,fileUnit,nextLine) use IO, only: & IO_read, & - IO_globalTagInPart, & - IO_countSections, & IO_error, & - IO_countTagInPart, & IO_lc, & IO_getTag, & IO_isBlank, & IO_stringValue, & - IO_intValue, & - IO_floatValue, & IO_stringPos, & IO_EOF - use mesh, only: & - mesh_element implicit none integer(pInt), intent(in) :: fileUnit @@ -153,10 +158,14 @@ character(len=65536) function material_parseHomogenization(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: Nsections, h character(len=65536) :: line, tag,devNull + character(len=65536) :: nextLine character(len=64) :: tag2 logical :: echo + type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: & + part + character(len=*), dimension(:), allocatable, intent(inout) :: partLabel - allocate(homogenizationConfig(0)) + allocate(part(0)) h = 0_pInt do while (trim(line) /= IO_EOF) ! read through sections of material part @@ -168,12 +177,12 @@ character(len=65536) function material_parseHomogenization(fileUnit) endif foundNextPart nextSection: if (IO_getTag(line,'[',']') /= '') then h = h + 1_pInt - homogenizationConfig = [homogenizationConfig, emptyList] + part = [part, emptyList] tag2 = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(homogenization_name)) then - allocate(homogenization_name(1),source=tag2) + GfortranBug86033: if (.not. allocated(partLabel)) then + allocate(partLabel(1),source=tag2) else GfortranBug86033 - homogenization_name = [homogenization_name,tag2] + partLabel = [partLabel,tag2] endif GfortranBug86033 endif nextSection chunkPos = IO_stringPos(line) @@ -186,278 +195,6 @@ character(len=65536) function material_parseHomogenization(fileUnit) endif inSection enddo - material_Nhomogenization = size(homogenizationConfig) - if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) - material_parseHomogenization=line - -end function material_parseHomogenization - - -!-------------------------------------------------------------------------------------------------- -!> @brief parses the microstructure part in the material configuration file -!-------------------------------------------------------------------------------------------------- -character(len=65536) function material_parseMicrostructure(fileUnit) - use prec, only: & - dNeq - use IO - use mesh, only: & - mesh_element, & - mesh_NcpElems - - implicit none - integer(pInt), intent(in) :: fileUnit - - character(len=256), dimension(:), allocatable :: & - str - character(len=64) :: tag2 - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt), allocatable, dimension(:,:) :: chunkPoss - integer(pInt) :: e, m, constituent, i - character(len=65536) :: & - tag,line,devNull - logical :: echo - - allocate(MicrostructureConfig(0)) - line = '' ! to have it initialized - m = 0_pInt - echo =.false. - - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - nextSection: if (IO_getTag(line,'[',']') /= '') then - m = m + 1_pInt - microstructureConfig = [microstructureConfig, emptyList] - tag2 = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(microstructure_name)) then - allocate(microstructure_name(1),source=tag2) - else GfortranBug86033 - microstructure_name = [microstructure_name,tag2] - endif GfortranBug86033 - endif nextSection - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key - inSection: if (m > 0_pInt) then - chunkPos = IO_stringPos(line) - call microstructureConfig(m)%add(IO_lc(trim(line)),chunkPos) - else inSection - echo = (trim(tag) == '/echo/') - endif inSection - enddo - - material_Nmicrostructure = size(microstructureConfig) - if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure) - material_parseMicrostructure = line -end function material_parseMicrostructure - - -!-------------------------------------------------------------------------------------------------- -!> @brief parses the crystallite part in the material configuration file -!-------------------------------------------------------------------------------------------------- -character(len=65536) function material_parseCrystallite(fileUnit) - use IO, only: & - IO_read, & - IO_error, & - IO_getTag, & - IO_lc, & - IO_stringPos, & - IO_stringValue, & - IO_isBlank, & - IO_EOF - - implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - - character(len=64) :: tag2 - integer(pInt) :: c - character(len=65536) :: line, tag,devNull - logical :: echo - - allocate(crystalliteConfig(0)) - c = 0_pInt - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - nextSection: if (IO_getTag(line,'[',']') /= '') then - c = c + 1_pInt - crystalliteConfig = [crystalliteConfig, emptyList] - tag2 = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(crystallite_name)) then - allocate(crystallite_name(1),source=tag2) - else GfortranBug86033 - crystallite_name = [crystallite_name,tag2] - endif GfortranBug86033 - endif nextSection - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key - inSection: if (c > 0_pInt) then - chunkPos = IO_stringPos(line) - call crystalliteConfig(c)%add(IO_lc(trim(line)),chunkPos) - else inSection - echo = (trim(tag) == '/echo/') - endif inSection - enddo - - material_Ncrystallite = size(crystalliteConfig) - if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite) - material_parseCrystallite = line - -end function material_parseCrystallite - - -!-------------------------------------------------------------------------------------------------- -!> @brief parses the phase part in the material configuration file -!-------------------------------------------------------------------------------------------------- -character(len=65536) function material_parsePhase(fileUnit) - use chained_list, only: & - emptyList - use IO, only: & - IO_read, & - IO_globalTagInPart, & - IO_countSections, & - IO_error, & - IO_countTagInPart, & - IO_getTag, & - IO_spotTagInPart, & - IO_lc, & - IO_isBlank, & - IO_stringValue, & - IO_stringPos, & - IO_EOF - - implicit none - integer(pInt), intent(in) :: fileUnit - - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p - character(len=65536) :: & - tag,line,devNull - character(len=64) :: tag2 - character(len=64), dimension(:), allocatable :: & - str - logical :: echo - - allocate(phaseConfig(0)) - line = '' ! to have it initialized - p = 0_pInt ! - " - - echo =.false. - - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - nextSection: if (IO_getTag(line,'[',']') /= '') then - p = p + 1_pInt - phaseConfig = [phaseConfig, emptyList] - tag2 = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(phase_name)) then - allocate(phase_name(1),source=tag2) - else GfortranBug86033 - phase_name = [phase_name,tag2] - endif GfortranBug86033 - endif nextSection - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key - inSection: if (p > 0_pInt) then - chunkPos = IO_stringPos(line) - call phaseConfig(p)%add(IO_lc(trim(line)),chunkPos) - else inSection - echo = (trim(tag) == '/echo/') - endif inSection - enddo - - material_Nphase = size(phaseConfig) - if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase) - material_parsePhase = line -end function material_parsePhase - -!-------------------------------------------------------------------------------------------------- -!> @brief parses the texture part in the material configuration file -!-------------------------------------------------------------------------------------------------- -character(len=65536) function material_parseTexture(fileUnit) - use prec, only: & - dNeq - use IO, only: & - IO_read, & - IO_globalTagInPart, & - IO_countSections, & - IO_error, & - IO_countTagInPart, & - IO_getTag, & - IO_spotTagInPart, & - IO_lc, & - IO_isBlank, & - IO_floatValue, & - IO_stringValue, & - IO_stringPos, & - IO_EOF - use math, only: & - inRad, & - math_sampleRandomOri, & - math_I3, & - math_det33, & - math_inv33 - - implicit none - integer(pInt), intent(in) :: fileUnit - - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, section, gauss, fiber, j, t, i - character(len=64) :: tag2 - character(len=256), dimension(:), allocatable :: bla - logical :: echo - - character(len=65536) :: line, tag,devNull, line2 - - allocate(textureConfig(0)) - - t = 0_pInt - do while (trim(line2) /= IO_EOF) ! read through sections of material part - line2 = IO_read(fileUnit) - if (IO_isBlank(line2)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line2,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - nextSection: if (IO_getTag(line2,'[',']') /= '') then - t = t + 1_pInt - textureConfig = [textureConfig, emptyList] - tag2 = IO_getTag(line2,'[',']') - GfortranBug86033: if (.not. allocated(texture_name)) then - allocate(texture_name(1),source=tag2) - else GfortranBug86033 - texture_name = [texture_name,tag2] - endif GfortranBug86033 - endif nextSection - chunkPos = IO_stringPos(line2) - tag = IO_lc(IO_stringValue(trim(line2),chunkPos,1_pInt)) ! extract key - inSection: if (t > 0_pInt) then - chunkPos = IO_stringPos(line2) - call textureConfig(t)%add(IO_lc(trim(line2)),chunkPos) - else inSection - echo = (trim(tag) == '/echo/') - endif inSection - enddo - - material_Ntexture = size(textureConfig) - if (material_Ntexture < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) - - material_parseTexture = line2 -end function material_parseTexture - +end subroutine parseFile end module config_material From 73e915c35a9aa694371a834159fcf7e31fb4f621 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Jun 2018 07:05:25 +0200 Subject: [PATCH 35/94] wrong dependencies cause failure during compilation --- src/CMakeLists.txt | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index eb5dacd46..cc29ca84f 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -15,7 +15,6 @@ add_dependencies(SYSTEM_ROUTINES C_ROUTINES) list(APPEND OBJECTFILES $) add_library(PREC OBJECT "prec.f90") -add_dependencies(PREC SYSTEM_ROUTINES) list(APPEND OBJECTFILES $) if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral") @@ -23,21 +22,13 @@ if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral") elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM") add_library(DAMASK_INTERFACE OBJECT "FEM_interface.f90") endif() -add_dependencies(DAMASK_INTERFACE PREC) +add_dependencies(DAMASK_INTERFACE PREC SYSTEM_ROUTINES) list(APPEND OBJECTFILES $) 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(CONFIG_MATERIAL OBJECT "config_material.f90") -add_dependencies(CONFIG_MATERIAL IO) -list(APPEND OBJECTFILES $) - add_library(NUMERICS OBJECT "numerics.f90") add_dependencies(NUMERICS IO) list(APPEND OBJECTFILES $) @@ -46,6 +37,14 @@ add_library(DEBUG OBJECT "debug.f90") add_dependencies(DEBUG NUMERICS) list(APPEND OBJECTFILES $) +add_library(CHAINED_LIST OBJECT "list.f90") +add_dependencies(CHAINED_LIST DEBUG) +list(APPEND OBJECTFILES $) + +add_library(CONFIG_MATERIAL OBJECT "config_material.f90") +add_dependencies(CONFIG_MATERIAL DEBUG) +list(APPEND OBJECTFILES $) + add_library(FEsolving OBJECT "FEsolving.f90") add_dependencies(FEsolving DEBUG) list(APPEND OBJECTFILES $) From 08a4da01e05d50e499a844ba2859a674d5cb3a10 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Jun 2018 11:03:34 +0200 Subject: [PATCH 36/94] IO_stringPos failed when parsing trimmed string --- src/IO.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/IO.f90 b/src/IO.f90 index d1b039c1e..27d2f4ae2 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -982,6 +982,10 @@ pure function IO_stringPos(string) if ( string(left:left) == '#' ) exit IO_stringPos = [IO_stringPos,int(left, pInt), int(right, pInt)] IO_stringPos(1) = IO_stringPos(1)+1_pInt + endOfString: if (right < left) then + IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string) + exit + endif endOfString enddo end function IO_stringPos From f8ae0ec92554a17906ebd5d88c05796dbdcdf7c1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Jun 2018 11:07:17 +0200 Subject: [PATCH 37/94] list does tokenizing automatically --- src/config_material.f90 | 9 ++++++++- src/list.f90 | 25 ++++++++++++++++--------- src/material.f90 | 15 ++++++++------- src/math.f90 | 1 - 4 files changed, 32 insertions(+), 18 deletions(-) diff --git a/src/config_material.f90 b/src/config_material.f90 index cca6acfa4..6bb8d81d8 100644 --- a/src/config_material.f90 +++ b/src/config_material.f90 @@ -1,3 +1,10 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Reads in the material configuration from file +!> @details Reads the material configuration file, where solverJobName.materialConfig takes +!! precedence over material.config. Stores the raw strings and the positions of delimiters for the +!! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture' +!-------------------------------------------------------------------------------------------------- module config_material use chained_list use prec, only: & @@ -189,7 +196,7 @@ subroutine parseFile(partLabel,part,fileUnit,nextLine) tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key inSection: if (h > 0_pInt) then chunkPos = IO_stringPos(line) - call homogenizationConfig(h)%add(IO_lc(trim(line)),chunkPos) + call part(h)%add(IO_lc(trim(line))) else inSection echo = (trim(tag) == '/echo/') endif inSection diff --git a/src/list.f90 b/src/list.f90 index e9e27b6d4..86c24eb86 100644 --- a/src/list.f90 +++ b/src/list.f90 @@ -42,18 +42,24 @@ contains !> @brief add element !> @details adds raw string and start/end position of chunks in this string !-------------------------------------------------------------------------------------------------- -subroutine add(this,string,stringPos) +subroutine add(this,string) + use IO, only: & + IO_isBlank, & + IO_lc, & + IO_stringPos + implicit none - class(tPartitionedStringList) :: this - type(tPartitionedStringList), pointer :: & - new, & - tmp - character(len=*), intent(in) :: string - integer(pInt), dimension(:), intent(in) :: stringPos + class(tPartitionedStringList) :: this + character(len=*), intent(in) :: string + + integer(pInt), allocatable,dimension(:) :: p + type(tPartitionedStringList), pointer :: new, tmp + + if (IO_isBlank(string)) return allocate(new) - new%string%val=string - new%string%pos=stringPos + new%string%val=trim(string) + new%string%pos=IO_stringPos(trim(string)) if (.not. associated(this%next)) then this%next => new @@ -61,6 +67,7 @@ subroutine add(this,string,stringPos) tmp => this%next this%next => new this%next%next => tmp + !new%prev => this%prev%next end if end subroutine add diff --git a/src/material.f90 b/src/material.f90 index 72599f9cc..dc70304fa 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -622,12 +622,13 @@ character(len=65536) function material_parseHomogenization(fileUnit) chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key inSection: if (h > 0_pInt) then - chunkPos = IO_stringPos(line) - call homogenizationConfig(h)%add(IO_lc(trim(line)),chunkPos) + call homogenizationConfig(h)%add(line) else inSection echo = (trim(tag) == '/echo/') endif inSection enddo + + if (echo) call homogenizationConfig(1)%show() material_Nhomogenization = size(homogenizationConfig) if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) @@ -814,7 +815,7 @@ character(len=65536) function material_parseMicrostructure(fileUnit) tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key inSection: if (m > 0_pInt) then chunkPos = IO_stringPos(line) - call microstructureConfig(m)%add(IO_lc(trim(line)),chunkPos) + call microstructureConfig(m)%add(IO_lc(line)) else inSection echo = (trim(tag) == '/echo/') endif inSection @@ -919,8 +920,8 @@ character(len=65536) function material_parseCrystallite(fileUnit) chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key inSection: if (c > 0_pInt) then - chunkPos = IO_stringPos(line) - call crystalliteConfig(c)%add(IO_lc(trim(line)),chunkPos) + chunkPos = IO_stringPos(trim(line)) + call crystalliteConfig(c)%add(IO_lc(line)) else inSection echo = (trim(tag) == '/echo/') endif inSection @@ -997,7 +998,7 @@ character(len=65536) function material_parsePhase(fileUnit) tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key inSection: if (p > 0_pInt) then chunkPos = IO_stringPos(line) - call phaseConfig(p)%add(IO_lc(trim(line)),chunkPos) + call phaseConfig(p)%add(IO_lc(trim(line))) else inSection echo = (trim(tag) == '/echo/') endif inSection @@ -1183,7 +1184,7 @@ character(len=65536) function material_parseTexture(fileUnit) tag = IO_lc(IO_stringValue(trim(line2),chunkPos,1_pInt)) ! extract key inSection: if (t > 0_pInt) then chunkPos = IO_stringPos(line2) - call textureConfig(t)%add(IO_lc(trim(line2)),chunkPos) + call textureConfig(t)%add(IO_lc(trim(line2))) else inSection echo = (trim(tag) == '/echo/') endif inSection diff --git a/src/math.f90 b/src/math.f90 index 8f228582b..c874e422d 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -223,7 +223,6 @@ end subroutine math_init !> @brief check correctness of (some) math functions !-------------------------------------------------------------------------------------------------- subroutine math_check - use prec, only: tol_math_check use IO, only: IO_error From 91d9c11612e25c04fe588ba5ee53fd486f4eb097 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Jun 2018 18:01:52 +0200 Subject: [PATCH 38/94] material.config is read in centrally moving data from material to config_material. use statements need to change. All aspects of reading from file will be removed from the individual modules --- src/CMakeLists.txt | 4 +- src/CPFEM.f90 | 6 +- src/CPFEM2.f90 | 6 +- src/config_material.f90 | 54 +++-- src/constitutive.f90 | 7 +- src/crystallite.f90 | 4 +- src/damage_local.f90 | 3 +- src/damage_none.f90 | 1 + src/damage_nonlocal.f90 | 3 +- src/homogenization.f90 | 1 + src/homogenization_RGC.f90 | 1 + src/homogenization_isostrain.f90 | 1 + src/homogenization_none.f90 | 1 + src/hydrogenflux_cahnhilliard.f90 | 3 +- src/hydrogenflux_isoconc.f90 | 1 + src/kinematics_cleavage_opening.f90 | 3 +- src/kinematics_hydrogen_strain.f90 | 3 +- src/kinematics_slipplane_opening.f90 | 3 +- src/kinematics_thermal_expansion.f90 | 3 +- src/kinematics_vacancy_strain.f90 | 3 +- src/lattice.f90 | 2 +- src/list.f90 | 17 +- src/material.f90 | 264 ++----------------------- src/plastic_disloUCLA.f90 | 5 +- src/plastic_dislotwin.f90 | 3 +- src/plastic_isotropic.f90 | 3 +- src/plastic_kinematichardening.f90 | 3 +- src/plastic_nonlocal.f90 | 2 +- src/plastic_phenopowerlaw.f90 | 3 +- src/porosity_none.f90 | 1 + src/porosity_phasefield.f90 | 11 +- src/source_damage_anisoBrittle.f90 | 5 +- src/source_damage_anisoDuctile.f90 | 5 +- src/source_damage_isoBrittle.f90 | 5 +- src/source_damage_isoDuctile.f90 | 6 +- src/source_thermal_dissipation.f90 | 5 +- src/source_thermal_externalheat.f90 | 5 +- src/source_vacancy_irradiation.f90 | 5 +- src/source_vacancy_phenoplasticity.f90 | 5 +- src/source_vacancy_thermalfluc.f90 | 5 +- src/thermal_adiabatic.f90 | 5 +- src/thermal_conduction.f90 | 3 +- src/thermal_isothermal.f90 | 1 + src/vacancyflux_cahnhilliard.f90 | 7 +- src/vacancyflux_isochempot.f90 | 3 +- src/vacancyflux_isoconc.f90 | 1 + 46 files changed, 146 insertions(+), 345 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index cc29ca84f..cb39ad363 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -42,7 +42,7 @@ add_dependencies(CHAINED_LIST DEBUG) list(APPEND OBJECTFILES $) add_library(CONFIG_MATERIAL OBJECT "config_material.f90") -add_dependencies(CONFIG_MATERIAL DEBUG) +add_dependencies(CONFIG_MATERIAL CHAINED_LIST) list(APPEND OBJECTFILES $) add_library(FEsolving OBJECT "FEsolving.f90") @@ -68,7 +68,7 @@ elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM") endif() add_library(MATERIAL OBJECT "material.f90") -add_dependencies(MATERIAL MESH CHAINED_LIST) +add_dependencies(MATERIAL MESH CONFIG_MATERIAL) list(APPEND OBJECTFILES $) add_library(DAMASK_HELPERS OBJECT "lattice.f90") diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index 44146c90e..b613c73d3 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -143,7 +143,8 @@ subroutine CPFEM_init material_phase, & homogState, & phase_plasticity, & - plasticState, & + plasticState + use config_material, only: & material_Nhomogenization use crystallite, only: & crystallite_F0, & @@ -310,7 +311,8 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt thermal_type, & THERMAL_conduction_ID, & phase_Nsources, & - material_homog, & + material_homog + use config_material, only: & material_Nhomogenization use crystallite, only: & crystallite_partionedF,& diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 09a98aaec..cd28e3420 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -108,7 +108,8 @@ subroutine CPFEM_init material_phase, & homogState, & phase_plasticity, & - plasticState, & + plasticState + use config_material, only: & material_Nhomogenization use crystallite, only: & crystallite_F0, & @@ -228,7 +229,8 @@ subroutine CPFEM_age() hydrogenfluxState, & material_phase, & phase_plasticity, & - phase_Nsources, & + phase_Nsources + use config_material, only: & material_Nhomogenization use crystallite, only: & crystallite_partionedF,& diff --git a/src/config_material.f90 b/src/config_material.f90 index 6bb8d81d8..61f41b2a5 100644 --- a/src/config_material.f90 +++ b/src/config_material.f90 @@ -11,8 +11,8 @@ module config_material pReal, & pInt implicit none - private - type(tPartitionedStringList), private,protected, allocatable, dimension(:) :: & + !private + type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & phaseConfig, & microstructureConfig, & homogenizationConfig, & @@ -24,7 +24,7 @@ module config_material crystallite_name, & !< name of each crystallite setting microstructure_name, & !< name of each microstructure texture_name !< name of each texture - character(len=*), parameter :: & + character(len=*), parameter, public :: & MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part MATERIAL_partPhase = 'phase',& !< keyword for phase part @@ -38,6 +38,9 @@ module config_material material_Nmicrostructure, & !< number of microstructures material_Ncrystallite !< number of crystallite settings + character(len=*), parameter, public :: & + MATERIAL_configFile = 'material.config', & !< generic name for material configuration file + MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file contains @@ -59,14 +62,7 @@ subroutine config_material_init() use debug, only: & debug_level, & debug_material, & - debug_levelBasic, & - debug_levelExtensive - use mesh, only: & - mesh_maxNips, & - mesh_NcpElems, & - mesh_element, & - FE_Nips, & - FE_geomtype + debug_levelBasic implicit none integer(pInt), parameter :: FILEUNIT = 200_pInt @@ -83,9 +79,6 @@ subroutine config_material_init() character(len=65536) :: & line,part - character(len=*), parameter :: & - MATERIAL_configFile = 'material.config', & !< generic name for material configuration file - MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file myDebug = debug_level(debug_material) @@ -147,7 +140,7 @@ end subroutine config_material_init !-------------------------------------------------------------------------------------------------- !> @brief parses the homogenization part in the material configuration file !-------------------------------------------------------------------------------------------------- -subroutine parseFile(partLabel,part,fileUnit,nextLine) +subroutine parseFile(sectionNames,part,fileUnit,line) use IO, only: & IO_read, & IO_error, & @@ -160,21 +153,19 @@ subroutine parseFile(partLabel,part,fileUnit,nextLine) implicit none integer(pInt), intent(in) :: fileUnit - + character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames + type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part + character(len=65536),intent(out) :: line integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, h - character(len=65536) :: line, tag,devNull - character(len=65536) :: nextLine - character(len=64) :: tag2 + integer(pInt) :: Nsections, s + character(len=65536) :: devNull + character(len=64) :: tag logical :: echo - type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: & - part - character(len=*), dimension(:), allocatable, intent(inout) :: partLabel allocate(part(0)) - h = 0_pInt + s = 0_pInt do while (trim(line) /= IO_EOF) ! read through sections of material part line = IO_read(fileUnit) if (IO_isBlank(line)) cycle ! skip empty lines @@ -183,20 +174,19 @@ subroutine parseFile(partLabel,part,fileUnit,nextLine) exit endif foundNextPart nextSection: if (IO_getTag(line,'[',']') /= '') then - h = h + 1_pInt + s = s + 1_pInt part = [part, emptyList] - tag2 = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(partLabel)) then - allocate(partLabel(1),source=tag2) + tag = IO_getTag(line,'[',']') + GfortranBug86033: if (.not. allocated(sectionNames)) then + allocate(sectionNames(1),source=tag) else GfortranBug86033 - partLabel = [partLabel,tag2] + sectionNames = [sectionNames,tag] endif GfortranBug86033 endif nextSection chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key - inSection: if (h > 0_pInt) then - chunkPos = IO_stringPos(line) - call part(h)%add(IO_lc(trim(line))) + inSection: if (s > 0_pInt) then + call part(s)%add(IO_lc(trim(line))) else inSection echo = (trim(tag) == '/echo/') endif inSection diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 75906c380..400670ce6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -59,12 +59,13 @@ subroutine constitutive_init() IO_timeStamp use mesh, only: & FE_geomtype - use material, only: & - material_phase, & + use config_material, only: & material_Nphase, & material_localFileExt, & - material_configFile, & phase_name, & + material_configFile + use material, only: & + material_phase, & phase_plasticity, & phase_plasticityInstance, & phase_Nsources, & diff --git a/src/crystallite.f90 b/src/crystallite.f90 index dd166fe4c..6b348a142 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -171,6 +171,7 @@ subroutine crystallite_init IO_write_jobFile, & IO_error use material + use config_material use constitutive, only: & constitutive_initialFi, & constitutive_microstructure ! derived (shortcut) quantities of given state @@ -1236,8 +1237,9 @@ subroutine crystallite_integrateStateRK4() plasticState, & sourceState, & phase_Nsources, & - material_Nphase, & phaseAt, phasememberAt + use config_material, only: & + material_Nphase use constitutive, only: & constitutive_collectDotState, & constitutive_microstructure diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 59956e7d1..f95a2956f 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -70,7 +70,8 @@ subroutine damage_local_init(fileUnit) damageState, & damageMapping, & damage, & - damage_initialPhi, & + damage_initialPhi + use config_material, only: & material_partHomogenization implicit none diff --git a/src/damage_none.f90 b/src/damage_none.f90 index a1f0f0cd5..a3a1adde5 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -26,6 +26,7 @@ subroutine damage_none_init() use IO, only: & IO_timeStamp use material + use config_material implicit none integer(pInt) :: & diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 92ad183e1..6c556bb25 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -75,7 +75,8 @@ subroutine damage_nonlocal_init(fileUnit) damageState, & damageMapping, & damage, & - damage_initialPhi, & + damage_initialPhi + use config_material, only: & material_partHomogenization implicit none diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 14ffdcdd6..6539b19a9 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -101,6 +101,7 @@ subroutine homogenization_init crystallite_maxSizePostResults #endif use material + use config_material use homogenization_none use homogenization_isostrain use homogenization_RGC diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 95dab049f..c48866dfe 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -100,6 +100,7 @@ subroutine homogenization_RGC_init(fileUnit) FE_geomtype use IO use material + use config_material implicit none integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index b569e3737..4c80059eb 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -62,6 +62,7 @@ subroutine homogenization_isostrain_init(fileUnit) debug_levelBasic use IO use material + use config_material implicit none integer(pInt), intent(in) :: fileUnit diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index b2d2f52a7..90d2ab6c4 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -29,6 +29,7 @@ subroutine homogenization_none_init() use IO, only: & IO_timeStamp use material + use config_material implicit none integer(pInt) :: & diff --git a/src/hydrogenflux_cahnhilliard.f90 b/src/hydrogenflux_cahnhilliard.f90 index 569be97dc..95898c86d 100644 --- a/src/hydrogenflux_cahnhilliard.f90 +++ b/src/hydrogenflux_cahnhilliard.f90 @@ -81,7 +81,8 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) hydrogenfluxMapping, & hydrogenConc, & hydrogenConcRate, & - hydrogenflux_initialCh, & + hydrogenflux_initialCh + use config_material, only: & material_partHomogenization, & material_partPhase diff --git a/src/hydrogenflux_isoconc.f90 b/src/hydrogenflux_isoconc.f90 index d1b13aa76..74505fad8 100644 --- a/src/hydrogenflux_isoconc.f90 +++ b/src/hydrogenflux_isoconc.f90 @@ -27,6 +27,7 @@ subroutine hydrogenflux_isoconc_init() use IO, only: & IO_timeStamp use material + use config_material implicit none integer(pInt) :: & diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 74af0a52d..64641f150 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -78,7 +78,8 @@ subroutine kinematics_cleavage_opening_init(fileUnit) phase_Nkinematics, & phase_Noutput, & KINEMATICS_cleavage_opening_label, & - KINEMATICS_cleavage_opening_ID, & + KINEMATICS_cleavage_opening_ID + use config_material, only: & material_Nphase, & MATERIAL_partPhase use lattice, only: & diff --git a/src/kinematics_hydrogen_strain.f90 b/src/kinematics_hydrogen_strain.f90 index f3ea4df38..d0c282627 100644 --- a/src/kinematics_hydrogen_strain.f90 +++ b/src/kinematics_hydrogen_strain.f90 @@ -68,7 +68,8 @@ subroutine kinematics_hydrogen_strain_init(fileUnit) phase_Nkinematics, & phase_Noutput, & KINEMATICS_hydrogen_strain_label, & - KINEMATICS_hydrogen_strain_ID, & + KINEMATICS_hydrogen_strain_ID + use config_material, only: & material_Nphase, & MATERIAL_partPhase diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index ba38ac05b..9f20d8594 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -78,7 +78,8 @@ subroutine kinematics_slipplane_opening_init(fileUnit) phase_Nkinematics, & phase_Noutput, & KINEMATICS_slipplane_opening_label, & - KINEMATICS_slipplane_opening_ID, & + KINEMATICS_slipplane_opening_ID + use config_material, only: & material_Nphase, & MATERIAL_partPhase use lattice, only: & diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 0de483d70..bc70d57b2 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -68,7 +68,8 @@ subroutine kinematics_thermal_expansion_init(fileUnit) phase_Nkinematics, & phase_Noutput, & KINEMATICS_thermal_expansion_label, & - KINEMATICS_thermal_expansion_ID, & + KINEMATICS_thermal_expansion_ID + use config_material, only: & material_Nphase, & MATERIAL_partPhase diff --git a/src/kinematics_vacancy_strain.f90 b/src/kinematics_vacancy_strain.f90 index 227a86e0c..7ee8312dc 100644 --- a/src/kinematics_vacancy_strain.f90 +++ b/src/kinematics_vacancy_strain.f90 @@ -68,7 +68,8 @@ subroutine kinematics_vacancy_strain_init(fileUnit) phase_Nkinematics, & phase_Noutput, & KINEMATICS_vacancy_strain_label, & - KINEMATICS_vacancy_strain_ID, & + KINEMATICS_vacancy_strain_ID + use config_material, only: & material_Nphase, & MATERIAL_partPhase diff --git a/src/lattice.f90 b/src/lattice.f90 index 37393b82e..374057381 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1263,7 +1263,7 @@ subroutine lattice_init IO_stringPos, & IO_stringValue, & IO_floatValue - use material, only: & + use config_material, only: & material_configfile, & material_localFileExt, & material_partPhase diff --git a/src/list.f90 b/src/list.f90 index 86c24eb86..9bb93a81b 100644 --- a/src/list.f90 +++ b/src/list.f90 @@ -49,7 +49,7 @@ subroutine add(this,string) IO_stringPos implicit none - class(tPartitionedStringList) :: this + class(tPartitionedStringList), target :: this character(len=*), intent(in) :: string integer(pInt), allocatable,dimension(:) :: p @@ -61,14 +61,11 @@ subroutine add(this,string) new%string%val=trim(string) new%string%pos=IO_stringPos(trim(string)) - if (.not. associated(this%next)) then - this%next => new - else - tmp => this%next - this%next => new - this%next%next => tmp - !new%prev => this%prev%next - end if + tmp => this + do while (associated(tmp%next)) + tmp => tmp%next + enddo + tmp%next => new end subroutine add @@ -85,7 +82,7 @@ subroutine show(this) tmp => this%next do if (.not. associated(tmp)) exit - write(6,*) trim(tmp%string%val) + write(6,'(a)') trim(tmp%string%val) tmp => tmp%next end do diff --git a/src/material.f90 b/src/material.f90 index dc70304fa..f7a4b29ef 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -7,6 +7,7 @@ !! 'phase', 'texture', and 'microstucture' !-------------------------------------------------------------------------------------------------- module material + use config_material use chained_list use prec, only: & pReal, & @@ -142,15 +143,6 @@ module material HOMOGENIZATION_rgc_ID end enum - character(len=*), parameter, public :: & - MATERIAL_configFile = 'material.config', & !< generic name for material configuration file - MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file - - character(len=*), parameter, public :: & - MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part - MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part - MATERIAL_partPhase = 'phase' !< keyword for phase part - integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: & phase_elasticity !< elasticity of each phase integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: & @@ -174,17 +166,8 @@ module material integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: & homogenization_type !< type of each homogenization - character(len=64), dimension(:), allocatable, public, protected :: & - phase_name, & !< name of each phase - homogenization_name, & !< name of each homogenization - crystallite_name !< name of each crystallite setting - integer(pInt), public, protected :: & - homogenization_maxNgrains, & !< max number of grains in any USED homogenization - material_Nphase, & !< number of phases - material_Nhomogenization, & !< number of homogenizations - material_Nmicrostructure, & !< number of microstructures - material_Ncrystallite !< number of crystallite settings + homogenization_maxNgrains !< max number of grains in any USED homogenization integer(pInt), dimension(:), allocatable, public, protected :: & phase_Nsources, & !< number of source mechanisms active in each phase @@ -243,19 +226,10 @@ module material phase_localPlasticity !< flags phases with local constitutive law - character(len=*), parameter, private :: & - MATERIAL_partMicrostructure = 'microstructure', & !< keyword for microstructure part - MATERIAL_partTexture = 'texture' !< keyword for texture part - - character(len=64), dimension(:), allocatable, private :: & - microstructure_name, & !< name of each microstructure - texture_name !< name of each texture - character(len=256), dimension(:), allocatable, private :: & texture_ODFfile !< name of each ODF file integer(pInt), private :: & - material_Ntexture, & !< number of textures microstructure_maxNconstituents, & !< max number of constituents in any phase texture_maxNgauss, & !< max number of Gauss components in any texture texture_maxNfiber !< max number of Fiber components in any texture @@ -305,13 +279,6 @@ module material vacancyConcRate, & !< vacancy conc change field hydrogenConcRate !< hydrogen conc change field - type(tPartitionedStringList), public,protected, allocatable, dimension(:) :: & - phaseConfig, & - microstructureConfig, & - homogenizationConfig, & - textureConfig, & - crystalliteConfig - public :: & material_init, & ELASTICITY_hooke_ID ,& @@ -419,43 +386,21 @@ subroutine material_init() write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... - call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file - - rewind(fileUnit) - line = '' ! to have it initialized - do while (trim(line) /= IO_EOF) - part = IO_lc(IO_getTag(line,'<','>')) - - select case (trim(part)) - - case (trim(material_partPhase)) - line = material_parsePhase(FILEUNIT) + call material_parsePhase() if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) - case (trim(material_partMicrostructure)) - line = material_parseMicrostructure(FILEUNIT) + call material_parseMicrostructure() if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) - case (trim(material_partCrystallite)) - line = material_parseCrystallite(FILEUNIT) + call material_parseCrystallite() if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) - case (trim(material_partHomogenization)) - line = material_parseHomogenization(FILEUNIT) + call material_parseHomogenization() if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) - case (trim(material_partTexture)) - line = material_parseTexture(FILEUNIT) + call material_parseTexture() if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) - case default - line = IO_read(fileUnit) - - end select - - enddo - allocate(plasticState (material_Nphase)) allocate(sourceState (material_Nphase)) do myPhase = 1,material_Nphase @@ -571,7 +516,9 @@ end subroutine material_init !-------------------------------------------------------------------------------------------------- !> @brief parses the homogenization part in the material configuration file !-------------------------------------------------------------------------------------------------- -character(len=65536) function material_parseHomogenization(fileUnit) +subroutine material_parseHomogenization + use config_material, only : & + homogenizationConfig use IO, only: & IO_read, & IO_globalTagInPart, & @@ -590,7 +537,6 @@ character(len=65536) function material_parseHomogenization(fileUnit) mesh_element implicit none - integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos @@ -598,40 +544,6 @@ character(len=65536) function material_parseHomogenization(fileUnit) character(len=65536) :: line, tag,devNull character(len=64) :: tag2 logical :: echo - - allocate(homogenizationConfig(0)) - - h = 0_pInt - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - nextSection: if (IO_getTag(line,'[',']') /= '') then - h = h + 1_pInt - homogenizationConfig = [homogenizationConfig, emptyList] - tag2 = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(homogenization_name)) then - allocate(homogenization_name(1),source=tag2) - else GfortranBug86033 - homogenization_name = [homogenization_name,tag2] - endif GfortranBug86033 - endif nextSection - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key - inSection: if (h > 0_pInt) then - call homogenizationConfig(h)%add(line) - else inSection - echo = (trim(tag) == '/echo/') - endif inSection - enddo - - if (echo) call homogenizationConfig(1)%show() - - material_Nhomogenization = size(homogenizationConfig) - if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) allocate(homogenization_type(material_Nhomogenization), source=HOMOGENIZATION_undefined_ID) allocate(thermal_type(material_Nhomogenization), source=THERMAL_isothermal_ID) @@ -760,15 +672,14 @@ endif enddo homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active) - material_parseHomogenization=line -end function material_parseHomogenization +end subroutine material_parseHomogenization !-------------------------------------------------------------------------------------------------- !> @brief parses the microstructure part in the material configuration file !-------------------------------------------------------------------------------------------------- -character(len=65536) function material_parseMicrostructure(fileUnit) +subroutine material_parseMicrostructure use prec, only: & dNeq use IO @@ -777,8 +688,6 @@ character(len=65536) function material_parseMicrostructure(fileUnit) mesh_NcpElems implicit none - integer(pInt), intent(in) :: fileUnit - character(len=256), dimension(:), allocatable :: & str character(len=64) :: tag2 @@ -789,40 +698,10 @@ character(len=65536) function material_parseMicrostructure(fileUnit) tag,line,devNull logical :: echo - allocate(MicrostructureConfig(0)) line = '' ! to have it initialized m = 0_pInt echo =.false. - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - nextSection: if (IO_getTag(line,'[',']') /= '') then - m = m + 1_pInt - microstructureConfig = [microstructureConfig, emptyList] - tag2 = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(microstructure_name)) then - allocate(microstructure_name(1),source=tag2) - else GfortranBug86033 - microstructure_name = [microstructure_name,tag2] - endif GfortranBug86033 - endif nextSection - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key - inSection: if (m > 0_pInt) then - chunkPos = IO_stringPos(line) - call microstructureConfig(m)%add(IO_lc(line)) - else inSection - echo = (trim(tag) == '/echo/') - endif inSection - enddo - - material_Nmicrostructure = size(microstructureConfig) - if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure) allocate(microstructure_crystallite(material_Nmicrostructure), source=0_pInt) allocate(microstructure_Nconstituents(material_Nmicrostructure), source=0_pInt) @@ -871,14 +750,13 @@ enddo call IO_error(153_pInt,ext_msg=microstructure_name(m)) enddo - material_parseMicrostructure = line -end function material_parseMicrostructure +end subroutine material_parseMicrostructure !-------------------------------------------------------------------------------------------------- !> @brief parses the crystallite part in the material configuration file !-------------------------------------------------------------------------------------------------- -character(len=65536) function material_parseCrystallite(fileUnit) +subroutine material_parseCrystallite use IO, only: & IO_read, & IO_error, & @@ -890,7 +768,6 @@ character(len=65536) function material_parseCrystallite(fileUnit) IO_EOF implicit none - integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos character(len=64) :: tag2 @@ -898,53 +775,18 @@ character(len=65536) function material_parseCrystallite(fileUnit) character(len=65536) :: line, tag,devNull logical :: echo - allocate(crystalliteConfig(0)) - c = 0_pInt - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - nextSection: if (IO_getTag(line,'[',']') /= '') then - c = c + 1_pInt - crystalliteConfig = [crystalliteConfig, emptyList] - tag2 = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(crystallite_name)) then - allocate(crystallite_name(1),source=tag2) - else GfortranBug86033 - crystallite_name = [crystallite_name,tag2] - endif GfortranBug86033 - endif nextSection - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key - inSection: if (c > 0_pInt) then - chunkPos = IO_stringPos(trim(line)) - call crystalliteConfig(c)%add(IO_lc(line)) - else inSection - echo = (trim(tag) == '/echo/') - endif inSection - enddo - - material_Ncrystallite = size(crystalliteConfig) - if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite) - allocate(crystallite_Noutput(material_Ncrystallite), source=0_pInt) do c=1_pInt, material_Ncrystallite crystallite_Noutput(c) = crystalliteConfig(c)%countKeys('(output)') enddo - material_parseCrystallite = line -end function material_parseCrystallite +end subroutine material_parseCrystallite !-------------------------------------------------------------------------------------------------- !> @brief parses the phase part in the material configuration file !-------------------------------------------------------------------------------------------------- -character(len=65536) function material_parsePhase(fileUnit) - use chained_list, only: & - emptyList +subroutine material_parsePhase use IO, only: & IO_read, & IO_globalTagInPart, & @@ -960,7 +802,6 @@ character(len=65536) function material_parsePhase(fileUnit) IO_EOF implicit none - integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos @@ -972,41 +813,10 @@ character(len=65536) function material_parsePhase(fileUnit) str logical :: echo - allocate(phaseConfig(0)) line = '' ! to have it initialized p = 0_pInt ! - " - echo =.false. - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - nextSection: if (IO_getTag(line,'[',']') /= '') then - p = p + 1_pInt - phaseConfig = [phaseConfig, emptyList] - tag2 = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(phase_name)) then - allocate(phase_name(1),source=tag2) - else GfortranBug86033 - phase_name = [phase_name,tag2] - endif GfortranBug86033 - endif nextSection - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key - inSection: if (p > 0_pInt) then - chunkPos = IO_stringPos(line) - call phaseConfig(p)%add(IO_lc(trim(line))) - else inSection - echo = (trim(tag) == '/echo/') - endif inSection - enddo - - material_Nphase = size(phaseConfig) - if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase) - allocate(phase_elasticity(material_Nphase),source=ELASTICITY_undefined_ID) allocate(phase_plasticity(material_Nphase),source=PLASTICITY_undefined_ID) allocate(phase_Nsources(material_Nphase), source=0_pInt) @@ -1118,13 +928,12 @@ character(len=65536) function material_parsePhase(fileUnit) phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) enddo - material_parsePhase = line -end function material_parsePhase +end subroutine material_parsePhase !-------------------------------------------------------------------------------------------------- !> @brief parses the texture part in the material configuration file !-------------------------------------------------------------------------------------------------- -character(len=65536) function material_parseTexture(fileUnit) +subroutine material_parseTexture use prec, only: & dNeq use IO, only: & @@ -1149,7 +958,6 @@ character(len=65536) function material_parseTexture(fileUnit) math_inv33 implicit none - integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos @@ -1160,39 +968,6 @@ character(len=65536) function material_parseTexture(fileUnit) character(len=65536) :: line, tag,devNull, line2 - allocate(textureConfig(0)) - - t = 0_pInt - do while (trim(line2) /= IO_EOF) ! read through sections of material part - line2 = IO_read(fileUnit) - if (IO_isBlank(line2)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line2,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - nextSection: if (IO_getTag(line2,'[',']') /= '') then - t = t + 1_pInt - textureConfig = [textureConfig, emptyList] - tag2 = IO_getTag(line2,'[',']') - GfortranBug86033: if (.not. allocated(texture_name)) then - allocate(texture_name(1),source=tag2) - else GfortranBug86033 - texture_name = [texture_name,tag2] - endif GfortranBug86033 - endif nextSection - chunkPos = IO_stringPos(line2) - tag = IO_lc(IO_stringValue(trim(line2),chunkPos,1_pInt)) ! extract key - inSection: if (t > 0_pInt) then - chunkPos = IO_stringPos(line2) - call textureConfig(t)%add(IO_lc(trim(line2))) - else inSection - echo = (trim(tag) == '/echo/') - endif inSection - enddo - - material_Ntexture = size(textureConfig) - if (material_Ntexture < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) - allocate(texture_ODFfile(material_Ntexture)); texture_ODFfile='' allocate(texture_symmetry(material_Ntexture), source=1_pInt) allocate(texture_Ngauss(material_Ntexture), source=0_pInt) @@ -1316,8 +1091,7 @@ character(len=65536) function material_parseTexture(fileUnit) enddo lines enddo - material_parseTexture = line2 -end function material_parseTexture +end subroutine material_parseTexture !-------------------------------------------------------------------------------------------------- diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 514652397..f010b3a00 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -151,8 +151,9 @@ subroutine plastic_disloUCLA_init(fileUnit) phase_Noutput, & PLASTICITY_DISLOUCLA_label, & PLASTICITY_DISLOUCLA_ID, & - material_phase, & - plasticState, & + material_phase, & + plasticState + use config_material, only: & MATERIAL_partPhase use lattice use numerics,only: & diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index e0da954a6..46f833a7f 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -239,7 +239,8 @@ subroutine plastic_dislotwin_init(fileUnit) PLASTICITY_DISLOTWIN_label, & PLASTICITY_DISLOTWIN_ID, & material_phase, & - plasticState, & + plasticState + use config_material, only: & MATERIAL_partPhase use lattice use numerics,only: & diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index eb3120562..916f43ebd 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -97,7 +97,8 @@ use IO PLASTICITY_ISOTROPIC_label, & PLASTICITY_ISOTROPIC_ID, & material_phase, & - plasticState, & + plasticState + use config_material, only: & MATERIAL_partPhase, & phaseConfig diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index c33a14db6..09eebe460 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -145,7 +145,8 @@ subroutine plastic_kinehardening_init(fileUnit) phase_plasticityInstance, & phase_Noutput, & material_phase, & - plasticState, & + plasticState + use config_material, only: & MATERIAL_partPhase use lattice use numerics,only: & diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 55871737d..eb75cee96 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -291,8 +291,8 @@ use material, only: phase_plasticity, & PLASTICITY_NONLOCAL_label, & PLASTICITY_NONLOCAL_ID, & plasticState, & - MATERIAL_partPhase ,& material_phase +use config_material, only: MATERIAL_partPhase use lattice use numerics,only: & numerics_integrator diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 229d03c26..8ac436ea2 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -157,7 +157,8 @@ subroutine plastic_phenopowerlaw_init(fileUnit) PLASTICITY_PHENOPOWERLAW_label, & PLASTICITY_PHENOPOWERLAW_ID, & material_phase, & - plasticState, & + plasticState + use config_material, only: & MATERIAL_partPhase use lattice use numerics,only: & diff --git a/src/porosity_none.f90 b/src/porosity_none.f90 index c273baf3b..b94e5ca94 100644 --- a/src/porosity_none.f90 +++ b/src/porosity_none.f90 @@ -27,6 +27,7 @@ subroutine porosity_none_init() use IO, only: & IO_timeStamp use material + use config_material implicit none integer(pInt) :: & diff --git a/src/porosity_phasefield.f90 b/src/porosity_phasefield.f90 index 6ab7263e4..a37538c37 100644 --- a/src/porosity_phasefield.f90 +++ b/src/porosity_phasefield.f90 @@ -77,11 +77,10 @@ subroutine porosity_phasefield_init(fileUnit) porosityState, & porosityMapping, & porosity, & - porosity_initialPhi, & + porosity_initialPhi + use config_material, only: & material_partHomogenization, & material_partPhase - use numerics,only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -94,11 +93,9 @@ subroutine porosity_phasefield_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_phasefield_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_phasefield_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(porosity_type == POROSITY_phasefield_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 22236a636..e8d7f62ec 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -91,9 +91,10 @@ subroutine source_damage_anisoBrittle_init(fileUnit) phase_Noutput, & SOURCE_damage_anisoBrittle_label, & SOURCE_damage_anisoBrittle_ID, & + material_phase, & + sourceState + use config_material, only: & material_Nphase, & - material_phase, & - sourceState, & MATERIAL_partPhase use numerics,only: & numerics_integrator diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 944a65918..c99647939 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -95,9 +95,10 @@ subroutine source_damage_anisoDuctile_init(fileUnit) phase_Noutput, & SOURCE_damage_anisoDuctile_label, & SOURCE_damage_anisoDuctile_ID, & - material_Nphase, & material_phase, & - sourceState, & + sourceState + use config_material, only: & + material_Nphase, & MATERIAL_partPhase use numerics,only: & numerics_integrator diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index b9fb2c22c..bb4497885 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -81,9 +81,10 @@ subroutine source_damage_isoBrittle_init(fileUnit) phase_Noutput, & SOURCE_damage_isoBrittle_label, & SOURCE_damage_isoBrittle_ID, & - material_Nphase, & material_phase, & - sourceState, & + sourceState + use config_material, only: & + material_Nphase, & MATERIAL_partPhase use numerics,only: & numerics_integrator diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index ed08e0a41..6f3fa3f89 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -81,10 +81,12 @@ subroutine source_damage_isoDuctile_init(fileUnit) phase_Noutput, & SOURCE_damage_isoDuctile_label, & SOURCE_damage_isoDuctile_ID, & - material_Nphase, & material_phase, & - sourceState, & + sourceState + use config_material, only: & + material_Nphase, & MATERIAL_partPhase + use numerics,only: & numerics_integrator diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 7a4e85c75..b9589d62b 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -67,9 +67,10 @@ subroutine source_thermal_dissipation_init(fileUnit) phase_Noutput, & SOURCE_thermal_dissipation_label, & SOURCE_thermal_dissipation_ID, & - material_Nphase, & material_phase, & - sourceState, & + sourceState + use config_material, only: & + material_Nphase, & MATERIAL_partPhase use numerics,only: & numerics_integrator diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 2907ddf85..39a23b71b 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -73,9 +73,10 @@ subroutine source_thermal_externalheat_init(fileUnit) phase_Noutput, & SOURCE_thermal_externalheat_label, & SOURCE_thermal_externalheat_ID, & - material_Nphase, & material_phase, & - sourceState, & + sourceState + use config_material, only: & + material_Nphase, & MATERIAL_partPhase use numerics,only: & numerics_integrator diff --git a/src/source_vacancy_irradiation.f90 b/src/source_vacancy_irradiation.f90 index 566d97e68..bc5f9a620 100644 --- a/src/source_vacancy_irradiation.f90 +++ b/src/source_vacancy_irradiation.f90 @@ -69,9 +69,10 @@ subroutine source_vacancy_irradiation_init(fileUnit) phase_Noutput, & SOURCE_vacancy_irradiation_label, & SOURCE_vacancy_irradiation_ID, & - material_Nphase, & material_phase, & - sourceState, & + sourceState + use config_material, only: & + material_Nphase, & MATERIAL_partPhase use numerics,only: & numerics_integrator diff --git a/src/source_vacancy_phenoplasticity.f90 b/src/source_vacancy_phenoplasticity.f90 index 8834a067a..0b543d19a 100644 --- a/src/source_vacancy_phenoplasticity.f90 +++ b/src/source_vacancy_phenoplasticity.f90 @@ -67,9 +67,10 @@ subroutine source_vacancy_phenoplasticity_init(fileUnit) phase_Noutput, & SOURCE_vacancy_phenoplasticity_label, & SOURCE_vacancy_phenoplasticity_ID, & - material_Nphase, & material_phase, & - sourceState, & + sourceState + use config_material, only: & + material_Nphase, & MATERIAL_partPhase use numerics,only: & numerics_integrator diff --git a/src/source_vacancy_thermalfluc.f90 b/src/source_vacancy_thermalfluc.f90 index 91047fbf2..39890e2ee 100644 --- a/src/source_vacancy_thermalfluc.f90 +++ b/src/source_vacancy_thermalfluc.f90 @@ -71,9 +71,10 @@ subroutine source_vacancy_thermalfluc_init(fileUnit) phase_Noutput, & SOURCE_vacancy_thermalfluc_label, & SOURCE_vacancy_thermalfluc_ID, & - material_Nphase, & material_phase, & - sourceState, & + sourceState + use config_material, only: & + material_Nphase, & MATERIAL_partPhase use numerics,only: & numerics_integrator diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index 62ffabf9c..2b9a5ae59 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -64,6 +64,8 @@ subroutine thermal_adiabatic_init(fileUnit) IO_error, & IO_timeStamp, & IO_EOF + use config_material, only: & + material_partHomogenization use material, only: & thermal_type, & thermal_typeInstance, & @@ -76,8 +78,7 @@ subroutine thermal_adiabatic_init(fileUnit) thermalMapping, & thermal_initialT, & temperature, & - temperatureRate, & - material_partHomogenization + temperatureRate implicit none integer(pInt), intent(in) :: fileUnit diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 151eb7aa3..83c776b6b 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -77,7 +77,8 @@ subroutine thermal_conduction_init(fileUnit) thermalMapping, & thermal_initialT, & temperature, & - temperatureRate, & + temperatureRate + use config_material, only: & material_partHomogenization implicit none diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 index 68e09de8c..17e82c606 100644 --- a/src/thermal_isothermal.f90 +++ b/src/thermal_isothermal.f90 @@ -27,6 +27,7 @@ subroutine thermal_isothermal_init() use IO, only: & IO_timeStamp use material + use config_material implicit none integer(pInt) :: & diff --git a/src/vacancyflux_cahnhilliard.f90 b/src/vacancyflux_cahnhilliard.f90 index e40772d11..5ea5c908a 100644 --- a/src/vacancyflux_cahnhilliard.f90 +++ b/src/vacancyflux_cahnhilliard.f90 @@ -91,9 +91,10 @@ subroutine vacancyflux_cahnhilliard_init(fileUnit) vacancyfluxMapping, & vacancyConc, & vacancyConcRate, & - vacancyflux_initialCv, & - material_partHomogenization, & - material_partPhase + vacancyflux_initialCv + use config_material, only: & + material_partPhase, & + material_partHomogenization implicit none integer(pInt), intent(in) :: fileUnit diff --git a/src/vacancyflux_isochempot.f90 b/src/vacancyflux_isochempot.f90 index f98379eba..6216c03cf 100644 --- a/src/vacancyflux_isochempot.f90 +++ b/src/vacancyflux_isochempot.f90 @@ -74,7 +74,8 @@ subroutine vacancyflux_isochempot_init(fileUnit) vacancyfluxMapping, & vacancyConc, & vacancyConcRate, & - vacancyflux_initialCv, & + vacancyflux_initialCv + use config_material, only: & material_partHomogenization implicit none diff --git a/src/vacancyflux_isoconc.f90 b/src/vacancyflux_isoconc.f90 index 470560206..bc66e2df9 100644 --- a/src/vacancyflux_isoconc.f90 +++ b/src/vacancyflux_isoconc.f90 @@ -27,6 +27,7 @@ subroutine vacancyflux_isoconc_init() use IO, only: & IO_timeStamp use material + use config_material implicit none integer(pInt) :: & From a1fdbd1d5e62767b4255237e6a884f5fa72bac0f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Jun 2018 18:38:31 +0200 Subject: [PATCH 39/94] most IO related variables not needed any more in material --- src/CPFEM2.f90 | 3 + src/config_material.f90 | 32 ++++++----- src/material.f90 | 123 ++++++++-------------------------------- 3 files changed, 46 insertions(+), 112 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index cd28e3420..20c2b8674 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -27,6 +27,8 @@ subroutine CPFEM_initAll(el,ip) numerics_init use debug, only: & debug_init + use config_material, only: & + config_material_init use FEsolving, only: & FE_init use math, only: & @@ -64,6 +66,7 @@ subroutine CPFEM_initAll(el,ip) #endif call numerics_init call debug_init + call config_material_init call math_init call FE_init call mesh_init(ip, el) ! pass on coordinates to alter calcMode of first ip diff --git a/src/config_material.f90 b/src/config_material.f90 index 61f41b2a5..278e97659 100644 --- a/src/config_material.f90 +++ b/src/config_material.f90 @@ -10,27 +10,32 @@ module config_material use prec, only: & pReal, & pInt + implicit none - !private + private type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & phaseConfig, & microstructureConfig, & homogenizationConfig, & textureConfig, & crystalliteConfig + character(len=64), dimension(:), allocatable, public, protected :: & phase_name, & !< name of each phase homogenization_name, & !< name of each homogenization crystallite_name, & !< name of each crystallite setting microstructure_name, & !< name of each microstructure texture_name !< name of each texture + +! ToDo: make private, no one needs to know that character(len=*), parameter, public :: & MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part - MATERIAL_partPhase = 'phase',& !< keyword for phase part + MATERIAL_partPhase = 'phase', & !< keyword for phase part MATERIAL_partMicrostructure = 'microstructure', & !< keyword for microstructure part MATERIAL_partTexture = 'texture' !< keyword for texture part +! ToDo: Remove, use size(phaseConfig) etc integer(pInt), public, protected :: & material_Ntexture, & !< number of textures material_Nphase, & !< number of phases @@ -38,10 +43,13 @@ module config_material material_Nmicrostructure, & !< number of microstructures material_Ncrystallite !< number of crystallite settings +! ToDo: make private, no one needs to know that character(len=*), parameter, public :: & MATERIAL_configFile = 'material.config', & !< generic name for material configuration file MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file + public :: config_material_init + contains subroutine config_material_init() @@ -66,18 +74,11 @@ subroutine config_material_init() implicit none integer(pInt), parameter :: FILEUNIT = 200_pInt - integer(pInt) :: m,c,h, myDebug, myPhase, myHomog - integer(pInt) :: & - g, & !< grain number - i, & !< integration point number - e, & !< element number - phase - integer(pInt), dimension(:), allocatable :: ConstitutivePosition - integer(pInt), dimension(:), allocatable :: CrystallitePosition - integer(pInt), dimension(:), allocatable :: HomogenizationPosition + integer(pInt) :: myDebug character(len=65536) :: & - line,part + line, & + part myDebug = debug_level(debug_material) @@ -158,7 +159,7 @@ subroutine parseFile(sectionNames,part,fileUnit,line) character(len=65536),intent(out) :: line integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, s + integer(pInt) :: s character(len=65536) :: devNull character(len=64) :: tag logical :: echo @@ -192,6 +193,11 @@ subroutine parseFile(sectionNames,part,fileUnit,line) endif inSection enddo + if (echo) then + do s = 1, size(sectionNames) + call part(s)%show() + end do + end if end subroutine parseFile end module config_material diff --git a/src/material.f90 b/src/material.f90 index f7a4b29ef..515557836 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -346,13 +346,7 @@ subroutine material_init() #endif use IO, only: & IO_error, & - IO_open_file, & - IO_read, & - IO_lc, & - IO_open_jobFile_stat, & - IO_getTag, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use debug, only: & debug_level, & debug_material, & @@ -377,9 +371,6 @@ subroutine material_init() integer(pInt), dimension(:), allocatable :: CrystallitePosition integer(pInt), dimension(:), allocatable :: HomogenizationPosition - character(len=65536) :: & - line,part - myDebug = debug_level(debug_material) write(6,'(/,a)') ' <<<+- material init -+>>>' @@ -520,30 +511,16 @@ subroutine material_parseHomogenization use config_material, only : & homogenizationConfig use IO, only: & - IO_read, & - IO_globalTagInPart, & - IO_countSections, & IO_error, & - IO_countTagInPart, & - IO_lc, & - IO_getTag, & - IO_isBlank, & IO_stringValue, & IO_intValue, & - IO_floatValue, & - IO_stringPos, & - IO_EOF + IO_floatValue use mesh, only: & mesh_element implicit none - - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, h - character(len=65536) :: line, tag,devNull - character(len=64) :: tag2 - logical :: echo + integer(pInt) :: h + character(len=65536) :: tag allocate(homogenization_type(material_Nhomogenization), source=HOMOGENIZATION_undefined_ID) allocate(thermal_type(material_Nhomogenization), source=THERMAL_isothermal_ID) @@ -690,17 +667,13 @@ subroutine material_parseMicrostructure implicit none character(len=256), dimension(:), allocatable :: & str - character(len=64) :: tag2 - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt), allocatable, dimension(:,:) :: chunkPoss integer(pInt) :: e, m, constituent, i character(len=65536) :: & - tag,line,devNull - logical :: echo + tag,line line = '' ! to have it initialized m = 0_pInt - echo =.false. allocate(microstructure_crystallite(material_Nmicrostructure), source=0_pInt) @@ -728,7 +701,7 @@ subroutine material_parseMicrostructure call microstructureConfig(m)%getRaws('(constituent)',str,chunkPoss) do constituent = 1_pInt, size(str) do i = 2_pInt,6_pInt,2_pInt - tag = IO_lc(IO_stringValue(str(constituent),chunkPoss(:,constituent),i)) + tag = IO_stringValue(str(constituent),chunkPoss(:,constituent),i) select case (tag) case('phase') @@ -757,25 +730,11 @@ end subroutine material_parseMicrostructure !> @brief parses the crystallite part in the material configuration file !-------------------------------------------------------------------------------------------------- subroutine material_parseCrystallite - use IO, only: & - IO_read, & - IO_error, & - IO_getTag, & - IO_lc, & - IO_stringPos, & - IO_stringValue, & - IO_isBlank, & - IO_EOF implicit none - integer(pInt), allocatable, dimension(:) :: chunkPos - - character(len=64) :: tag2 integer(pInt) :: c - character(len=65536) :: line, tag,devNull - logical :: echo - allocate(crystallite_Noutput(material_Ncrystallite), source=0_pInt) + allocate(crystallite_Noutput(material_Ncrystallite),source=0_pInt) do c=1_pInt, material_Ncrystallite crystallite_Noutput(c) = crystalliteConfig(c)%countKeys('(output)') enddo @@ -788,34 +747,14 @@ end subroutine material_parseCrystallite !-------------------------------------------------------------------------------------------------- subroutine material_parsePhase use IO, only: & - IO_read, & - IO_globalTagInPart, & - IO_countSections, & IO_error, & - IO_countTagInPart, & IO_getTag, & - IO_spotTagInPart, & - IO_lc, & - IO_isBlank, & - IO_stringValue, & - IO_stringPos, & - IO_EOF + IO_stringValue implicit none - - - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p - character(len=65536) :: & - tag,line,devNull - character(len=64) :: tag2 - character(len=64), dimension(:), allocatable :: & - str - logical :: echo + character(len=256), dimension(:), allocatable :: str - line = '' ! to have it initialized - p = 0_pInt ! - " - - echo =.false. allocate(phase_elasticity(material_Nphase),source=ELASTICITY_undefined_ID) allocate(phase_plasticity(material_Nphase),source=PLASTICITY_undefined_ID) @@ -937,19 +876,10 @@ subroutine material_parseTexture use prec, only: & dNeq use IO, only: & - IO_read, & - IO_globalTagInPart, & - IO_countSections, & IO_error, & - IO_countTagInPart, & - IO_getTag, & - IO_spotTagInPart, & - IO_lc, & - IO_isBlank, & - IO_floatValue, & - IO_stringValue, & IO_stringPos, & - IO_EOF + IO_floatValue, & + IO_stringValue use math, only: & inRad, & math_sampleRandomOri, & @@ -958,20 +888,15 @@ subroutine material_parseTexture math_inv33 implicit none - - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, section, gauss, fiber, j, t, i - character(len=64) :: tag2 + integer(pInt) :: section, gauss, fiber, j, t, i character(len=256), dimension(:), allocatable :: bla - logical :: echo + integer(pInt), dimension(:), allocatable :: chunkPos + character(len=65536) :: line, tag - character(len=65536) :: line, tag,devNull, line2 - - allocate(texture_ODFfile(material_Ntexture)); texture_ODFfile='' - allocate(texture_symmetry(material_Ntexture), source=1_pInt) - allocate(texture_Ngauss(material_Ntexture), source=0_pInt) - allocate(texture_Nfiber(material_Ntexture), source=0_pInt) + allocate(texture_ODFfile(material_Ntexture)); texture_ODFfile='' + allocate(texture_symmetry(material_Ntexture), source=1_pInt) + allocate(texture_Ngauss(material_Ntexture), source=0_pInt) + allocate(texture_Nfiber(material_Ntexture), source=0_pInt) do t=1_pInt, material_Ntexture texture_Ngauss(t) = textureConfig(t)%countKeys('(gauss)') & @@ -996,12 +921,12 @@ subroutine material_parseTexture line = bla(i) chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + tag = IO_stringValue(line,chunkPos,1_pInt) ! extract key textureType: select case(tag) case ('axes', 'rotation') textureType do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries - tag = IO_lc(IO_stringValue(line,chunkPos,j+1_pInt)) + tag = IO_stringValue(line,chunkPos,j+1_pInt) select case (tag) case('x', '+x') texture_transformation(j,1:3,section) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis @@ -1027,7 +952,7 @@ subroutine material_parseTexture texture_ODFfile(section) = IO_stringValue(line,chunkPos,2_pInt) case ('symmetry') textureType - tag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + tag = IO_stringValue(line,chunkPos,2_pInt) select case (tag) case('orthotropic') texture_symmetry(section) = 4_pInt @@ -1041,7 +966,7 @@ subroutine material_parseTexture gauss = gauss + 1_pInt texture_Gauss(1:3,gauss,section) = math_sampleRandomOri() do j = 2_pInt,4_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,chunkPos,j)) + tag = IO_stringValue(line,chunkPos,j) select case (tag) case('scatter') texture_Gauss(4,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad @@ -1053,7 +978,7 @@ subroutine material_parseTexture case ('(gauss)') textureType gauss = gauss + 1_pInt do j = 2_pInt,10_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,chunkPos,j)) + tag = IO_stringValue(line,chunkPos,j) select case (tag) case('phi1') texture_Gauss(1,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad @@ -1071,7 +996,7 @@ subroutine material_parseTexture case ('(fiber)') textureType fiber = fiber + 1_pInt do j = 2_pInt,12_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,chunkPos,j)) + tag = IO_stringValue(line,chunkPos,j) select case (tag) case('alpha1') texture_Fiber(1,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad From e0a6b79b145e0c4ad091187a53223bdb37239e33 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Jun 2018 23:38:16 +0200 Subject: [PATCH 40/94] trying to have descriptive names --- src/CPFEM.f90 | 3 + src/IO.f90 | 11 + src/commercialFEM_fileList.f90 | 3 +- src/list.f90 | 378 ++++++++++++++++++--------------- 4 files changed, 223 insertions(+), 172 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index b613c73d3..aefa1638f 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -62,6 +62,8 @@ subroutine CPFEM_initAll(el,ip) numerics_init use debug, only: & debug_init + use config_material, only: & + config_material_init use FEsolving, only: & FE_init use math, only: & @@ -93,6 +95,7 @@ subroutine CPFEM_initAll(el,ip) call IO_init call numerics_init call debug_init + call config_material_init call math_init call FE_init call mesh_init(ip, el) ! pass on coordinates to alter calcMode of first ip diff --git a/src/IO.f90 b/src/IO.f90 index 27d2f4ae2..d21f3a754 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -1550,6 +1550,17 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) case (136_pInt) msg = 'zero entry on stiffness diagonal for transformed phase' +!-------------------------------------------------------------------------------------------------- +! errors related to the parsing of material.config + case (140_pInt) + msg = 'key not found' + case (141_pInt) + msg = 'number of chunks in string differs' + case (142_pInt) + msg = 'empty list' + case (143_pInt) + msg = 'no value found for key' + !-------------------------------------------------------------------------------------------------- ! material error messages and related messages in mesh case (150_pInt) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index f1651dea8..a4e2ee383 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -4,9 +4,10 @@ !> @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 "list.f90" +#include "config_material.f90" #include "math.f90" #include "FEsolving.f90" #include "mesh.f90" diff --git a/src/list.f90 b/src/list.f90 index 9bb93a81b..b8f114f8f 100644 --- a/src/list.f90 +++ b/src/list.f90 @@ -1,3 +1,7 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Dieh, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Chained list to store string together with position of delimiters +!-------------------------------------------------------------------------------------------------- module chained_list use prec, only: & pReal, & @@ -17,9 +21,13 @@ module chained_list contains procedure :: add => add procedure :: show => show + + procedure :: keyExists => keyExists + procedure :: countKeys => countKeyAppearances + procedure :: getStringsRaw => strings + procedure :: getRaw => getRaw - procedure :: getRaws => getRaws - procedure :: getStringsRaw => getStringsRaw + procedure :: getRaws => getRaws procedure :: getFloat => getFloat procedure :: getFloatArray => getFloatArray @@ -29,8 +37,6 @@ module chained_list procedure :: getString => getString procedure :: getStrings => getStrings - procedure :: keyExists => keyExists - procedure :: countKeys => countKeys end type tPartitionedStringList @@ -40,7 +46,9 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief add element -!> @details adds raw string and start/end position of chunks in this string +!> @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: & @@ -49,16 +57,14 @@ subroutine add(this,string) IO_stringPos implicit none - class(tPartitionedStringList), target :: this - character(len=*), intent(in) :: string - - integer(pInt), allocatable,dimension(:) :: p - type(tPartitionedStringList), pointer :: new, tmp + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: string + type(tPartitionedStringList), pointer :: new, tmp if (IO_isBlank(string)) return allocate(new) - new%string%val=trim(string) + new%string%val=IO_lc(trim(string)) new%string%pos=IO_stringPos(trim(string)) tmp => this @@ -71,10 +77,11 @@ end subroutine add !-------------------------------------------------------------------------------------------------- -!> @brief add element -!> @details adds raw string and start/end position of chunks in this string +!> @brief prints all elements +!> @details Strings are printed in order of insertion (FIFO) !-------------------------------------------------------------------------------------------------- subroutine show(this) + implicit none class(tPartitionedStringList) :: this type(tPartitionedStringList), pointer :: tmp @@ -88,8 +95,117 @@ subroutine show(this) end subroutine show + !-------------------------------------------------------------------------------------------------- -!> @brief gets raw data +!> @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 :: tmp +! +! do +! tmp => first +! +! if (associated(tmp) .eqv. .FALSE.) exit +! +! first => first%next +! deallocate(tmp) +! 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 :: tmp + + keyExists = .false. + + tmp => this%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 keyExists + + +!-------------------------------------------------------------------------------------------------- +!> @brief prints all elements +!> @details Strings are printed in order of insertion (FIFO) +!-------------------------------------------------------------------------------------------------- +integer(pInt) function countKeyAppearances(this,key) + use IO, only: & + IO_stringValue + + implicit none + + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: tmp + integer(pInt) :: i + + countKeyAppearances = 0_pInt + + tmp => this%next + do + if (.not. associated(tmp)) exit + if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + countKeyAppearances = countKeyAppearances + 1_pInt + endif + tmp => tmp%next + end do + +end function countKeyAppearances + + +!-------------------------------------------------------------------------------------------------- +!> @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) :: stringTmp + type(tPartitionedStringList), pointer :: tmp + + tmp => this%next + do + if (.not. associated(tmp)) then + if(size(strings) < 0_pInt) call IO_error(142_pInt) + exit + endif + stringTmp = tmp%string%val + GfortranBug86033: if (.not. allocated(strings)) then + allocate(strings(1),source=stringTmp) + else GfortranBug86033 + strings = [strings,stringTmp] + endif GfortranBug86033 + tmp => tmp%next + end do +end function strings + + +!-------------------------------------------------------------------------------------------------- +!> @brief gets first string that matches given key (i.e. first chunk) !> @details returns raw string and start/end position of chunks in this string !-------------------------------------------------------------------------------------------------- subroutine getRaw(this,key,string,stringPos) @@ -98,15 +214,15 @@ subroutine getRaw(this,key,string,stringPos) IO_stringValue 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) :: this + character(len=*), intent(in) :: key + integer(pInt), dimension(:), allocatable, intent(out) :: stringPos + character(len=*), intent(out) :: string + type(tPartitionedStringList), pointer :: tmp tmp => this%next do - if (.not. associated(tmp)) call IO_error(1_pInt,ext_msg=key) + if (.not. associated(tmp)) call IO_error(140_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 @@ -118,8 +234,9 @@ end subroutine getRaw !-------------------------------------------------------------------------------------------------- -!> @brief gets raw data -!> @details returns raw string and start/end position of chunks in this string +!> @brief gets all strings that matches given key (i.e. first chunk) +!> @details returns raw strings and start/end positions of chunks in these strings. Will fail if +! number of positions in strings differs !-------------------------------------------------------------------------------------------------- subroutine getRaws(this,key,string,stringPos) use IO, only: & @@ -127,20 +244,21 @@ subroutine getRaws(this,key,string,stringPos) 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 + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + integer(pInt), dimension(:,:), allocatable, intent(out) :: stringPos + character(len=65536), dimension(:), allocatable, intent(out) :: string + + character(len=65536) :: 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) + if(posSize < 0_pInt) call IO_error(140_pInt,ext_msg=key) stringPos = reshape(stringPosFlat,[posSize,size(string)]) exit endif @@ -151,7 +269,8 @@ subroutine getRaws(this,key,string,stringPos) allocate(string(1)) string(1) = tmp%string%val else - if (size(tmp%string%pos) /= posSize) call IO_error(1_pInt,ext_msg=key) + if (size(tmp%string%pos) /= posSize) & + call IO_error(141_pInt,ext_msg=trim(tmp%string%val),el=posSize) stringPosFlat = [stringPosFlat,tmp%string%pos] stringTmp = tmp%string%val string = [string,stringTmp] @@ -159,43 +278,13 @@ subroutine getRaws(this,key,string,stringPos) endif foundKey tmp => tmp%next end do + end subroutine getRaws !-------------------------------------------------------------------------------------------------- -!> @brief gets raw data -!> @details returns raw string and start/end position of chunks in this string -!-------------------------------------------------------------------------------------------------- -function getStringsRaw(this) - use IO, only: & - IO_error, & - IO_stringValue - - implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=256), dimension(:),allocatable :: getStringsRaw - character(len=256) :: stringTmp - type(tPartitionedStringList), pointer :: tmp - - tmp => this%next - do - if (.not. associated(tmp)) then - if(size(getStringsRaw) < 0_pInt) call IO_error(1_pInt,ext_msg='getallraw empty list') - exit - endif - stringTmp = tmp%string%val - if (.not. allocated(getStringsRaw)) then - allocate(getStringsRaw(1),source=stringTmp) - else - getStringsRaw = [getStringsRaw,stringTmp] - endif - tmp => tmp%next - end do -end function getStringsRaw - -!-------------------------------------------------------------------------------------------------- -!> @brief gets float value for given key -!> @details if key is not found exits with error unless default is given +!> @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 : & @@ -216,22 +305,23 @@ real(pReal) function getFloat(this,key,defaultVal) getFloat = defaultVal exit else - call IO_error(1_pInt,ext_msg=key) + call IO_error(140_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) + if (tmp%string%pos(1) < 2_pInt) call IO_error(143_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 +!> @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: & @@ -252,16 +342,17 @@ integer(pInt) function getInt(this,key,defaultVal) getInt = defaultVal exit else - call IO_error(1_pInt,ext_msg=key) + call IO_error(140_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) + if (tmp%string%pos(1) < 2_pInt) call IO_error(143_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 @@ -269,7 +360,7 @@ 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=64) function getString(this,key,defaultVal) +character(len=65536) function getString(this,key,defaultVal) use IO, only: & IO_error, & IO_stringValue @@ -277,7 +368,7 @@ character(len=64) function getString(this,key,defaultVal) implicit none class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key - character(len=64), intent(in), optional :: defaultVal + character(len=65536), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: tmp tmp => this%next @@ -287,18 +378,55 @@ character(len=64) function getString(this,key,defaultVal) getString = defaultVal exit else - call IO_error(1_pInt,ext_msg=key) + call IO_error(140_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) + if (tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) getString = IO_StringValue(tmp%string%val,tmp%string%pos,2) exit endif foundKey tmp => tmp%next end do + end function getString + +function getStrings(this,key) + use IO + + implicit none + character(len=64),dimension(:),allocatable :: getStrings + character(len=64) :: str + + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: tmp + integer(pInt) :: i + + + tmp => this%next + do + if (.not. associated(tmp)) then + if (.not. allocated(getStrings)) allocate(getStrings(0),source=str) + exit + endif + 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) + + GfortranBug86033: if (.not. allocated(getStrings)) then + allocate(getStrings(1),source=str) + else GfortranBug86033 + getStrings = [getStrings,str] + endif GfortranBug86033 + endif + tmp => tmp%next + end do +end function + + + !-------------------------------------------------------------------------------------------------- !> @brief gets array of int values for given key !> @details if key is not found exits with error unless default is given @@ -326,11 +454,11 @@ function getIntArray(this,key,defaultVal) getIntArray = defaultVal exit else - call IO_error(1_pInt,ext_msg=key) + call IO_error(140_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) + if (tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) do i = 2_pInt, tmp%string%pos(1) getIntArray = [getIntArray,IO_IntValue(tmp%string%val,tmp%string%pos,i)] enddo @@ -369,11 +497,11 @@ function getFloatArray(this,key,defaultVal) getFloatArray = defaultVal exit else - call IO_error(1_pInt,ext_msg=key) + call IO_error(140_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) + if (tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) do i = 2_pInt, tmp%string%pos(1) getFloatArray = [getFloatArray,IO_FloatValue(tmp%string%val,tmp%string%pos,i)] enddo @@ -383,98 +511,6 @@ function getFloatArray(this,key,defaultVal) end do end function getFloatArray -! reports wether a key exists at least once - function keyExists(this,key) - use IO - implicit none - logical :: keyExists - - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: tmp - - keyExists = .false. - - tmp => this%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 - - - integer(pInt) function countKeys(this,key) - use IO - - implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: tmp - integer(pInt) :: i - - countKeys = 0_pInt - - tmp => this%next - do - if (.not. associated(tmp)) exit - if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then - countKeys = countKeys + 1_pInt - endif - tmp => tmp%next - end do - end function - - function getStrings(this,key) - use IO - - implicit none - character(len=64),dimension(:),allocatable :: getStrings - character(len=64) :: str - - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: tmp - integer(pInt) :: i - - - tmp => this%next - do - if (.not. associated(tmp)) then - if (.not. allocated(getStrings)) allocate(getStrings(0),source=str) - exit - endif - 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) - - GfortranBug86033: if (.not. allocated(getStrings)) then - allocate(getStrings(1),source=str) - else GfortranBug86033 - getStrings = [getStrings,str] - endif GfortranBug86033 - 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 fdd3bd126228b7294ff25be5d8470929528282d9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Jun 2018 00:16:48 +0200 Subject: [PATCH 41/94] polishing --- src/material.f90 | 322 +++++++++++++++++++++++------------------------ 1 file changed, 161 insertions(+), 161 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 515557836..a0ab03c7c 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -377,20 +377,20 @@ subroutine material_init() write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - call material_parsePhase() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) - - call material_parseMicrostructure() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) - - call material_parseCrystallite() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) - - call material_parseHomogenization() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) - - call material_parseTexture() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) + call material_parsePhase() + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) + + call material_parseMicrostructure() + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) + + call material_parseCrystallite() + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) + + call material_parseHomogenization() + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) + + call material_parseTexture() + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) allocate(plasticState (material_Nphase)) allocate(sourceState (material_Nphase)) @@ -505,16 +505,13 @@ end subroutine material_init !-------------------------------------------------------------------------------------------------- -!> @brief parses the homogenization part in the material configuration file +!> @brief parses the homogenization part from the material configuration !-------------------------------------------------------------------------------------------------- subroutine material_parseHomogenization use config_material, only : & homogenizationConfig use IO, only: & - IO_error, & - IO_stringValue, & - IO_intValue, & - IO_floatValue + IO_error use mesh, only: & mesh_element @@ -546,97 +543,107 @@ subroutine material_parseHomogenization forall (h = 1_pInt:material_Nhomogenization) homogenization_active(h) = any(mesh_element(3,:) == h) - do h=1_pInt, material_Nhomogenization homogenization_Noutput(h) = homogenizationConfig(h)%countKeys('(output)') + tag = homogenizationConfig(h)%getString('mech') + select case (trim(tag)) + case(HOMOGENIZATION_NONE_label) + homogenization_type(h) = HOMOGENIZATION_NONE_ID + homogenization_Ngrains(h) = 1_pInt + case(HOMOGENIZATION_ISOSTRAIN_label) + homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID + homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents') + case(HOMOGENIZATION_RGC_label) + homogenization_type(h) = HOMOGENIZATION_RGC_ID + homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents') + case default + call IO_error(500_pInt,ext_msg=trim(tag)) + end select + + homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h)) - select case (trim(tag)) - case(HOMOGENIZATION_NONE_label) - homogenization_type(h) = HOMOGENIZATION_NONE_ID - homogenization_Ngrains(h) = 1_pInt - case(HOMOGENIZATION_ISOSTRAIN_label) - homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID - homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents') - case(HOMOGENIZATION_RGC_label) - homogenization_type(h) = HOMOGENIZATION_RGC_ID - homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents') - case default - call IO_error(500_pInt,ext_msg=trim(tag)) - end select - homogenization_typeInstance(h) = & - count(homogenization_type==homogenization_type(h)) ! count instances if (homogenizationConfig(h)%keyExists('thermal')) then - tag = homogenizationConfig(h)%getString('thermal') + thermal_initialT(h) = homogenizationConfig(h)%getFloat('t0') -! case ('t0') -! thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt) - select case (trim(tag)) - case(THERMAL_isothermal_label) - thermal_type(h) = THERMAL_isothermal_ID - case(THERMAL_adiabatic_label) - thermal_type(h) = THERMAL_adiabatic_ID - case(THERMAL_conduction_label) - thermal_type(h) = THERMAL_conduction_ID - case default - call IO_error(500_pInt,ext_msg=trim(tag)) - end select -endif + tag = homogenizationConfig(h)%getString('thermal') + select case (trim(tag)) + case(THERMAL_isothermal_label) + thermal_type(h) = THERMAL_isothermal_ID + case(THERMAL_adiabatic_label) + thermal_type(h) = THERMAL_adiabatic_ID + case(THERMAL_conduction_label) + thermal_type(h) = THERMAL_conduction_ID + case default + call IO_error(500_pInt,ext_msg=trim(tag)) + end select + + endif if (homogenizationConfig(h)%keyExists('damage')) then - tag = homogenizationConfig(h)%getString('damage') -! case ('initialdamage') -! damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) - select case (trim(tag)) - case(DAMAGE_NONE_label) - damage_type(h) = DAMAGE_none_ID - case(DAMAGE_LOCAL_label) - damage_type(h) = DAMAGE_local_ID - case(DAMAGE_NONLOCAL_label) - damage_type(h) = DAMAGE_nonlocal_ID - case default - call IO_error(500_pInt,ext_msg=trim(tag)) - end select -endif - if (homogenizationConfig(h)%keyExists('vacancyflux')) then - tag = homogenizationConfig(h)%getString('vacancyflux') -! case ('cv0') -! vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt) - select case (trim(tag)) - case(VACANCYFLUX_isoconc_label) - vacancyflux_type(h) = VACANCYFLUX_isoconc_ID - case(VACANCYFLUX_isochempot_label) - vacancyflux_type(h) = VACANCYFLUX_isochempot_ID - case(VACANCYFLUX_cahnhilliard_label) - vacancyflux_type(h) = VACANCYFLUX_cahnhilliard_ID - case default - call IO_error(500_pInt,ext_msg=trim(tag)) - end select -endif - if (homogenizationConfig(h)%keyExists('porosity')) then - tag = homogenizationConfig(h)%getString('porosity') - select case (trim(tag)) - case(POROSITY_NONE_label) - porosity_type(h) = POROSITY_none_ID - case(POROSITY_phasefield_label) - porosity_type(h) = POROSITY_phasefield_ID - case default - call IO_error(500_pInt,ext_msg=trim(tag)) - end select -endif - if (homogenizationConfig(h)%keyExists('hydrogenflux')) then - tag = homogenizationConfig(h)%getString('hydrogenflux') -! case ('ch0') -! hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt) - select case (trim(tag)) - case(HYDROGENFLUX_isoconc_label) - hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID - case(HYDROGENFLUX_cahnhilliard_label) - hydrogenflux_type(h) = HYDROGENFLUX_cahnhilliard_ID - case default - call IO_error(500_pInt,ext_msg=trim(tag)) - end select + damage_initialPhi(h) = homogenizationConfig(h)%getFloat('initialdamage') + + tag = homogenizationConfig(h)%getString('thermal') + select case (trim(tag)) + case(DAMAGE_NONE_label) + damage_type(h) = DAMAGE_none_ID + case(DAMAGE_LOCAL_label) + damage_type(h) = DAMAGE_local_ID + case(DAMAGE_NONLOCAL_label) + damage_type(h) = DAMAGE_nonlocal_ID + case default + call IO_error(500_pInt,ext_msg=trim(tag)) + end select + endif + + if (homogenizationConfig(h)%keyExists('vacancyflux')) then + vacancyflux_initialCv(h) = homogenizationConfig(h)%getFloat('cv0') + + tag = homogenizationConfig(h)%getString('vacancyflux') + select case (trim(tag)) + case(VACANCYFLUX_isoconc_label) + vacancyflux_type(h) = VACANCYFLUX_isoconc_ID + case(VACANCYFLUX_isochempot_label) + vacancyflux_type(h) = VACANCYFLUX_isochempot_ID + case(VACANCYFLUX_cahnhilliard_label) + vacancyflux_type(h) = VACANCYFLUX_cahnhilliard_ID + case default + call IO_error(500_pInt,ext_msg=trim(tag)) + end select + + endif + + if (homogenizationConfig(h)%keyExists('porosity')) then + !ToDo? + + tag = homogenizationConfig(h)%getString('porosity') + select case (trim(tag)) + case(POROSITY_NONE_label) + porosity_type(h) = POROSITY_none_ID + case(POROSITY_phasefield_label) + porosity_type(h) = POROSITY_phasefield_ID + case default + call IO_error(500_pInt,ext_msg=trim(tag)) + end select + + endif + + if (homogenizationConfig(h)%keyExists('hydrogenflux')) then + hydrogenflux_initialCh(h) = homogenizationConfig(h)%getFloat('ch0') + + tag = homogenizationConfig(h)%getString('hydrogenflux') + select case (trim(tag)) + case(HYDROGENFLUX_isoconc_label) + hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID + case(HYDROGENFLUX_cahnhilliard_label) + hydrogenflux_type(h) = HYDROGENFLUX_cahnhilliard_ID + case default + call IO_error(500_pInt,ext_msg=trim(tag)) + end select + + endif + enddo do h=1_pInt, material_Nhomogenization @@ -659,22 +666,22 @@ end subroutine material_parseHomogenization subroutine material_parseMicrostructure use prec, only: & dNeq - use IO + use IO, only: & + IO_floatValue, & + IO_intValue, & + IO_stringValue, & + IO_error use mesh, only: & mesh_element, & mesh_NcpElems implicit none - character(len=256), dimension(:), allocatable :: & + character(len=65536), dimension(:), allocatable :: & str integer(pInt), allocatable, dimension(:,:) :: chunkPoss - integer(pInt) :: e, m, constituent, i + integer(pInt) :: e, m, c, i character(len=65536) :: & - tag,line - - line = '' ! to have it initialized - m = 0_pInt - + tag allocate(microstructure_crystallite(material_Nmicrostructure), source=0_pInt) allocate(microstructure_Nconstituents(material_Nmicrostructure), source=0_pInt) @@ -698,26 +705,24 @@ subroutine material_parseMicrostructure allocate(microstructure_fraction(microstructure_maxNconstituents,material_Nmicrostructure),source=0.0_pReal) do m=1_pInt, material_Nmicrostructure - call microstructureConfig(m)%getRaws('(constituent)',str,chunkPoss) - do constituent = 1_pInt, size(str) - do i = 2_pInt,6_pInt,2_pInt - tag = IO_stringValue(str(constituent),chunkPoss(:,constituent),i) + call microstructureConfig(m)%getRaws('(constituent)',str,chunkPoss) + do c = 1_pInt, size(str) + do i = 2_pInt,6_pInt,2_pInt + tag = IO_stringValue(str(c),chunkPoss(:,c),i) - select case (tag) - case('phase') - microstructure_phase(constituent,m) = IO_intValue(str(constituent),chunkPoss(:,constituent),i+1_pInt) - - case('texture') - microstructure_texture(constituent,m) = IO_intValue(str(constituent),chunkPoss(:,constituent),i+1_pInt) + select case (tag) + case('phase') + microstructure_phase(c,m) = IO_intValue(str(c),chunkPoss(:,c),i+1_pInt) + case('texture') + microstructure_texture(c,m) = IO_intValue(str(c),chunkPoss(:,c),i+1_pInt) + case('fraction') + microstructure_fraction(c,m) = IO_floatValue(str(c),chunkPoss(:,c),i+1_pInt) + end select + + enddo + enddo + enddo - case('fraction') - microstructure_fraction(constituent,m) = IO_floatValue(str(constituent),chunkPoss(:,constituent),i+1_pInt) - - end select - enddo -enddo -enddo - !sanity check do m = 1_pInt, material_Nmicrostructure if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) & call IO_error(153_pInt,ext_msg=microstructure_name(m)) @@ -929,49 +934,49 @@ subroutine material_parseTexture tag = IO_stringValue(line,chunkPos,j+1_pInt) select case (tag) case('x', '+x') - texture_transformation(j,1:3,section) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis + texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis case('-x') - texture_transformation(j,1:3,section) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis + texture_transformation(j,1:3,t) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis case('y', '+y') - texture_transformation(j,1:3,section) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis + texture_transformation(j,1:3,t) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis case('-y') - texture_transformation(j,1:3,section) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis + texture_transformation(j,1:3,t) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis case('z', '+z') - texture_transformation(j,1:3,section) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis + texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis case('-z') - texture_transformation(j,1:3,section) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis + texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis case default - call IO_error(157_pInt,section) + call IO_error(157_pInt,t) end select enddo - if(dNeq(math_det33(texture_transformation(1:3,1:3,section)),1.0_pReal)) & - call IO_error(157_pInt,section) + if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) & + call IO_error(157_pInt,t) case ('hybridia') textureType - texture_ODFfile(section) = IO_stringValue(line,chunkPos,2_pInt) + texture_ODFfile(t) = IO_stringValue(line,chunkPos,2_pInt) case ('symmetry') textureType tag = IO_stringValue(line,chunkPos,2_pInt) select case (tag) case('orthotropic') - texture_symmetry(section) = 4_pInt + texture_symmetry(t) = 4_pInt case('monoclinic') - texture_symmetry(section) = 2_pInt + texture_symmetry(t) = 2_pInt case default - texture_symmetry(section) = 1_pInt + texture_symmetry(t) = 1_pInt end select case ('(random)') textureType gauss = gauss + 1_pInt - texture_Gauss(1:3,gauss,section) = math_sampleRandomOri() + texture_Gauss(1:3,gauss,t) = math_sampleRandomOri() do j = 2_pInt,4_pInt,2_pInt tag = IO_stringValue(line,chunkPos,j) select case (tag) case('scatter') - texture_Gauss(4,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Gauss(4,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('fraction') - texture_Gauss(5,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt) + texture_Gauss(5,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt) end select enddo @@ -981,15 +986,15 @@ subroutine material_parseTexture tag = IO_stringValue(line,chunkPos,j) select case (tag) case('phi1') - texture_Gauss(1,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Gauss(1,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('phi') - texture_Gauss(2,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Gauss(2,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('phi2') - texture_Gauss(3,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Gauss(3,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('scatter') - texture_Gauss(4,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Gauss(4,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('fraction') - texture_Gauss(5,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt) + texture_Gauss(5,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt) end select enddo @@ -999,17 +1004,17 @@ subroutine material_parseTexture tag = IO_stringValue(line,chunkPos,j) select case (tag) case('alpha1') - texture_Fiber(1,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Fiber(1,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('alpha2') - texture_Fiber(2,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Fiber(2,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('beta1') - texture_Fiber(3,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Fiber(3,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('beta2') - texture_Fiber(4,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Fiber(4,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('scatter') - texture_Fiber(5,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Fiber(5,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad case('fraction') - texture_Fiber(6,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt) + texture_Fiber(6,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt) end select enddo end select textureType @@ -1132,10 +1137,8 @@ subroutine material_populateGrains allocate(orientationOfGrain(3,maxval(Ngrains)),source=0.0_pReal) ! reserve memory for maximum case if (iand(myDebug,debug_levelBasic) /= 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(/,a/)') ' MATERIAL grain population' write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#' - !$OMP END CRITICAL (write2out) endif homogenizationLoop: do homog = 1_pInt,material_Nhomogenization dGrains = homogenization_Ngrains(homog) ! grain number per material point @@ -1143,11 +1146,8 @@ subroutine material_populateGrains activePair: if (Ngrains(homog,micro) > 0_pInt) then myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate myNconstituents = microstructure_Nconstituents(micro) ! assign short name for number of constituents - if (iand(myDebug,debug_levelBasic) /= 0_pInt) then - !$OMP CRITICAL (write2out) - write(6,'(/,a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains - !$OMP END CRITICAL (write2out) - endif + if (iand(myDebug,debug_levelBasic) /= 0_pInt) & + write(6,'(/,a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains !-------------------------------------------------------------------------------------------------- From 940d9fcbab6f2557f4b42d8475b5bc8c3266e6cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Jun 2018 00:23:43 +0200 Subject: [PATCH 42/94] cleaning --- src/list.f90 | 194 +++++++++++++++++++++++------------------------ src/material.f90 | 56 +++++++------- 2 files changed, 124 insertions(+), 126 deletions(-) diff --git a/src/list.f90 b/src/list.f90 index b8f114f8f..8da80ab86 100644 --- a/src/list.f90 +++ b/src/list.f90 @@ -59,7 +59,7 @@ subroutine add(this,string) implicit none class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: string - type(tPartitionedStringList), pointer :: new, tmp + type(tPartitionedStringList), pointer :: new, list_tmp if (IO_isBlank(string)) return @@ -67,11 +67,11 @@ subroutine add(this,string) new%string%val=IO_lc(trim(string)) new%string%pos=IO_stringPos(trim(string)) - tmp => this - do while (associated(tmp%next)) - tmp => tmp%next + list_tmp => this + do while (associated(list_tmp%next)) + list_tmp => list_tmp%next enddo - tmp%next => new + list_tmp%next => new end subroutine add @@ -84,13 +84,13 @@ subroutine show(this) implicit none class(tPartitionedStringList) :: this - type(tPartitionedStringList), pointer :: tmp + type(tPartitionedStringList), pointer :: list_tmp - tmp => this%next + list_tmp => this%next do - if (.not. associated(tmp)) exit - write(6,'(a)') trim(tmp%string%val) - tmp => tmp%next + if (.not. associated(list_tmp)) exit + write(6,'(a)') trim(list_tmp%string%val) + list_tmp => list_tmp%next end do end subroutine show @@ -103,15 +103,15 @@ end subroutine show ! subroutine free_all() ! implicit none ! -! type(node), pointer :: tmp +! type(node), pointer :: list_tmp ! ! do -! tmp => first +! list_tmp => first ! -! if (associated(tmp) .eqv. .FALSE.) exit +! if (associated(list_tmp) .eqv. .FALSE.) exit ! ! first => first%next -! deallocate(tmp) +! deallocate(list_tmp) ! end do ! end subroutine free_all @@ -126,18 +126,18 @@ logical function keyExists(this,key) implicit none class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: tmp + type(tPartitionedStringList), pointer :: list_tmp keyExists = .false. - tmp => this%next + list_tmp => this%next do - if (.not. associated(tmp)) exit - if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + if (.not. associated(list_tmp)) exit + if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then keyExists = .true. exit endif - tmp => tmp%next + list_tmp => list_tmp%next end do end function keyExists @@ -155,18 +155,18 @@ integer(pInt) function countKeyAppearances(this,key) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: tmp + type(tPartitionedStringList), pointer :: list_tmp integer(pInt) :: i countKeyAppearances = 0_pInt - tmp => this%next + list_tmp => this%next do - if (.not. associated(tmp)) exit - if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then + if (.not. associated(list_tmp)) exit + if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then countKeyAppearances = countKeyAppearances + 1_pInt endif - tmp => tmp%next + list_tmp => list_tmp%next end do end function countKeyAppearances @@ -184,22 +184,22 @@ function strings(this) implicit none class(tPartitionedStringList), intent(in) :: this character(len=65536), dimension(:), allocatable :: strings - character(len=65536) :: stringTmp - type(tPartitionedStringList), pointer :: tmp + character(len=65536) :: string_tmp + type(tPartitionedStringList), pointer :: list_tmp - tmp => this%next + list_tmp => this%next do - if (.not. associated(tmp)) then + if (.not. associated(list_tmp)) then if(size(strings) < 0_pInt) call IO_error(142_pInt) exit endif - stringTmp = tmp%string%val + string_tmp = list_tmp%string%val GfortranBug86033: if (.not. allocated(strings)) then - allocate(strings(1),source=stringTmp) + allocate(strings(1),source=string_tmp) else GfortranBug86033 - strings = [strings,stringTmp] + strings = [strings,string_tmp] endif GfortranBug86033 - tmp => tmp%next + list_tmp => list_tmp%next end do end function strings @@ -218,17 +218,17 @@ subroutine getRaw(this,key,string,stringPos) character(len=*), intent(in) :: key integer(pInt), dimension(:), allocatable, intent(out) :: stringPos character(len=*), intent(out) :: string - type(tPartitionedStringList), pointer :: tmp + type(tPartitionedStringList), pointer :: list_tmp - tmp => this%next + list_tmp => this%next do - if (.not. associated(tmp)) call IO_error(140_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 + if (.not. associated(list_tmp)) call IO_error(140_pInt,ext_msg=key) + foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + stringPos = list_tmp%string%pos + string = list_tmp%string%val exit endif foundKey - tmp => tmp%next + list_tmp => list_tmp%next end do end subroutine getRaw @@ -249,34 +249,34 @@ subroutine getRaws(this,key,string,stringPos) integer(pInt), dimension(:,:), allocatable, intent(out) :: stringPos character(len=65536), dimension(:), allocatable, intent(out) :: string - character(len=65536) :: stringTmp + character(len=65536) :: string_tmp integer(pInt) :: posSize integer(pInt), dimension(:), allocatable :: stringPosFlat - type(tPartitionedStringList), pointer :: tmp + type(tPartitionedStringList), pointer :: list_tmp posSize = -1_pInt - tmp => this%next + list_tmp => this%next do - if (.not. associated(tmp)) then + if (.not. associated(list_tmp)) then if(posSize < 0_pInt) call IO_error(140_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 + foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then if (posSize < 0_pInt) then - posSize = size(tmp%string%pos) - stringPosFlat = tmp%string%pos + posSize = size(list_tmp%string%pos) + stringPosFlat = list_tmp%string%pos allocate(string(1)) - string(1) = tmp%string%val + string(1) = list_tmp%string%val else - if (size(tmp%string%pos) /= posSize) & - call IO_error(141_pInt,ext_msg=trim(tmp%string%val),el=posSize) - stringPosFlat = [stringPosFlat,tmp%string%pos] - stringTmp = tmp%string%val - string = [string,stringTmp] + if (size(list_tmp%string%pos) /= posSize) & + call IO_error(141_pInt,ext_msg=trim(list_tmp%string%val),el=posSize) + stringPosFlat = [stringPosFlat,list_tmp%string%pos] + string_tmp = list_tmp%string%val + string = [string,string_tmp] endif endif foundKey - tmp => tmp%next + list_tmp => list_tmp%next end do end subroutine getRaws @@ -296,11 +296,11 @@ real(pReal) function getFloat(this,key,defaultVal) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key real(pReal), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: tmp + type(tPartitionedStringList), pointer :: list_tmp - tmp => this%next + list_tmp => this%next do - endOfList: if (.not. associated(tmp)) then + endOfList: if (.not. associated(list_tmp)) then if(present(defaultVal)) then getFloat = defaultVal exit @@ -308,12 +308,12 @@ real(pReal) function getFloat(this,key,defaultVal) call IO_error(140_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(143_pInt,ext_msg=key) - getFloat = IO_FloatValue(tmp%string%val,tmp%string%pos,2) + foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + getFloat = IO_FloatValue(list_tmp%string%val,list_tmp%string%pos,2) exit endif foundKey - tmp => tmp%next + list_tmp => list_tmp%next end do end function getFloat @@ -333,11 +333,11 @@ integer(pInt) function getInt(this,key,defaultVal) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key integer(pInt), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: tmp + type(tPartitionedStringList), pointer :: list_tmp - tmp => this%next + list_tmp => this%next do - endOfList: if (.not. associated(tmp)) then + endOfList: if (.not. associated(list_tmp)) then if(present(defaultVal)) then getInt = defaultVal exit @@ -345,12 +345,12 @@ integer(pInt) function getInt(this,key,defaultVal) call IO_error(140_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(143_pInt,ext_msg=key) - getInt = IO_IntValue(tmp%string%val,tmp%string%pos,2) + foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + getInt = IO_IntValue(list_tmp%string%val,list_tmp%string%pos,2) exit endif foundKey - tmp => tmp%next + list_tmp => list_tmp%next end do end function getInt @@ -369,11 +369,11 @@ character(len=65536) function getString(this,key,defaultVal) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key character(len=65536), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: tmp + type(tPartitionedStringList), pointer :: list_tmp - tmp => this%next + list_tmp => this%next do - endOfList: if (.not. associated(tmp)) then + endOfList: if (.not. associated(list_tmp)) then if(present(defaultVal)) then getString = defaultVal exit @@ -381,12 +381,12 @@ character(len=65536) function getString(this,key,defaultVal) call IO_error(140_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(143_pInt,ext_msg=key) - getString = IO_StringValue(tmp%string%val,tmp%string%pos,2) + foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + getString = IO_StringValue(list_tmp%string%val,list_tmp%string%pos,2) exit endif foundKey - tmp => tmp%next + list_tmp => list_tmp%next end do end function getString @@ -401,19 +401,19 @@ function getStrings(this,key) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: tmp + type(tPartitionedStringList), pointer :: list_tmp integer(pInt) :: i - tmp => this%next + list_tmp => this%next do - if (.not. associated(tmp)) then + if (.not. associated(list_tmp)) then if (.not. allocated(getStrings)) allocate(getStrings(0),source=str) exit endif - 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 (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + if (list_tmp%string%pos(1) < 2) print*, "NOT WORKKING" + str = IO_StringValue(list_tmp%string%val,list_tmp%string%pos,2) GfortranBug86033: if (.not. allocated(getStrings)) then allocate(getStrings(1),source=str) @@ -421,7 +421,7 @@ function getStrings(this,key) getStrings = [getStrings,str] endif GfortranBug86033 endif - tmp => tmp%next + list_tmp => list_tmp%next end do end function @@ -442,14 +442,14 @@ function getIntArray(this,key,defaultVal) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key integer(pInt),dimension(:), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: tmp + type(tPartitionedStringList), pointer :: list_tmp integer(pInt) :: i allocate(getIntArray(0)) - tmp => this%next + list_tmp => this%next do - endOfList: if (.not. associated(tmp)) then + endOfList: if (.not. associated(list_tmp)) then if(present(defaultVal)) then getIntArray = defaultVal exit @@ -457,14 +457,14 @@ function getIntArray(this,key,defaultVal) call IO_error(140_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(143_pInt,ext_msg=key) - do i = 2_pInt, tmp%string%pos(1) - getIntArray = [getIntArray,IO_IntValue(tmp%string%val,tmp%string%pos,i)] + foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + do i = 2_pInt, list_tmp%string%pos(1) + getIntArray = [getIntArray,IO_IntValue(list_tmp%string%val,list_tmp%string%pos,i)] enddo exit endif foundKey - tmp => tmp%next + list_tmp => list_tmp%next end do end function getIntArray @@ -485,14 +485,14 @@ function getFloatArray(this,key,defaultVal) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key real(pReal),dimension(:), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: tmp + type(tPartitionedStringList), pointer :: list_tmp integer(pInt) :: i allocate(getFloatArray(0)) - tmp => this%next + list_tmp => this%next do - endOfList: if (.not. associated(tmp)) then + endOfList: if (.not. associated(list_tmp)) then if(present(defaultVal)) then getFloatArray = defaultVal exit @@ -500,14 +500,14 @@ function getFloatArray(this,key,defaultVal) call IO_error(140_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(143_pInt,ext_msg=key) - do i = 2_pInt, tmp%string%pos(1) - getFloatArray = [getFloatArray,IO_FloatValue(tmp%string%val,tmp%string%pos,i)] + foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + do i = 2_pInt, list_tmp%string%pos(1) + getFloatArray = [getFloatArray,IO_FloatValue(list_tmp%string%val,list_tmp%string%pos,i)] enddo exit endif foundKey - tmp => tmp%next + list_tmp => list_tmp%next end do end function getFloatArray diff --git a/src/material.f90 b/src/material.f90 index a0ab03c7c..3b80d62d9 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -889,14 +889,13 @@ subroutine material_parseTexture inRad, & math_sampleRandomOri, & math_I3, & - math_det33, & - math_inv33 + math_det33 implicit none integer(pInt) :: section, gauss, fiber, j, t, i - character(len=256), dimension(:), allocatable :: bla + character(len=65536), dimension(:), allocatable :: lines integer(pInt), dimension(:), allocatable :: chunkPos - character(len=65536) :: line, tag + character(len=65536) :: tag allocate(texture_ODFfile(material_Ntexture)); texture_ODFfile='' allocate(texture_symmetry(material_Ntexture), source=1_pInt) @@ -920,18 +919,17 @@ subroutine material_parseTexture section = t gauss = 0_pInt fiber = 0_pInt - bla = textureConfig(t)%getStringsRaw() + lines = textureConfig(t)%getStringsRaw() - lines: do i=1_pInt, size(bla) - line = bla(i) + do i=1_pInt, size(lines) - chunkPos = IO_stringPos(line) - tag = IO_stringValue(line,chunkPos,1_pInt) ! extract key + chunkPos = IO_stringPos(lines(i)) + tag = IO_stringValue(lines(i),chunkPos,1_pInt) ! extract key textureType: select case(tag) case ('axes', 'rotation') textureType do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries - tag = IO_stringValue(line,chunkPos,j+1_pInt) + tag = IO_stringValue(lines(i),chunkPos,j+1_pInt) select case (tag) case('x', '+x') texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis @@ -954,10 +952,10 @@ subroutine material_parseTexture call IO_error(157_pInt,t) case ('hybridia') textureType - texture_ODFfile(t) = IO_stringValue(line,chunkPos,2_pInt) + texture_ODFfile(t) = IO_stringValue(lines(i),chunkPos,2_pInt) case ('symmetry') textureType - tag = IO_stringValue(line,chunkPos,2_pInt) + tag = IO_stringValue(lines(i),chunkPos,2_pInt) select case (tag) case('orthotropic') texture_symmetry(t) = 4_pInt @@ -971,54 +969,54 @@ subroutine material_parseTexture gauss = gauss + 1_pInt texture_Gauss(1:3,gauss,t) = math_sampleRandomOri() do j = 2_pInt,4_pInt,2_pInt - tag = IO_stringValue(line,chunkPos,j) + tag = IO_stringValue(lines(i),chunkPos,j) select case (tag) case('scatter') - texture_Gauss(4,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Gauss(4,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad case('fraction') - texture_Gauss(5,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt) + texture_Gauss(5,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt) end select enddo case ('(gauss)') textureType gauss = gauss + 1_pInt do j = 2_pInt,10_pInt,2_pInt - tag = IO_stringValue(line,chunkPos,j) + tag = IO_stringValue(lines(i),chunkPos,j) select case (tag) case('phi1') - texture_Gauss(1,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Gauss(1,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad case('phi') - texture_Gauss(2,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Gauss(2,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad case('phi2') - texture_Gauss(3,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Gauss(3,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad case('scatter') - texture_Gauss(4,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Gauss(4,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad case('fraction') - texture_Gauss(5,gauss,t) = IO_floatValue(line,chunkPos,j+1_pInt) + texture_Gauss(5,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt) end select enddo case ('(fiber)') textureType fiber = fiber + 1_pInt do j = 2_pInt,12_pInt,2_pInt - tag = IO_stringValue(line,chunkPos,j) + tag = IO_stringValue(lines(i),chunkPos,j) select case (tag) case('alpha1') - texture_Fiber(1,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Fiber(1,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad case('alpha2') - texture_Fiber(2,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Fiber(2,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad case('beta1') - texture_Fiber(3,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Fiber(3,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad case('beta2') - texture_Fiber(4,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Fiber(4,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad case('scatter') - texture_Fiber(5,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad + texture_Fiber(5,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad case('fraction') - texture_Fiber(6,fiber,t) = IO_floatValue(line,chunkPos,j+1_pInt) + texture_Fiber(6,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt) end select enddo end select textureType - enddo lines + enddo enddo end subroutine material_parseTexture From 1c8c33595ee15db40f13973db6761be87ac9331b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Jun 2018 00:27:30 +0200 Subject: [PATCH 43/94] more precise name --- src/CMakeLists.txt | 2 +- src/commercialFEM_fileList.f90 | 2 +- src/{list.f90 => linked_list.f90} | 0 3 files changed, 2 insertions(+), 2 deletions(-) rename src/{list.f90 => linked_list.f90} (100%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index cb39ad363..8972f7c13 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -37,7 +37,7 @@ add_library(DEBUG OBJECT "debug.f90") add_dependencies(DEBUG NUMERICS) list(APPEND OBJECTFILES $) -add_library(CHAINED_LIST OBJECT "list.f90") +add_library(CHAINED_LIST OBJECT "linked_list.f90") add_dependencies(CHAINED_LIST DEBUG) list(APPEND OBJECTFILES $) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index a4e2ee383..cf2e3769a 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -6,7 +6,7 @@ #include "IO.f90" #include "numerics.f90" #include "debug.f90" -#include "list.f90" +#include "linked_list.f90" #include "config_material.f90" #include "math.f90" #include "FEsolving.f90" diff --git a/src/list.f90 b/src/linked_list.f90 similarity index 100% rename from src/list.f90 rename to src/linked_list.f90 From 04b8218d2cb1185c8ab1e76e287e995590cec6c7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Jun 2018 00:28:36 +0200 Subject: [PATCH 44/94] module name and file name should match --- src/config_material.f90 | 2 +- src/linked_list.f90 | 4 ++-- src/material.f90 | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/config_material.f90 b/src/config_material.f90 index 278e97659..9fcf51721 100644 --- a/src/config_material.f90 +++ b/src/config_material.f90 @@ -6,7 +6,7 @@ !! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture' !-------------------------------------------------------------------------------------------------- module config_material - use chained_list + use linked_list use prec, only: & pReal, & pInt diff --git a/src/linked_list.f90 b/src/linked_list.f90 index 8da80ab86..254c87ba4 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -2,7 +2,7 @@ !> @author Martin Dieh, Max-Planck-Institut für Eisenforschung GmbH !> @brief Chained list to store string together with position of delimiters !-------------------------------------------------------------------------------------------------- -module chained_list +module linked_list use prec, only: & pReal, & pInt @@ -513,4 +513,4 @@ end function getFloatArray -end module chained_list +end module linked_list diff --git a/src/material.f90 b/src/material.f90 index 3b80d62d9..9fbd5a83c 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -8,7 +8,7 @@ !-------------------------------------------------------------------------------------------------- module material use config_material - use chained_list + use linked_list use prec, only: & pReal, & pInt, & From ca24681c4919448891b4f3f923b539c78fffd619 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Jun 2018 00:42:42 +0200 Subject: [PATCH 45/94] variable is undefined if no echo tag is found --- src/config_material.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/config_material.f90 b/src/config_material.f90 index 9fcf51721..6a8f1a9f3 100644 --- a/src/config_material.f90 +++ b/src/config_material.f90 @@ -163,7 +163,8 @@ subroutine parseFile(sectionNames,part,fileUnit,line) character(len=65536) :: devNull character(len=64) :: tag logical :: echo - + + echo = .false. allocate(part(0)) s = 0_pInt From e29add3bce21a382642488ca5acbc9cc53a2d847 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Jun 2018 07:21:22 +0200 Subject: [PATCH 46/94] intitial values are not given by default --- src/material.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 9fbd5a83c..1a1c5c5a0 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -564,7 +564,7 @@ subroutine material_parseHomogenization homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h)) if (homogenizationConfig(h)%keyExists('thermal')) then - thermal_initialT(h) = homogenizationConfig(h)%getFloat('t0') + thermal_initialT(h) = homogenizationConfig(h)%getFloat('t0',defaultVal=300.0_pReal) tag = homogenizationConfig(h)%getString('thermal') select case (trim(tag)) @@ -581,9 +581,9 @@ subroutine material_parseHomogenization endif if (homogenizationConfig(h)%keyExists('damage')) then - damage_initialPhi(h) = homogenizationConfig(h)%getFloat('initialdamage') + damage_initialPhi(h) = homogenizationConfig(h)%getFloat('initialdamage',defaultVal=1.0_pReal) - tag = homogenizationConfig(h)%getString('thermal') + tag = homogenizationConfig(h)%getString('damage') select case (trim(tag)) case(DAMAGE_NONE_label) damage_type(h) = DAMAGE_none_ID @@ -598,7 +598,7 @@ subroutine material_parseHomogenization endif if (homogenizationConfig(h)%keyExists('vacancyflux')) then - vacancyflux_initialCv(h) = homogenizationConfig(h)%getFloat('cv0') + vacancyflux_initialCv(h) = homogenizationConfig(h)%getFloat('cv0',defaultVal=0.0_pReal) tag = homogenizationConfig(h)%getString('vacancyflux') select case (trim(tag)) @@ -630,7 +630,7 @@ subroutine material_parseHomogenization endif if (homogenizationConfig(h)%keyExists('hydrogenflux')) then - hydrogenflux_initialCh(h) = homogenizationConfig(h)%getFloat('ch0') + hydrogenflux_initialCh(h) = homogenizationConfig(h)%getFloat('ch0',defaultVal=0.0_pReal) tag = homogenizationConfig(h)%getString('hydrogenflux') select case (trim(tag)) From a11c6e0feab1f0b17efbbaac66e6b54cf2ab8c78 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Jun 2018 06:35:28 +0200 Subject: [PATCH 47/94] convention: intent(out) first, intent(in) last --- src/config_material.f90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/config_material.f90 b/src/config_material.f90 index 6a8f1a9f3..9a7d7b59c 100644 --- a/src/config_material.f90 +++ b/src/config_material.f90 @@ -98,23 +98,23 @@ subroutine config_material_init() select case (trim(part)) case (trim(material_partPhase)) - call parseFile(phase_name,phaseConfig,FILEUNIT,line) + call parseFile(line,phase_name,phaseConfig,FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) case (trim(material_partMicrostructure)) - call parseFile(microstructure_name,microstructureConfig,FILEUNIT,line) + call parseFile(line,microstructure_name,microstructureConfig,FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) case (trim(material_partCrystallite)) - call parseFile(crystallite_name,crystalliteConfig,FILEUNIT,line) + call parseFile(line,crystallite_name,crystalliteConfig,FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) case (trim(material_partHomogenization)) - call parseFile(homogenization_name,homogenizationConfig,FILEUNIT,line) + call parseFile(line,homogenization_name,homogenizationConfig,FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) case (trim(material_partTexture)) - call parseFile(texture_name,textureConfig,FILEUNIT,line) + call parseFile(line,texture_name,textureConfig,FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) case default @@ -141,7 +141,8 @@ end subroutine config_material_init !-------------------------------------------------------------------------------------------------- !> @brief parses the homogenization part in the material configuration file !-------------------------------------------------------------------------------------------------- -subroutine parseFile(sectionNames,part,fileUnit,line) +subroutine parseFile(line,& + sectionNames,part,fileUnit) use IO, only: & IO_read, & IO_error, & From 9c12ce553991058b79ed5eda9981e71de2c49353 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Jun 2018 06:39:49 +0200 Subject: [PATCH 48/94] more general name (should include parsing of debug and numerics) --- src/CMakeLists.txt | 2 +- src/CPFEM.f90 | 10 +++++----- src/CPFEM2.f90 | 10 +++++----- src/commercialFEM_fileList.f90 | 2 +- src/{config_material.f90 => config.f90} | 10 +++++----- src/constitutive.f90 | 2 +- src/crystallite.f90 | 4 ++-- src/damage_local.f90 | 2 +- src/damage_none.f90 | 2 +- src/damage_nonlocal.f90 | 2 +- src/homogenization.f90 | 2 +- src/homogenization_RGC.f90 | 2 +- src/homogenization_isostrain.f90 | 2 +- src/homogenization_none.f90 | 2 +- src/hydrogenflux_cahnhilliard.f90 | 2 +- src/hydrogenflux_isoconc.f90 | 2 +- src/kinematics_cleavage_opening.f90 | 2 +- src/kinematics_hydrogen_strain.f90 | 2 +- src/kinematics_slipplane_opening.f90 | 2 +- src/kinematics_thermal_expansion.f90 | 2 +- src/kinematics_vacancy_strain.f90 | 2 +- src/lattice.f90 | 2 +- src/material.f90 | 4 ++-- src/plastic_disloUCLA.f90 | 2 +- src/plastic_dislotwin.f90 | 2 +- src/plastic_isotropic.f90 | 2 +- src/plastic_kinematichardening.f90 | 2 +- src/plastic_nonlocal.f90 | 2 +- src/plastic_phenopowerlaw.f90 | 2 +- src/porosity_none.f90 | 2 +- src/porosity_phasefield.f90 | 2 +- src/source_damage_anisoBrittle.f90 | 2 +- src/source_damage_anisoDuctile.f90 | 2 +- src/source_damage_isoBrittle.f90 | 2 +- src/source_damage_isoDuctile.f90 | 2 +- src/source_thermal_dissipation.f90 | 2 +- src/source_thermal_externalheat.f90 | 2 +- src/source_vacancy_irradiation.f90 | 2 +- src/source_vacancy_phenoplasticity.f90 | 2 +- src/source_vacancy_thermalfluc.f90 | 2 +- src/thermal_adiabatic.f90 | 2 +- src/thermal_conduction.f90 | 2 +- src/thermal_isothermal.f90 | 2 +- src/vacancyflux_cahnhilliard.f90 | 2 +- src/vacancyflux_isochempot.f90 | 2 +- src/vacancyflux_isoconc.f90 | 2 +- 46 files changed, 60 insertions(+), 60 deletions(-) rename src/{config_material.f90 => config.f90} (98%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 8972f7c13..516747f8b 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -41,7 +41,7 @@ add_library(CHAINED_LIST OBJECT "linked_list.f90") add_dependencies(CHAINED_LIST DEBUG) list(APPEND OBJECTFILES $) -add_library(CONFIG_MATERIAL OBJECT "config_material.f90") +add_library(CONFIG_MATERIAL OBJECT "config.f90") add_dependencies(CONFIG_MATERIAL CHAINED_LIST) list(APPEND OBJECTFILES $) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index aefa1638f..6caeaf57c 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -62,8 +62,8 @@ subroutine CPFEM_initAll(el,ip) numerics_init use debug, only: & debug_init - use config_material, only: & - config_material_init + use config, only: & + config_init use FEsolving, only: & FE_init use math, only: & @@ -95,7 +95,7 @@ subroutine CPFEM_initAll(el,ip) call IO_init call numerics_init call debug_init - call config_material_init + call config_init call math_init call FE_init call mesh_init(ip, el) ! pass on coordinates to alter calcMode of first ip @@ -147,7 +147,7 @@ subroutine CPFEM_init homogState, & phase_plasticity, & plasticState - use config_material, only: & + use config, only: & material_Nhomogenization use crystallite, only: & crystallite_F0, & @@ -315,7 +315,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt THERMAL_conduction_ID, & phase_Nsources, & material_homog - use config_material, only: & + use config, only: & material_Nhomogenization use crystallite, only: & crystallite_partionedF,& diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 20c2b8674..c66aa4089 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -27,8 +27,8 @@ subroutine CPFEM_initAll(el,ip) numerics_init use debug, only: & debug_init - use config_material, only: & - config_material_init + use config, only: & + config_init use FEsolving, only: & FE_init use math, only: & @@ -66,7 +66,7 @@ subroutine CPFEM_initAll(el,ip) #endif call numerics_init call debug_init - call config_material_init + call config_init call math_init call FE_init call mesh_init(ip, el) ! pass on coordinates to alter calcMode of first ip @@ -112,7 +112,7 @@ subroutine CPFEM_init homogState, & phase_plasticity, & plasticState - use config_material, only: & + use config, only: & material_Nhomogenization use crystallite, only: & crystallite_F0, & @@ -233,7 +233,7 @@ subroutine CPFEM_age() material_phase, & phase_plasticity, & phase_Nsources - use config_material, only: & + use config, only: & material_Nhomogenization use crystallite, only: & crystallite_partionedF,& diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index cf2e3769a..372aeaab4 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -7,7 +7,7 @@ #include "numerics.f90" #include "debug.f90" #include "linked_list.f90" -#include "config_material.f90" +#include "config.f90" #include "math.f90" #include "FEsolving.f90" #include "mesh.f90" diff --git a/src/config_material.f90 b/src/config.f90 similarity index 98% rename from src/config_material.f90 rename to src/config.f90 index 9a7d7b59c..66c2f18bb 100644 --- a/src/config_material.f90 +++ b/src/config.f90 @@ -5,7 +5,7 @@ !! precedence over material.config. Stores the raw strings and the positions of delimiters for the !! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture' !-------------------------------------------------------------------------------------------------- -module config_material +module config use linked_list use prec, only: & pReal, & @@ -48,11 +48,11 @@ module config_material MATERIAL_configFile = 'material.config', & !< generic name for material configuration file MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file - public :: config_material_init + public :: config_init contains -subroutine config_material_init() +subroutine config_init() #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -136,7 +136,7 @@ subroutine config_material_init() if (material_Ntexture < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) -end subroutine config_material_init +end subroutine config_init !-------------------------------------------------------------------------------------------------- !> @brief parses the homogenization part in the material configuration file @@ -202,4 +202,4 @@ subroutine parseFile(line,& end if end subroutine parseFile -end module config_material +end module config diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 400670ce6..81a6f17b9 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -59,7 +59,7 @@ subroutine constitutive_init() IO_timeStamp use mesh, only: & FE_geomtype - use config_material, only: & + use config, only: & material_Nphase, & material_localFileExt, & phase_name, & diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 6b348a142..92fa61619 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -171,7 +171,7 @@ subroutine crystallite_init IO_write_jobFile, & IO_error use material - use config_material + use config use constitutive, only: & constitutive_initialFi, & constitutive_microstructure ! derived (shortcut) quantities of given state @@ -1238,7 +1238,7 @@ subroutine crystallite_integrateStateRK4() sourceState, & phase_Nsources, & phaseAt, phasememberAt - use config_material, only: & + use config, only: & material_Nphase use constitutive, only: & constitutive_collectDotState, & diff --git a/src/damage_local.f90 b/src/damage_local.f90 index f95a2956f..74bcb00db 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -71,7 +71,7 @@ subroutine damage_local_init(fileUnit) damageMapping, & damage, & damage_initialPhi - use config_material, only: & + use config, only: & material_partHomogenization implicit none diff --git a/src/damage_none.f90 b/src/damage_none.f90 index a3a1adde5..90b1acc72 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -26,7 +26,7 @@ subroutine damage_none_init() use IO, only: & IO_timeStamp use material - use config_material + use config implicit none integer(pInt) :: & diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 6c556bb25..6b9093ef1 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -76,7 +76,7 @@ subroutine damage_nonlocal_init(fileUnit) damageMapping, & damage, & damage_initialPhi - use config_material, only: & + use config, only: & material_partHomogenization implicit none diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 6539b19a9..b50b6ff83 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -101,7 +101,7 @@ subroutine homogenization_init crystallite_maxSizePostResults #endif use material - use config_material + use config use homogenization_none use homogenization_isostrain use homogenization_RGC diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index c48866dfe..92ea5301d 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -100,7 +100,7 @@ subroutine homogenization_RGC_init(fileUnit) FE_geomtype use IO use material - use config_material + use config implicit none integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index 4c80059eb..8ee0df73d 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -62,7 +62,7 @@ subroutine homogenization_isostrain_init(fileUnit) debug_levelBasic use IO use material - use config_material + use config implicit none integer(pInt), intent(in) :: fileUnit diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index 90d2ab6c4..c33aabe89 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -29,7 +29,7 @@ subroutine homogenization_none_init() use IO, only: & IO_timeStamp use material - use config_material + use config implicit none integer(pInt) :: & diff --git a/src/hydrogenflux_cahnhilliard.f90 b/src/hydrogenflux_cahnhilliard.f90 index 95898c86d..3a42a49e1 100644 --- a/src/hydrogenflux_cahnhilliard.f90 +++ b/src/hydrogenflux_cahnhilliard.f90 @@ -82,7 +82,7 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) hydrogenConc, & hydrogenConcRate, & hydrogenflux_initialCh - use config_material, only: & + use config, only: & material_partHomogenization, & material_partPhase diff --git a/src/hydrogenflux_isoconc.f90 b/src/hydrogenflux_isoconc.f90 index 74505fad8..836d29198 100644 --- a/src/hydrogenflux_isoconc.f90 +++ b/src/hydrogenflux_isoconc.f90 @@ -27,7 +27,7 @@ subroutine hydrogenflux_isoconc_init() use IO, only: & IO_timeStamp use material - use config_material + use config implicit none integer(pInt) :: & diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 64641f150..998b19562 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -79,7 +79,7 @@ subroutine kinematics_cleavage_opening_init(fileUnit) phase_Noutput, & KINEMATICS_cleavage_opening_label, & KINEMATICS_cleavage_opening_ID - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase use lattice, only: & diff --git a/src/kinematics_hydrogen_strain.f90 b/src/kinematics_hydrogen_strain.f90 index d0c282627..516ca286f 100644 --- a/src/kinematics_hydrogen_strain.f90 +++ b/src/kinematics_hydrogen_strain.f90 @@ -69,7 +69,7 @@ subroutine kinematics_hydrogen_strain_init(fileUnit) phase_Noutput, & KINEMATICS_hydrogen_strain_label, & KINEMATICS_hydrogen_strain_ID - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 9f20d8594..61ff84b9f 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -79,7 +79,7 @@ subroutine kinematics_slipplane_opening_init(fileUnit) phase_Noutput, & KINEMATICS_slipplane_opening_label, & KINEMATICS_slipplane_opening_ID - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase use lattice, only: & diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index bc70d57b2..3cec1da4c 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -69,7 +69,7 @@ subroutine kinematics_thermal_expansion_init(fileUnit) phase_Noutput, & KINEMATICS_thermal_expansion_label, & KINEMATICS_thermal_expansion_ID - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase diff --git a/src/kinematics_vacancy_strain.f90 b/src/kinematics_vacancy_strain.f90 index 7ee8312dc..7ecc7fe6e 100644 --- a/src/kinematics_vacancy_strain.f90 +++ b/src/kinematics_vacancy_strain.f90 @@ -69,7 +69,7 @@ subroutine kinematics_vacancy_strain_init(fileUnit) phase_Noutput, & KINEMATICS_vacancy_strain_label, & KINEMATICS_vacancy_strain_ID - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase diff --git a/src/lattice.f90 b/src/lattice.f90 index 374057381..386001c76 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1263,7 +1263,7 @@ subroutine lattice_init IO_stringPos, & IO_stringValue, & IO_floatValue - use config_material, only: & + use config, only: & material_configfile, & material_localFileExt, & material_partPhase diff --git a/src/material.f90 b/src/material.f90 index 1a1c5c5a0..edb0b9ef1 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -7,7 +7,7 @@ !! 'phase', 'texture', and 'microstucture' !-------------------------------------------------------------------------------------------------- module material - use config_material + use config use linked_list use prec, only: & pReal, & @@ -508,7 +508,7 @@ end subroutine material_init !> @brief parses the homogenization part from the material configuration !-------------------------------------------------------------------------------------------------- subroutine material_parseHomogenization - use config_material, only : & + use config, only : & homogenizationConfig use IO, only: & IO_error diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index f010b3a00..7c4d87fff 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -153,7 +153,7 @@ subroutine plastic_disloUCLA_init(fileUnit) PLASTICITY_DISLOUCLA_ID, & material_phase, & plasticState - use config_material, only: & + use config, only: & MATERIAL_partPhase use lattice use numerics,only: & diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 46f833a7f..2ed8ebfdf 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -240,7 +240,7 @@ subroutine plastic_dislotwin_init(fileUnit) PLASTICITY_DISLOTWIN_ID, & material_phase, & plasticState - use config_material, only: & + use config, only: & MATERIAL_partPhase use lattice use numerics,only: & diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 916f43ebd..ed1ac7f54 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -98,7 +98,7 @@ use IO PLASTICITY_ISOTROPIC_ID, & material_phase, & plasticState - use config_material, only: & + use config, only: & MATERIAL_partPhase, & phaseConfig diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 09eebe460..06a327247 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -146,7 +146,7 @@ subroutine plastic_kinehardening_init(fileUnit) phase_Noutput, & material_phase, & plasticState - use config_material, only: & + use config, only: & MATERIAL_partPhase use lattice use numerics,only: & diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index eb75cee96..41666a34c 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -292,7 +292,7 @@ use material, only: phase_plasticity, & PLASTICITY_NONLOCAL_ID, & plasticState, & material_phase -use config_material, only: MATERIAL_partPhase +use config, only: MATERIAL_partPhase use lattice use numerics,only: & numerics_integrator diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 8ac436ea2..8a6d8b145 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -158,7 +158,7 @@ subroutine plastic_phenopowerlaw_init(fileUnit) PLASTICITY_PHENOPOWERLAW_ID, & material_phase, & plasticState - use config_material, only: & + use config, only: & MATERIAL_partPhase use lattice use numerics,only: & diff --git a/src/porosity_none.f90 b/src/porosity_none.f90 index b94e5ca94..d8175cd9e 100644 --- a/src/porosity_none.f90 +++ b/src/porosity_none.f90 @@ -27,7 +27,7 @@ subroutine porosity_none_init() use IO, only: & IO_timeStamp use material - use config_material + use config implicit none integer(pInt) :: & diff --git a/src/porosity_phasefield.f90 b/src/porosity_phasefield.f90 index a37538c37..1975ba64c 100644 --- a/src/porosity_phasefield.f90 +++ b/src/porosity_phasefield.f90 @@ -78,7 +78,7 @@ subroutine porosity_phasefield_init(fileUnit) porosityMapping, & porosity, & porosity_initialPhi - use config_material, only: & + use config, only: & material_partHomogenization, & material_partPhase diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index e8d7f62ec..6b222c37c 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -93,7 +93,7 @@ subroutine source_damage_anisoBrittle_init(fileUnit) SOURCE_damage_anisoBrittle_ID, & material_phase, & sourceState - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase use numerics,only: & diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index c99647939..5978960fb 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -97,7 +97,7 @@ subroutine source_damage_anisoDuctile_init(fileUnit) SOURCE_damage_anisoDuctile_ID, & material_phase, & sourceState - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase use numerics,only: & diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index bb4497885..041761afe 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -83,7 +83,7 @@ subroutine source_damage_isoBrittle_init(fileUnit) SOURCE_damage_isoBrittle_ID, & material_phase, & sourceState - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase use numerics,only: & diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 6f3fa3f89..e843be728 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -83,7 +83,7 @@ subroutine source_damage_isoDuctile_init(fileUnit) SOURCE_damage_isoDuctile_ID, & material_phase, & sourceState - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index b9589d62b..994d26b41 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -69,7 +69,7 @@ subroutine source_thermal_dissipation_init(fileUnit) SOURCE_thermal_dissipation_ID, & material_phase, & sourceState - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase use numerics,only: & diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 39a23b71b..b7151aece 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -75,7 +75,7 @@ subroutine source_thermal_externalheat_init(fileUnit) SOURCE_thermal_externalheat_ID, & material_phase, & sourceState - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase use numerics,only: & diff --git a/src/source_vacancy_irradiation.f90 b/src/source_vacancy_irradiation.f90 index bc5f9a620..67b4cabcf 100644 --- a/src/source_vacancy_irradiation.f90 +++ b/src/source_vacancy_irradiation.f90 @@ -71,7 +71,7 @@ subroutine source_vacancy_irradiation_init(fileUnit) SOURCE_vacancy_irradiation_ID, & material_phase, & sourceState - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase use numerics,only: & diff --git a/src/source_vacancy_phenoplasticity.f90 b/src/source_vacancy_phenoplasticity.f90 index 0b543d19a..e20d8ec06 100644 --- a/src/source_vacancy_phenoplasticity.f90 +++ b/src/source_vacancy_phenoplasticity.f90 @@ -69,7 +69,7 @@ subroutine source_vacancy_phenoplasticity_init(fileUnit) SOURCE_vacancy_phenoplasticity_ID, & material_phase, & sourceState - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase use numerics,only: & diff --git a/src/source_vacancy_thermalfluc.f90 b/src/source_vacancy_thermalfluc.f90 index 39890e2ee..cea52aa75 100644 --- a/src/source_vacancy_thermalfluc.f90 +++ b/src/source_vacancy_thermalfluc.f90 @@ -73,7 +73,7 @@ subroutine source_vacancy_thermalfluc_init(fileUnit) SOURCE_vacancy_thermalfluc_ID, & material_phase, & sourceState - use config_material, only: & + use config, only: & material_Nphase, & MATERIAL_partPhase use numerics,only: & diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index 2b9a5ae59..6a70ca7ee 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -64,7 +64,7 @@ subroutine thermal_adiabatic_init(fileUnit) IO_error, & IO_timeStamp, & IO_EOF - use config_material, only: & + use config, only: & material_partHomogenization use material, only: & thermal_type, & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 83c776b6b..16497040b 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -78,7 +78,7 @@ subroutine thermal_conduction_init(fileUnit) thermal_initialT, & temperature, & temperatureRate - use config_material, only: & + use config, only: & material_partHomogenization implicit none diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 index 17e82c606..fb518fe24 100644 --- a/src/thermal_isothermal.f90 +++ b/src/thermal_isothermal.f90 @@ -27,7 +27,7 @@ subroutine thermal_isothermal_init() use IO, only: & IO_timeStamp use material - use config_material + use config implicit none integer(pInt) :: & diff --git a/src/vacancyflux_cahnhilliard.f90 b/src/vacancyflux_cahnhilliard.f90 index 5ea5c908a..cde2cb233 100644 --- a/src/vacancyflux_cahnhilliard.f90 +++ b/src/vacancyflux_cahnhilliard.f90 @@ -92,7 +92,7 @@ subroutine vacancyflux_cahnhilliard_init(fileUnit) vacancyConc, & vacancyConcRate, & vacancyflux_initialCv - use config_material, only: & + use config, only: & material_partPhase, & material_partHomogenization diff --git a/src/vacancyflux_isochempot.f90 b/src/vacancyflux_isochempot.f90 index 6216c03cf..761a0ba22 100644 --- a/src/vacancyflux_isochempot.f90 +++ b/src/vacancyflux_isochempot.f90 @@ -75,7 +75,7 @@ subroutine vacancyflux_isochempot_init(fileUnit) vacancyConc, & vacancyConcRate, & vacancyflux_initialCv - use config_material, only: & + use config, only: & material_partHomogenization implicit none diff --git a/src/vacancyflux_isoconc.f90 b/src/vacancyflux_isoconc.f90 index bc66e2df9..135509aa1 100644 --- a/src/vacancyflux_isoconc.f90 +++ b/src/vacancyflux_isoconc.f90 @@ -27,7 +27,7 @@ subroutine vacancyflux_isoconc_init() use IO, only: & IO_timeStamp use material - use config_material + use config implicit none integer(pInt) :: & From 05ac53430e9f8b24a14ae3507fef7743da943330 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Jun 2018 08:32:02 +0200 Subject: [PATCH 49/94] always using last key in list to be compatible with convention --- src/linked_list.f90 | 56 ++++++++++++++++++++++++++------------------- 1 file changed, 32 insertions(+), 24 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index 254c87ba4..ffce7f422 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -297,25 +297,26 @@ real(pReal) function getFloat(this,key,defaultVal) character(len=*), intent(in) :: key real(pReal), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: list_tmp + logical :: found + found = merge(.true.,.false.,present(defaultVal)) + if (present(defaultVal)) getFloat = defaultVal list_tmp => this%next + do endOfList: if (.not. associated(list_tmp)) then - if(present(defaultVal)) then - getFloat = defaultVal - exit - else - call IO_error(140_pInt,ext_msg=key) - endif + if(.not. found) call IO_error(140_pInt,ext_msg=key) + exit endif endOfList foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + found = .true. if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) getFloat = IO_FloatValue(list_tmp%string%val,list_tmp%string%pos,2) - exit endif foundKey list_tmp => list_tmp%next end do + end function getFloat @@ -334,21 +335,21 @@ integer(pInt) function getInt(this,key,defaultVal) character(len=*), intent(in) :: key integer(pInt), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: list_tmp + logical :: found + found = merge(.true.,.false.,present(defaultVal)) + if (present(defaultVal)) getInt = defaultVal list_tmp => this%next + do endOfList: if (.not. associated(list_tmp)) then - if(present(defaultVal)) then - getInt = defaultVal - exit - else - call IO_error(140_pInt,ext_msg=key) - endif + if(.not. found) call IO_error(140_pInt,ext_msg=key) + exit endif endOfList foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + found = .true. if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) getInt = IO_IntValue(list_tmp%string%val,list_tmp%string%pos,2) - exit endif foundKey list_tmp => list_tmp%next end do @@ -360,7 +361,7 @@ 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) +character(len=65536) function getString(this,key,defaultVal,raw) use IO, only: & IO_error, & IO_stringValue @@ -369,22 +370,29 @@ character(len=65536) function getString(this,key,defaultVal) 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 :: list_tmp + logical :: split + logical :: found + found = merge(.true.,.false.,present(defaultVal)) + if (present(defaultVal)) getString = defaultVal + split = merge(raw,.false.,present(raw)) list_tmp => this%next + do endOfList: if (.not. associated(list_tmp)) then - if(present(defaultVal)) then - getString = defaultVal - exit - else - call IO_error(140_pInt,ext_msg=key) - endif + if(.not. found) call IO_error(140_pInt,ext_msg=key) + exit endif endOfList foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then - if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - getString = IO_StringValue(list_tmp%string%val,list_tmp%string%pos,2) - exit + found = .true. + if (split) then + if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + getString = IO_StringValue(list_tmp%string%val,list_tmp%string%pos,2) + else + getString = list_tmp%string%val(list_tmp%string%pos(3):) + endif endif foundKey list_tmp => list_tmp%next end do From 877481811bd86a5e336ada8ca39045a88744c9a4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Jun 2018 18:25:16 +0200 Subject: [PATCH 50/94] old statement was overcomplex --- src/linked_list.f90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index ffce7f422..78e38d0da 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -299,7 +299,7 @@ real(pReal) function getFloat(this,key,defaultVal) type(tPartitionedStringList), pointer :: list_tmp logical :: found - found = merge(.true.,.false.,present(defaultVal)) + found = present(defaultVal) if (present(defaultVal)) getFloat = defaultVal list_tmp => this%next @@ -316,7 +316,6 @@ real(pReal) function getFloat(this,key,defaultVal) list_tmp => list_tmp%next end do - end function getFloat @@ -337,7 +336,7 @@ integer(pInt) function getInt(this,key,defaultVal) type(tPartitionedStringList), pointer :: list_tmp logical :: found - found = merge(.true.,.false.,present(defaultVal)) + found = present(defaultVal) if (present(defaultVal)) getInt = defaultVal list_tmp => this%next @@ -375,7 +374,7 @@ character(len=65536) function getString(this,key,defaultVal,raw) logical :: split logical :: found - found = merge(.true.,.false.,present(defaultVal)) + found = present(defaultVal) if (present(defaultVal)) getString = defaultVal split = merge(raw,.false.,present(raw)) list_tmp => this%next From 7388cbb940a5bd31ee1e829a559117edc890ec81 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Jun 2018 20:39:23 +0200 Subject: [PATCH 51/94] 'split' should be default, wrong position in stringPos --- src/linked_list.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index 78e38d0da..fe5ae0e35 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -376,7 +376,7 @@ character(len=65536) function getString(this,key,defaultVal,raw) found = present(defaultVal) if (present(defaultVal)) getString = defaultVal - split = merge(raw,.false.,present(raw)) + split = merge(raw,.true.,present(raw)) list_tmp => this%next do @@ -390,7 +390,7 @@ character(len=65536) function getString(this,key,defaultVal,raw) if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) getString = IO_StringValue(list_tmp%string%val,list_tmp%string%pos,2) else - getString = list_tmp%string%val(list_tmp%string%pos(3):) + getString = trim(list_tmp%string%val(list_tmp%string%pos(4):)) endif endif foundKey list_tmp => list_tmp%next From 999d0d774e001feea640edf4f96debdf883621e1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Jun 2018 19:23:04 +0200 Subject: [PATCH 52/94] first try of unifying getInts and getIntArray --- src/linked_list.f90 | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index fe5ae0e35..5bb3ba33c 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -433,7 +433,6 @@ function getStrings(this,key) end function - !-------------------------------------------------------------------------------------------------- !> @brief gets array of int values for given key !> @details if key is not found exits with error unless default is given @@ -451,25 +450,34 @@ function getIntArray(this,key,defaultVal) integer(pInt),dimension(:), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: list_tmp integer(pInt) :: i + logical :: found + logical :: cumulative - allocate(getIntArray(0)) + cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') + found = present(defaultVal) + + if (present(defaultVal)) then + getIntArray = defaultVal + else + allocate(getIntArray(0)) + endif list_tmp => this%next do endOfList: if (.not. associated(list_tmp)) then - if(present(defaultVal)) then - getIntArray = defaultVal - exit - else - call IO_error(140_pInt,ext_msg=key) - endif + if(.not. found) call IO_error(140_pInt,ext_msg=key) + exit endif endOfList foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + if (.not. cumulative) then + deallocate(getIntArray) ! use here rhs allocation with empty list + allocate(getIntArray(0)) + endif + found = .true. if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) do i = 2_pInt, list_tmp%string%pos(1) getIntArray = [getIntArray,IO_IntValue(list_tmp%string%val,list_tmp%string%pos,i)] enddo - exit endif foundKey list_tmp => list_tmp%next end do From 0e4379f7eced07b687b1372ac5cd6057afe89813 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 15 Jun 2018 20:42:28 +0200 Subject: [PATCH 53/94] straightened out logic and variable naming --- src/linked_list.f90 | 296 ++++++++++++++++++++++---------------------- 1 file changed, 146 insertions(+), 150 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index 5bb3ba33c..9acee4a12 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -10,19 +10,19 @@ module linked_list implicit none private type, private :: tPartitionedString - character(len=:), allocatable :: val + character(len=:), allocatable :: val integer(pInt), dimension(:), allocatable :: pos end type tPartitionedString type, public :: tPartitionedStringList - type(tPartitionedString) :: string + type(tPartitionedString) :: string type(tPartitionedStringList), pointer :: next => null() type(tPartitionedStringList), pointer :: prev => null() contains procedure :: add => add procedure :: show => show - procedure :: keyExists => keyExists + procedure :: keyExists => exist procedure :: countKeys => countKeyAppearances procedure :: getStringsRaw => strings @@ -59,19 +59,19 @@ subroutine add(this,string) implicit none class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: string - type(tPartitionedStringList), pointer :: new, list_tmp + 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)) + new%string%val = IO_lc (trim(string)) + new%string%pos = IO_stringPos(trim(string)) - list_tmp => this - do while (associated(list_tmp%next)) - list_tmp => list_tmp%next + item => this + do while (associated(item%next)) + item => item%next enddo - list_tmp%next => new + item%next => new end subroutine add @@ -84,13 +84,12 @@ subroutine show(this) implicit none class(tPartitionedStringList) :: this - type(tPartitionedStringList), pointer :: list_tmp + type(tPartitionedStringList), pointer :: item - list_tmp => this%next - do - if (.not. associated(list_tmp)) exit - write(6,'(a)') trim(list_tmp%string%val) - list_tmp => list_tmp%next + item => this%next + do while (associated(item)) + write(6,'(a)') trim(item%string%val) + item => item%next end do end subroutine show @@ -103,15 +102,15 @@ end subroutine show ! subroutine free_all() ! implicit none ! -! type(node), pointer :: list_tmp +! type(node), pointer :: item ! ! do -! list_tmp => first +! item => first ! -! if (associated(list_tmp) .eqv. .FALSE.) exit +! if (associated(item) .eqv. .FALSE.) exit ! ! first => first%next -! deallocate(list_tmp) +! deallocate(item) ! end do ! end subroutine free_all @@ -119,28 +118,24 @@ end subroutine show !-------------------------------------------------------------------------------------------------- !> @brief reports wether a given key (string value at first position) exists in the list !-------------------------------------------------------------------------------------------------- -logical function keyExists(this,key) +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 :: list_tmp + type(tPartitionedStringList), pointer :: item - keyExists = .false. + exist = .false. - list_tmp => this%next - do - if (.not. associated(list_tmp)) exit - if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then - keyExists = .true. - exit - endif - list_tmp => list_tmp%next + 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 keyExists +end function exist !-------------------------------------------------------------------------------------------------- @@ -155,18 +150,17 @@ integer(pInt) function countKeyAppearances(this,key) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: list_tmp + type(tPartitionedStringList), pointer :: item integer(pInt) :: i countKeyAppearances = 0_pInt - list_tmp => this%next - do - if (.not. associated(list_tmp)) exit - if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + item => this%next + do while (associated(item)) + if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then countKeyAppearances = countKeyAppearances + 1_pInt endif - list_tmp => list_tmp%next + item => item%next end do end function countKeyAppearances @@ -184,23 +178,21 @@ function strings(this) implicit none class(tPartitionedStringList), intent(in) :: this character(len=65536), dimension(:), allocatable :: strings - character(len=65536) :: string_tmp - type(tPartitionedStringList), pointer :: list_tmp + character(len=65536) :: string + type(tPartitionedStringList), pointer :: item - list_tmp => this%next - do - if (.not. associated(list_tmp)) then - if(size(strings) < 0_pInt) call IO_error(142_pInt) - exit - endif - string_tmp = list_tmp%string%val - GfortranBug86033: if (.not. allocated(strings)) then - allocate(strings(1),source=string_tmp) - else GfortranBug86033 - strings = [strings,string_tmp] - endif GfortranBug86033 - list_tmp => list_tmp%next + 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) + end function strings @@ -218,18 +210,21 @@ subroutine getRaw(this,key,string,stringPos) character(len=*), intent(in) :: key integer(pInt), dimension(:), allocatable, intent(out) :: stringPos character(len=*), intent(out) :: string - type(tPartitionedStringList), pointer :: list_tmp - - list_tmp => this%next - do - if (.not. associated(list_tmp)) call IO_error(140_pInt,ext_msg=key) - foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then - stringPos = list_tmp%string%pos - string = list_tmp%string%val - exit - endif foundKey - list_tmp => list_tmp%next + type(tPartitionedStringList), pointer :: item + logical :: found + + found = .false. + item => this%next + do while (associated(item) .and. .not. found) + found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) + if (found) then + stringPos = item%string%pos + string = item%string%val + endif + item => item%next end do + if (.not. found) call IO_error(140_pInt,ext_msg=key) + end subroutine getRaw @@ -252,31 +247,31 @@ subroutine getRaws(this,key,string,stringPos) character(len=65536) :: string_tmp integer(pInt) :: posSize integer(pInt), dimension(:), allocatable :: stringPosFlat - type(tPartitionedStringList), pointer :: list_tmp + type(tPartitionedStringList), pointer :: item posSize = -1_pInt - list_tmp => this%next + item => this%next do - if (.not. associated(list_tmp)) then + if (.not. associated(item)) then if(posSize < 0_pInt) call IO_error(140_pInt,ext_msg=key) stringPos = reshape(stringPosFlat,[posSize,size(string)]) exit endif - foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + foundKey: if (trim(IO_stringValue(item%string%val,item%string%pos,1))==trim(key)) then if (posSize < 0_pInt) then - posSize = size(list_tmp%string%pos) - stringPosFlat = list_tmp%string%pos + posSize = size(item%string%pos) + stringPosFlat = item%string%pos allocate(string(1)) - string(1) = list_tmp%string%val + string(1) = item%string%val else - if (size(list_tmp%string%pos) /= posSize) & - call IO_error(141_pInt,ext_msg=trim(list_tmp%string%val),el=posSize) - stringPosFlat = [stringPosFlat,list_tmp%string%pos] - string_tmp = list_tmp%string%val + if (size(item%string%pos) /= posSize) & + call IO_error(141_pInt,ext_msg=trim(item%string%val),el=posSize) + stringPosFlat = [stringPosFlat,item%string%pos] + string_tmp = item%string%val string = [string,string_tmp] endif endif foundKey - list_tmp => list_tmp%next + item => item%next end do end subroutine getRaws @@ -296,26 +291,24 @@ real(pReal) function getFloat(this,key,defaultVal) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key real(pReal), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: list_tmp + type(tPartitionedStringList), pointer :: item logical :: found - found = present(defaultVal) if (present(defaultVal)) getFloat = defaultVal - list_tmp => this%next + found = .false. + item => this%next - do - endOfList: if (.not. associated(list_tmp)) then - if(.not. found) call IO_error(140_pInt,ext_msg=key) - exit - endif endOfList - foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then - found = .true. - if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - getFloat = IO_FloatValue(list_tmp%string%val,list_tmp%string%pos,2) - endif foundKey - list_tmp => list_tmp%next + do while (associated(item) .and. .not. found) + found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) + if (found) then + 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 .and. .not. present(defaultVal)) call IO_error(140_pInt,ext_msg=key) + end function getFloat @@ -333,26 +326,24 @@ integer(pInt) function getInt(this,key,defaultVal) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key integer(pInt), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: list_tmp + type(tPartitionedStringList), pointer :: item logical :: found - found = present(defaultVal) if (present(defaultVal)) getInt = defaultVal - list_tmp => this%next + found = .false. + item => this%next - do - endOfList: if (.not. associated(list_tmp)) then - if(.not. found) call IO_error(140_pInt,ext_msg=key) - exit - endif endOfList - foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then - found = .true. - if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - getInt = IO_IntValue(list_tmp%string%val,list_tmp%string%pos,2) - endif foundKey - list_tmp => list_tmp%next + do while (associated(item) .and. .not. found) + found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) + if (found) then + 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 .and. .not. present(defaultVal)) call IO_error(140_pInt,ext_msg=key) + end function getInt @@ -370,35 +361,39 @@ character(len=65536) function getString(this,key,defaultVal,raw) character(len=*), intent(in) :: key character(len=65536), intent(in), optional :: defaultVal logical, intent(in), optional :: raw - type(tPartitionedStringList), pointer :: list_tmp + type(tPartitionedStringList), pointer :: item logical :: split logical :: found found = present(defaultVal) if (present(defaultVal)) getString = defaultVal split = merge(raw,.true.,present(raw)) - list_tmp => this%next + item => this%next do - endOfList: if (.not. associated(list_tmp)) then + endOfList: if (.not. associated(item)) then if(.not. found) call IO_error(140_pInt,ext_msg=key) exit endif endOfList - foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + foundKey: if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (split) then - if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - getString = IO_StringValue(list_tmp%string%val,list_tmp%string%pos,2) + if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + getString = IO_StringValue(item%string%val,item%string%pos,2) else - getString = trim(list_tmp%string%val(list_tmp%string%pos(4):)) + getString = trim(item%string%val(item%string%pos(4):)) endif endif foundKey - list_tmp => list_tmp%next + item => item%next end do end function getString +!-------------------------------------------------------------------------------------------------- +!> @brief ... +!> @details ... +!-------------------------------------------------------------------------------------------------- function getStrings(this,key) use IO @@ -447,14 +442,14 @@ function getIntArray(this,key,defaultVal) 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 :: list_tmp - integer(pInt) :: i + integer(pInt), dimension(:), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + integer(pInt) :: i logical :: found logical :: cumulative cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - found = present(defaultVal) + found = .false. if (present(defaultVal)) then getIntArray = defaultVal @@ -462,25 +457,24 @@ function getIntArray(this,key,defaultVal) allocate(getIntArray(0)) endif - list_tmp => this%next - do - endOfList: if (.not. associated(list_tmp)) then - if(.not. found) call IO_error(140_pInt,ext_msg=key) - exit - endif endOfList - foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then + item => this%next + do while (associated(item) .and. (.not. found .or. cumulative)) + found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) + if (found) then if (.not. cumulative) then deallocate(getIntArray) ! use here rhs allocation with empty list allocate(getIntArray(0)) endif - found = .true. - if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - do i = 2_pInt, list_tmp%string%pos(1) - getIntArray = [getIntArray,IO_IntValue(list_tmp%string%val,list_tmp%string%pos,i)] + if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + do i = 2_pInt, item%string%pos(1) + getIntArray = [getIntArray,IO_IntValue(item%string%val,item%string%pos,i)] enddo - endif foundKey - list_tmp => list_tmp%next + endif + item => item%next end do + + if (.not. found .and. .not. present(defaultVal)) call IO_error(140_pInt,ext_msg=key) + end function getIntArray @@ -499,31 +493,33 @@ function getFloatArray(this,key,defaultVal) 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 :: list_tmp - integer(pInt) :: i + real(pReal), dimension(:), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + integer(pInt) :: i + logical :: found - allocate(getFloatArray(0)) + found = .false. - list_tmp => this%next - do - endOfList: if (.not. associated(list_tmp)) then - if(present(defaultVal)) then - getFloatArray = defaultVal - exit - else - call IO_error(140_pInt,ext_msg=key) - endif - endif endOfList - foundKey: if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then - if (list_tmp%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) - do i = 2_pInt, list_tmp%string%pos(1) - getFloatArray = [getFloatArray,IO_FloatValue(list_tmp%string%val,list_tmp%string%pos,i)] + if (present(defaultVal)) then + getFloatArray = defaultVal + else + allocate(getFloatArray(0)) + endif + + item => this%next + do while (associated(item) .and. .not. found) + found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) + if (found) then + if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) + do i = 2_pInt, item%string%pos(1) + getFloatArray = [getFloatArray,IO_FloatValue(item%string%val,item%string%pos,i)] enddo - exit - endif foundKey - list_tmp => list_tmp%next + endif + item => item%next end do + + if (.not. found .and. .not. present(defaultVal)) call IO_error(140_pInt,ext_msg=key) + end function getFloatArray From d6d1439f529ec620c4e2a435d059bf6fd5aa73c2 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Sat, 16 Jun 2018 17:44:27 +0200 Subject: [PATCH 54/94] more polishing, getStrings seems still somewhat murky... return lengths of strings are still inconsistent (64 and 65536) --- src/linked_list.f90 | 93 ++++++++++++++++++++++----------------------- 1 file changed, 46 insertions(+), 47 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index 9acee4a12..3099d5251 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -23,7 +23,7 @@ module linked_list procedure :: show => show procedure :: keyExists => exist - procedure :: countKeys => countKeyAppearances + procedure :: countKeys => count procedure :: getStringsRaw => strings procedure :: getRaw => getRaw @@ -139,10 +139,10 @@ end function exist !-------------------------------------------------------------------------------------------------- -!> @brief prints all elements -!> @details Strings are printed in order of insertion (FIFO) +!> @brief count number of key appearances +!> @details traverses list and counts each occurrence of specified key !-------------------------------------------------------------------------------------------------- -integer(pInt) function countKeyAppearances(this,key) +integer(pInt) function count(this,key) use IO, only: & IO_stringValue @@ -153,17 +153,16 @@ integer(pInt) function countKeyAppearances(this,key) type(tPartitionedStringList), pointer :: item integer(pInt) :: i - countKeyAppearances = 0_pInt + count = 0_pInt item => this%next do while (associated(item)) - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - countKeyAppearances = countKeyAppearances + 1_pInt - endif + if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) & + count = count + 1_pInt item => item%next end do -end function countKeyAppearances +end function count !-------------------------------------------------------------------------------------------------- @@ -191,7 +190,8 @@ function strings(this) endif GfortranBug86033 item => item%next end do - if (size(strings) < 0_pInt) call IO_error(142_pInt) + + if (size(strings) < 0_pInt) call IO_error(142_pInt) ! better to check for "allocated"? end function strings @@ -208,12 +208,13 @@ subroutine getRaw(this,key,string,stringPos) 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 :: item + integer(pInt), dimension(:), allocatable, intent(out) :: stringPos + type(tPartitionedStringList), pointer :: item logical :: found found = .false. + item => this%next do while (associated(item) .and. .not. found) found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) @@ -223,6 +224,7 @@ subroutine getRaw(this,key,string,stringPos) endif item => item%next end do + if (.not. found) call IO_error(140_pInt,ext_msg=key) end subroutine getRaw @@ -230,8 +232,8 @@ end subroutine getRaw !-------------------------------------------------------------------------------------------------- !> @brief gets all strings that matches given key (i.e. first chunk) -!> @details returns raw strings and start/end positions of chunks in these strings. Will fail if -! number of positions in strings differs +!> @details returns raw strings and start/end positions of chunks in these strings. +! Will fail if number of positions in strings differs. !-------------------------------------------------------------------------------------------------- subroutine getRaws(this,key,string,stringPos) use IO, only: & @@ -241,8 +243,8 @@ subroutine getRaws(this,key,string,stringPos) implicit none class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key - integer(pInt), dimension(:,:), allocatable, intent(out) :: stringPos character(len=65536), dimension(:), allocatable, intent(out) :: string + integer(pInt), dimension(:,:), allocatable, intent(out) :: stringPos character(len=65536) :: string_tmp integer(pInt) :: posSize @@ -253,7 +255,7 @@ subroutine getRaws(this,key,string,stringPos) item => this%next do if (.not. associated(item)) then - if(posSize < 0_pInt) call IO_error(140_pInt,ext_msg=key) + if (posSize < 0_pInt) call IO_error(140_pInt,ext_msg=key) stringPos = reshape(stringPosFlat,[posSize,size(string)]) exit endif @@ -296,8 +298,8 @@ real(pReal) function getFloat(this,key,defaultVal) if (present(defaultVal)) getFloat = defaultVal found = .false. + item => this%next - do while (associated(item) .and. .not. found) found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) if (found) then @@ -331,8 +333,8 @@ integer(pInt) function getInt(this,key,defaultVal) if (present(defaultVal)) getInt = defaultVal found = .false. + item => this%next - do while (associated(item) .and. .not. found) found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) if (found) then @@ -362,31 +364,29 @@ character(len=65536) function getString(this,key,defaultVal,raw) character(len=65536), intent(in), optional :: defaultVal logical, intent(in), optional :: raw type(tPartitionedStringList), pointer :: item - logical :: split - logical :: found + logical :: found, & + split - found = present(defaultVal) if (present(defaultVal)) getString = defaultVal - split = merge(raw,.true.,present(raw)) - item => this%next + split = merge(raw,.true.,present(raw)) + found = .false. - do - endOfList: if (.not. associated(item)) then - if(.not. found) call IO_error(140_pInt,ext_msg=key) - exit - endif endOfList - foundKey: if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - found = .true. + item => this%next + do while (associated(item) .and. .not. found) + found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) + if (found) then if (split) then if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) getString = IO_StringValue(item%string%val,item%string%pos,2) else - getString = trim(item%string%val(item%string%pos(4):)) + getString = trim(item%string%val(item%string%pos(4):)) ! raw string starting a second chunk endif - endif foundKey + endif item => item%next end do + if (.not. found .and. .not. present(defaultVal)) call IO_error(140_pInt,ext_msg=key) + end function getString @@ -398,24 +398,23 @@ function getStrings(this,key) use IO implicit none - character(len=64),dimension(:),allocatable :: getStrings - character(len=64) :: str - - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: list_tmp - integer(pInt) :: i + character(len=64),dimension(:), allocatable :: getStrings + class(tPartitionedStringList), intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: item + character(len=64) :: str + integer(pInt) :: i - list_tmp => this%next + item => this%next do - if (.not. associated(list_tmp)) then + if (.not. associated(item)) then if (.not. allocated(getStrings)) allocate(getStrings(0),source=str) exit endif - if (trim(IO_stringValue(list_tmp%string%val,list_tmp%string%pos,1))==trim(key)) then - if (list_tmp%string%pos(1) < 2) print*, "NOT WORKKING" - str = IO_StringValue(list_tmp%string%val,list_tmp%string%pos,2) + if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then + if (item%string%pos(1) < 2) print*, "NOT WORKING" + str = IO_StringValue(item%string%val,item%string%pos,2) GfortranBug86033: if (.not. allocated(getStrings)) then allocate(getStrings(1),source=str) @@ -423,7 +422,7 @@ function getStrings(this,key) getStrings = [getStrings,str] endif GfortranBug86033 endif - list_tmp => list_tmp%next + item => item%next end do end function @@ -445,8 +444,8 @@ function getIntArray(this,key,defaultVal) integer(pInt), dimension(:), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: item integer(pInt) :: i - logical :: found - logical :: cumulative + logical :: found, & + cumulative cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') found = .false. From 674d2ea61ae655e8aa9b7aa2e9509cad852061fc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 18 Jun 2018 16:04:58 +0200 Subject: [PATCH 55/94] getting tests to run after seaborn update --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 701d63b0e..aead92902 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 701d63b0e11a653797afe260d1dfc12e2a390d6f +Subproject commit aead92902b3a0cf3404be9c552bfec918d7aaffb From 8739bada26ed574a72a6bb73a5c23bb083e8f454 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 13:08:14 +0200 Subject: [PATCH 56/94] always search for last occurrence --- src/linked_list.f90 | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index 3099d5251..a6f22256b 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -297,19 +297,19 @@ real(pReal) function getFloat(this,key,defaultVal) logical :: found if (present(defaultVal)) getFloat = defaultVal - found = .false. + found = present(defaultVal) item => this%next - do while (associated(item) .and. .not. found) - found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) - if (found) then + 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 .and. .not. present(defaultVal)) call IO_error(140_pInt,ext_msg=key) + if (.not. found) call IO_error(140_pInt,ext_msg=key) end function getFloat @@ -332,19 +332,19 @@ integer(pInt) function getInt(this,key,defaultVal) logical :: found if (present(defaultVal)) getInt = defaultVal - found = .false. + found = present(defaultVal) item => this%next - do while (associated(item) .and. .not. found) - found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) - if (found) then + 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 .and. .not. present(defaultVal)) call IO_error(140_pInt,ext_msg=key) + if (.not. found) call IO_error(140_pInt,ext_msg=key) end function getInt @@ -369,12 +369,12 @@ character(len=65536) function getString(this,key,defaultVal,raw) if (present(defaultVal)) getString = defaultVal split = merge(raw,.true.,present(raw)) - found = .false. + found = present(defaultVal) item => this%next - do while (associated(item) .and. .not. found) - found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) - if (found) then + do while (associated(item)) + if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then + found = .true. if (split) then if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) getString = IO_StringValue(item%string%val,item%string%pos,2) @@ -385,7 +385,7 @@ character(len=65536) function getString(this,key,defaultVal,raw) item => item%next end do - if (.not. found .and. .not. present(defaultVal)) call IO_error(140_pInt,ext_msg=key) + if (.not. found) call IO_error(140_pInt,ext_msg=key) end function getString From 3b676af215cc20f355400c63f367a0a20777d9e5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 13:08:14 +0200 Subject: [PATCH 57/94] always search for last occurrence --- src/linked_list.f90 | 65 ++++++++++++++++++++++++--------------------- 1 file changed, 34 insertions(+), 31 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index a6f22256b..2c864a07f 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -17,7 +17,6 @@ module linked_list type, public :: tPartitionedStringList type(tPartitionedString) :: string type(tPartitionedStringList), pointer :: next => null() - type(tPartitionedStringList), pointer :: prev => null() contains procedure :: add => add procedure :: show => show @@ -30,10 +29,10 @@ module linked_list procedure :: getRaws => getRaws procedure :: getFloat => getFloat - procedure :: getFloatArray => getFloatArray + procedure :: getFloatArray => getFloats procedure :: getInt => getInt - procedure :: getIntArray => getIntArray + procedure :: getIntArray => getInts procedure :: getString => getString procedure :: getStrings => getStrings @@ -431,14 +430,14 @@ end function !> @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) +function getInts(this,key,defaultVal) use IO, only: & IO_error, & IO_stringValue, & IO_IntValue implicit none - integer(pInt), dimension(:), allocatable :: getIntArray + integer(pInt), dimension(:), allocatable :: getInts class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key integer(pInt), dimension(:), intent(in), optional :: defaultVal @@ -448,79 +447,83 @@ function getIntArray(this,key,defaultVal) cumulative cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - found = .false. + found = present(defaultVal) if (present(defaultVal)) then - getIntArray = defaultVal + getInts = defaultVal else - allocate(getIntArray(0)) + allocate(getInts(0)) endif item => this%next - do while (associated(item) .and. (.not. found .or. cumulative)) - found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) - if (found) then + 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(getIntArray) ! use here rhs allocation with empty list - allocate(getIntArray(0)) + 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) - getIntArray = [getIntArray,IO_IntValue(item%string%val,item%string%pos,i)] + getInts = [getInts,IO_IntValue(item%string%val,item%string%pos,i)] enddo endif item => item%next end do - if (.not. found .and. .not. present(defaultVal)) call IO_error(140_pInt,ext_msg=key) - -end function getIntArray + 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 getFloatArray(this,key,defaultVal) +function getFloats(this,key,defaultVal) use IO, only: & IO_error, & IO_stringValue, & IO_FloatValue implicit none - real(pReal), dimension(:), allocatable :: getFloatArray + real(pReal), dimension(:), allocatable :: getFloats class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key - real(pReal), dimension(:), intent(in), optional :: defaultVal + integer(pInt), dimension(:), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: item integer(pInt) :: i - logical :: found + logical :: found, & + cumulative - found = .false. + cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') + found = present(defaultVal) if (present(defaultVal)) then - getFloatArray = defaultVal + getFloats = defaultVal else - allocate(getFloatArray(0)) + allocate(getFloats(0)) endif item => this%next - do while (associated(item) .and. .not. found) - found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) - if (found) then + 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) - getFloatArray = [getFloatArray,IO_FloatValue(item%string%val,item%string%pos,i)] + getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)] enddo endif item => item%next end do - if (.not. found .and. .not. present(defaultVal)) call IO_error(140_pInt,ext_msg=key) - -end function getFloatArray + if (.not. found) call IO_error(140_pInt,ext_msg=key) +end function getFloats end module linked_list From 8d5d3060767fc0012d48a5c0f75dc07dd6662631 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 18:02:18 +0200 Subject: [PATCH 58/94] getStrings has functionality for multiple entries in a row of cumulative searches --- src/linked_list.f90 | 85 ++++++++++++++++++++++++++++++--------------- 1 file changed, 57 insertions(+), 28 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index 2c864a07f..c91d3dad3 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -374,11 +374,12 @@ character(len=65536) function getString(this,key,defaultVal,raw) 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 - if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) 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 + getString = trim(item%string%val(item%string%pos(4):)) ! raw string starting a second chunk endif endif item => item%next @@ -393,36 +394,64 @@ end function getString !> @brief ... !> @details ... !-------------------------------------------------------------------------------------------------- -function getStrings(this,key) - use IO +function getStrings(this,key,defaultVal,raw) + use IO - implicit none - character(len=64),dimension(:), allocatable :: getStrings - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: item - character(len=64) :: str - integer(pInt) :: i + 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(raw,.true.,present(raw)) + found = present(defaultVal) + + if (present(defaultVal)) getStrings = defaultVal - item => this%next - do - if (.not. associated(item)) then - if (.not. allocated(getStrings)) allocate(getStrings(0),source=str) - exit - endif - if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then - if (item%string%pos(1) < 2) print*, "NOT WORKING" - str = IO_StringValue(item%string%val,item%string%pos,2) + 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 (.not. found) call IO_error(140_pInt,ext_msg=key) - GfortranBug86033: if (.not. allocated(getStrings)) then - allocate(getStrings(1),source=str) - else GfortranBug86033 - getStrings = [getStrings,str] - endif GfortranBug86033 - endif - item => item%next - end do end function From fc5410459929645b5f93f06dac7e916074f10c14 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 18:38:32 +0200 Subject: [PATCH 59/94] getStrings works for cumulative and non-cumulative --- src/linked_list.f90 | 94 ++------------------------------------------- src/material.f90 | 17 ++++---- 2 files changed, 13 insertions(+), 98 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index c91d3dad3..7badd1d71 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -23,10 +23,6 @@ module linked_list procedure :: keyExists => exist procedure :: countKeys => count - procedure :: getStringsRaw => strings - - procedure :: getRaw => getRaw - procedure :: getRaws => getRaws procedure :: getFloat => getFloat procedure :: getFloatArray => getFloats @@ -34,6 +30,7 @@ module linked_list procedure :: getInt => getInt procedure :: getIntArray => getInts + procedure :: getStringsRaw => strings procedure :: getString => getString procedure :: getStrings => getStrings @@ -195,89 +192,6 @@ function strings(this) end function strings -!-------------------------------------------------------------------------------------------------- -!> @brief gets first string that matches given key (i.e. first chunk) -!> @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 - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - character(len=*), intent(out) :: string - integer(pInt), dimension(:), allocatable, intent(out) :: stringPos - type(tPartitionedStringList), pointer :: item - logical :: found - - found = .false. - - item => this%next - do while (associated(item) .and. .not. found) - found = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) - if (found) then - stringPos = item%string%pos - string = item%string%val - endif - item => item%next - end do - - if (.not. found) call IO_error(140_pInt,ext_msg=key) - -end subroutine getRaw - - -!-------------------------------------------------------------------------------------------------- -!> @brief gets all strings that matches given key (i.e. first chunk) -!> @details returns raw strings and start/end positions of chunks in these strings. -! Will fail if number of positions in strings differs. -!-------------------------------------------------------------------------------------------------- -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 - character(len=65536), dimension(:), allocatable, intent(out) :: string - integer(pInt), dimension(:,:), allocatable, intent(out) :: stringPos - - character(len=65536) :: string_tmp - integer(pInt) :: posSize - integer(pInt), dimension(:), allocatable :: stringPosFlat - type(tPartitionedStringList), pointer :: item - - posSize = -1_pInt - item => this%next - do - if (.not. associated(item)) then - if (posSize < 0_pInt) call IO_error(140_pInt,ext_msg=key) - stringPos = reshape(stringPosFlat,[posSize,size(string)]) - exit - endif - foundKey: if (trim(IO_stringValue(item%string%val,item%string%pos,1))==trim(key)) then - if (posSize < 0_pInt) then - posSize = size(item%string%pos) - stringPosFlat = item%string%pos - allocate(string(1)) - string(1) = item%string%val - else - if (size(item%string%pos) /= posSize) & - call IO_error(141_pInt,ext_msg=trim(item%string%val),el=posSize) - stringPosFlat = [stringPosFlat,item%string%pos] - string_tmp = item%string%val - string = [string,string_tmp] - endif - endif foundKey - item => item%next - end do - -end subroutine getRaws - - !-------------------------------------------------------------------------------------------------- !> @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 @@ -367,7 +281,7 @@ character(len=65536) function getString(this,key,defaultVal,raw) split if (present(defaultVal)) getString = defaultVal - split = merge(raw,.true.,present(raw)) + split = merge(.not. raw,.true.,present(raw)) found = present(defaultVal) item => this%next @@ -411,9 +325,8 @@ function getStrings(this,key,defaultVal,raw) cumulative cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - split = merge(raw,.true.,present(raw)) + split = merge(.not. raw,.true.,present(raw)) found = present(defaultVal) - if (present(defaultVal)) getStrings = defaultVal @@ -451,7 +364,6 @@ function getStrings(this,key,defaultVal,raw) end do if (.not. found) call IO_error(140_pInt,ext_msg=key) - end function diff --git a/src/material.f90 b/src/material.f90 index edb0b9ef1..e4907fe96 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -670,6 +670,7 @@ subroutine material_parseMicrostructure IO_floatValue, & IO_intValue, & IO_stringValue, & + IO_stringPos, & IO_error use mesh, only: & mesh_element, & @@ -678,7 +679,7 @@ subroutine material_parseMicrostructure implicit none character(len=65536), dimension(:), allocatable :: & str - integer(pInt), allocatable, dimension(:,:) :: chunkPoss + integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: e, m, c, i character(len=65536) :: & tag @@ -705,18 +706,20 @@ subroutine material_parseMicrostructure allocate(microstructure_fraction(microstructure_maxNconstituents,material_Nmicrostructure),source=0.0_pReal) do m=1_pInt, material_Nmicrostructure - call microstructureConfig(m)%getRaws('(constituent)',str,chunkPoss) + str = microstructureConfig(m)%getStrings('(constituent)',raw=.true.) do c = 1_pInt, size(str) - do i = 2_pInt,6_pInt,2_pInt - tag = IO_stringValue(str(c),chunkPoss(:,c),i) + chunkPos = IO_stringPos(str(c)) + + do i = 1_pInt,5_pInt,2_pInt + tag = IO_stringValue(str(c),chunkPos,i) select case (tag) case('phase') - microstructure_phase(c,m) = IO_intValue(str(c),chunkPoss(:,c),i+1_pInt) + microstructure_phase(c,m) = IO_intValue(str(c),chunkPos,i+1_pInt) case('texture') - microstructure_texture(c,m) = IO_intValue(str(c),chunkPoss(:,c),i+1_pInt) + microstructure_texture(c,m) = IO_intValue(str(c),chunkPos,i+1_pInt) case('fraction') - microstructure_fraction(c,m) = IO_floatValue(str(c),chunkPoss(:,c),i+1_pInt) + microstructure_fraction(c,m) = IO_floatValue(str(c),chunkPos,i+1_pInt) end select enddo From efd2eae63ea19ccca9087481d3c8e4b4c3e42937 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 19:16:03 +0200 Subject: [PATCH 60/94] first step to get rid off getStringsRaw --- src/material.f90 | 106 ++++++++++++++++++++++++----------------------- 1 file changed, 55 insertions(+), 51 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index e4907fe96..474f10a59 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -922,6 +922,61 @@ subroutine material_parseTexture section = t gauss = 0_pInt fiber = 0_pInt + + if (textureConfig(t)%keyExists('axes')) then + lines = textureConfig(t)%getStrings('axes') + do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries + select case (lines(j)) + case('x', '+x') + texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis + case('-x') + texture_transformation(j,1:3,t) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis + case('y', '+y') + texture_transformation(j,1:3,t) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis + case('-y') + texture_transformation(j,1:3,t) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis + case('z', '+z') + texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis + case('-z') + texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis + case default + call IO_error(157_pInt,t) + end select + enddo + if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157_pInt,t) + endif + + tag='' + texture_ODFfile(t) = textureConfig(t)%getString('hybridia',defaultVal=tag) + + if (textureConfig(t)%keyExists('symmetry')) then + select case (textureConfig(t)%getString('symmetry')) + case('orthotropic') + texture_symmetry(t) = 4_pInt + case('monoclinic') + texture_symmetry(t) = 2_pInt + case default + texture_symmetry(t) = 1_pInt + end select + endif + + if (textureConfig(t)%keyExists('(random)')) then + lines = textureConfig(t)%getStrings('(random)',raw=.true.) + do i = 1_pInt, size(lines) + gauss = gauss + 1_pInt + texture_Gauss(1:3,gauss,t) = math_sampleRandomOri() + chunkPos = IO_stringPos(lines(i)) + do j = 1_pInt,3_pInt,2_pInt + select case (IO_stringValue(lines(i),chunkPos,j)) + case('scatter') + texture_Gauss(4,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad + case('fraction') + texture_Gauss(5,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt) + end select + enddo + enddo + endif + lines = textureConfig(t)%getStringsRaw() do i=1_pInt, size(lines) @@ -930,57 +985,6 @@ subroutine material_parseTexture tag = IO_stringValue(lines(i),chunkPos,1_pInt) ! extract key textureType: select case(tag) - case ('axes', 'rotation') textureType - do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries - tag = IO_stringValue(lines(i),chunkPos,j+1_pInt) - select case (tag) - case('x', '+x') - texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis - case('-x') - texture_transformation(j,1:3,t) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis - case('y', '+y') - texture_transformation(j,1:3,t) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis - case('-y') - texture_transformation(j,1:3,t) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis - case('z', '+z') - texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis - case('-z') - texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis - case default - call IO_error(157_pInt,t) - end select - enddo - - if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) & - call IO_error(157_pInt,t) - - case ('hybridia') textureType - texture_ODFfile(t) = IO_stringValue(lines(i),chunkPos,2_pInt) - - case ('symmetry') textureType - tag = IO_stringValue(lines(i),chunkPos,2_pInt) - select case (tag) - case('orthotropic') - texture_symmetry(t) = 4_pInt - case('monoclinic') - texture_symmetry(t) = 2_pInt - case default - texture_symmetry(t) = 1_pInt - end select - - case ('(random)') textureType - gauss = gauss + 1_pInt - texture_Gauss(1:3,gauss,t) = math_sampleRandomOri() - do j = 2_pInt,4_pInt,2_pInt - tag = IO_stringValue(lines(i),chunkPos,j) - select case (tag) - case('scatter') - texture_Gauss(4,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad - case('fraction') - texture_Gauss(5,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt) - end select - enddo - case ('(gauss)') textureType gauss = gauss + 1_pInt do j = 2_pInt,10_pInt,2_pInt From 2b5db71739f47ed3f91434d524baf2052cb8f988 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 19:25:29 +0200 Subject: [PATCH 61/94] using consistent names --- src/linked_list.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index 7badd1d71..6826a26da 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -25,10 +25,10 @@ module linked_list procedure :: countKeys => count procedure :: getFloat => getFloat - procedure :: getFloatArray => getFloats + procedure :: getFloats => getFloats procedure :: getInt => getInt - procedure :: getIntArray => getInts + procedure :: getInts => getInts procedure :: getStringsRaw => strings procedure :: getString => getString From 9aa211605f6c73f78b7160c80afb8bb4302b1b85 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 22:58:46 +0200 Subject: [PATCH 62/94] having no output in crystallite caused trouble --- src/crystallite.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 92fa61619..94f046605 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -268,7 +268,8 @@ subroutine crystallite_init do c = 1_pInt, material_Ncrystallite - str = crystalliteConfig(c)%getStrings('(output)')!,defaultVal=[]) + if (crystalliteConfig(c)%keyExists('output') )then + str = crystalliteConfig(c)%getStrings('(output)') do o = 1_pInt, size(str) crystallite_output(o,c) = str(o) outputName: select case(str(o)) @@ -319,7 +320,8 @@ subroutine crystallite_init case default outputName call IO_error(105_pInt,ext_msg=tag//' (Crystallite)') end select outputName -enddo + enddo + endif enddo From d177afa9e1520ae07c6a492794d6a541bf1140a3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 22:59:18 +0200 Subject: [PATCH 63/94] unallocated array --- src/plastic_kinematichardening.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 7ffaf2b26..0cc51817a 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -1,6 +1,7 @@ !-------------------------------------------------------------------------------------------------- !> @author Philip Eisenlohr, Michigan State University !> @author Zhuowen Zhao, Michigan State University +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief Introducing Voce-type kinematic hardening rule into crystal plasticity !! formulation using a power law fitting !-------------------------------------------------------------------------------------------------- @@ -231,6 +232,7 @@ subroutine plastic_kinehardening_init(fileUnit) allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid), source=0.0_pReal) if(allocated(tempPerSlip)) deallocate(tempPerSlip) allocate(tempPerSlip(Nchunks_SlipFamilies)) + allocate(param(instance)%outputID(0)) endif cycle ! skip to next line endif From 76fcf6b204dd596fc53b7d038057a9d6309f2836 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 22:59:52 +0200 Subject: [PATCH 64/94] logic for default value was broken only use default value if nothing else is found (do not append) --- src/linked_list.f90 | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/src/linked_list.f90 b/src/linked_list.f90 index 6826a26da..dbde4a295 100644 --- a/src/linked_list.f90 +++ b/src/linked_list.f90 @@ -147,7 +147,6 @@ integer(pInt) function count(this,key) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key type(tPartitionedStringList), pointer :: item - integer(pInt) :: i count = 0_pInt @@ -326,9 +325,7 @@ function getStrings(this,key,defaultVal,raw) cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') split = merge(.not. raw,.true.,present(raw)) - found = present(defaultVal) - if (present(defaultVal)) getStrings = defaultVal - + found = .false. item => this%next do while (associated(item)) @@ -363,8 +360,13 @@ function getStrings(this,key,defaultVal,raw) 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 + +end function getStrings !-------------------------------------------------------------------------------------------------- @@ -388,13 +390,9 @@ function getInts(this,key,defaultVal) cumulative cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - found = present(defaultVal) + found = .false. - if (present(defaultVal)) then - getInts = defaultVal - else - allocate(getInts(0)) - endif + allocate(getInts(0)) item => this%next do while (associated(item)) @@ -412,6 +410,10 @@ function getInts(this,key,defaultVal) 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 @@ -438,13 +440,9 @@ function getFloats(this,key,defaultVal) cumulative cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - found = present(defaultVal) + found = .false. - if (present(defaultVal)) then - getFloats = defaultVal - else - allocate(getFloats(0)) - endif + allocate(getFloats(0)) item => this%next do while (associated(item)) @@ -462,6 +460,10 @@ function getFloats(this,key,defaultVal) 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 From 5302782daddc0d0dec35003f938e3f938e17f984 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 23:42:15 +0200 Subject: [PATCH 65/94] need to search for cumulative tag --- src/crystallite.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 94f046605..17cf1570d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -268,7 +268,7 @@ subroutine crystallite_init do c = 1_pInt, material_Ncrystallite - if (crystalliteConfig(c)%keyExists('output') )then + if (crystalliteConfig(c)%keyExists('(output)') )then str = crystalliteConfig(c)%getStrings('(output)') do o = 1_pInt, size(str) crystallite_output(o,c) = str(o) From b58489c1c23e674f59b15cd35cee82b105eccc09 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 19 Jun 2018 23:53:14 +0200 Subject: [PATCH 66/94] merged all config related data into the config module --- src/CMakeLists.txt | 12 +- src/commercialFEM_fileList.f90 | 1 - src/config.f90 | 462 +++++++++++++++++++++++++++++++- src/linked_list.f90 | 472 --------------------------------- src/material.f90 | 1 - 5 files changed, 464 insertions(+), 484 deletions(-) delete mode 100644 src/linked_list.f90 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..3a0099a40 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 => 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 + 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,433 @@ 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 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 + 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(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/linked_list.f90 b/src/linked_list.f90 deleted file mode 100644 index dbde4a295..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 - 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(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..15912741e 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, & From adefbd95e666a22274510c47e53f662c94f8f60d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Jun 2018 22:34:32 +0200 Subject: [PATCH 67/94] don't use intrinsic names of keywors as function names --- src/config.f90 | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 3a0099a40..a2bdd6b50 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -24,8 +24,8 @@ module config procedure :: add => add procedure :: show => show - procedure :: keyExists => exist - procedure :: countKeys => count + procedure :: keyExists => keyExists + procedure :: countKeys => countKeys procedure :: getFloat => getFloat procedure :: getFloats => getFloats @@ -305,7 +305,7 @@ end subroutine show !-------------------------------------------------------------------------------------------------- !> @brief reports wether a given key (string value at first position) exists in the list !-------------------------------------------------------------------------------------------------- -logical function exist(this,key) +logical function keyExists(this,key) use IO, only: & IO_stringValue @@ -314,22 +314,22 @@ logical function exist(this,key) character(len=*), intent(in) :: key type(tPartitionedStringList), pointer :: item - exist = .false. + keyExists = .false. item => this%next - do while (associated(item) .and. .not. exist) - exist = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) + 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 exist +end function keyExists !-------------------------------------------------------------------------------------------------- !> @brief count number of key appearances !> @details traverses list and counts each occurrence of specified key !-------------------------------------------------------------------------------------------------- -integer(pInt) function count(this,key) +integer(pInt) function countKeys(this,key) use IO, only: & IO_stringValue @@ -339,21 +339,20 @@ integer(pInt) function count(this,key) character(len=*), intent(in) :: key type(tPartitionedStringList), pointer :: item - count = 0_pInt + countKeys = 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 + countKeys = countKeys + 1_pInt item => item%next end do -end function count +end function countKeys !-------------------------------------------------------------------------------------------------- -!> @brief returns all strings in the list -!> @details returns raw string without start/end position of chunks +!> @brief DEPRECATED: REMOVE SOON !-------------------------------------------------------------------------------------------------- function strings(this) use IO, only: & @@ -621,10 +620,10 @@ function getFloats(this,key,defaultVal) IO_FloatValue implicit none - real(pReal), dimension(:), allocatable :: getFloats + real(pReal), dimension(:), allocatable :: getFloats class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key - integer(pInt), dimension(:), intent(in), optional :: defaultVal + real(pReal), dimension(:), intent(in), optional :: defaultVal type(tPartitionedStringList), pointer :: item integer(pInt) :: i logical :: found, & From f61f22924a5ed48bda0ab7c76da09d2b6af24e22 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Jun 2018 22:38:06 +0200 Subject: [PATCH 68/94] empty string list as default value simplifies logic --- src/crystallite.f90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) 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 From bed922059736eadaf36c9b7215ecac7ed48625c8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Jun 2018 22:38:48 +0200 Subject: [PATCH 69/94] consistent string name and more verbose "prm" for shortcut parameters --- src/plastic_isotropic.f90 | 142 +++++++++++++++++++------------------- 1 file changed, 71 insertions(+), 71 deletions(-) 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 From 367e6a4eeec9f9c2f1033e11ec10f69213a95484 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Jun 2018 22:39:18 +0200 Subject: [PATCH 70/94] consistent string length (de-facto standard 65536) --- src/material.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 15912741e..48e71af07 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -225,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 :: & @@ -760,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) From c5b00e7a6c6e1931ee17cdf82c8c985d8c334e42 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Jun 2018 23:48:34 +0200 Subject: [PATCH 71/94] consistent description --- src/config.f90 | 226 ++++++++++++++++++++++++++----------------------- 1 file changed, 119 insertions(+), 107 deletions(-) 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 From c5ebe3510fc38256cb307be92884c4d3b1c810c2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 21 Jun 2018 23:49:07 +0200 Subject: [PATCH 72/94] simplified by using empty string list as default --- src/material.f90 | 102 +++++++++++++++++++++++------------------------ 1 file changed, 49 insertions(+), 53 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 48e71af07..d51309d81 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -811,59 +811,55 @@ 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 + str = phaseConfig(p)%getStrings('(source)',defaultVal=[character(len=65536)::]) + 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 + + str = phaseConfig(p)%getStrings('(kinematics)',defaultVal=[character(len=65536)::]) + 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 + + str = phaseConfig(p)%getStrings('(stiffness_degradation)',defaultVal=[character(len=65536)::]) + 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) From 1add0f3d84ea5efe1e58f81bef93437d3569848c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 22 Jun 2018 08:03:22 +0200 Subject: [PATCH 73/94] gfortran does not recognice an empty array as 'present' --- src/crystallite.f90 | 10 ++++++++-- src/material.f90 | 19 ++++++++++++++++++- src/plastic_isotropic.f90 | 6 ++++++ 3 files changed, 32 insertions(+), 3 deletions(-) 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 d51309d81..5462f3e9d 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -811,7 +811,13 @@ subroutine material_parsePhase allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),material_Nphase), & source=STIFFNESS_DEGRADATION_undefined_ID) do p=1_pInt, material_Nphase +#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) @@ -835,7 +841,13 @@ subroutine material_parsePhase 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) @@ -850,8 +862,13 @@ subroutine material_parsePhase 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) 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)) From 300b2827b29f0b215b7c4d1de5f7120149fe058b Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Mon, 25 Jun 2018 15:28:15 +0200 Subject: [PATCH 74/94] Using new functions for parsing material config --- src/config.f90 | 33 ----------------- src/material.f90 | 93 ++++++++++++++++++++++++------------------------ 2 files changed, 47 insertions(+), 79 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 68f06e7a2..9b229b2ec 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -36,8 +36,6 @@ module config procedure :: getInts => getInts procedure :: getStrings => getStrings - procedure :: getStringsRaw => strings - end type tPartitionedStringList type(tPartitionedStringList), public :: emptyList @@ -640,35 +638,4 @@ function getStrings(this,key,defaultVal,raw) end function getStrings - -!-------------------------------------------------------------------------------------------------- -!> @brief DEPRECATED: REMOVE SOON -!-------------------------------------------------------------------------------------------------- -function strings(this) - use IO, only: & - IO_error, & - IO_stringValue - - implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=65536), dimension(:), allocatable :: strings - character(len=65536) :: string - type(tPartitionedStringList), pointer :: item - - item => this%next - do while (associated(item)) - string = item%string%val - GfortranBug86033: if (.not. allocated(strings)) then - allocate(strings(1),source=string) - else GfortranBug86033 - strings = [strings,string] - endif GfortranBug86033 - item => item%next - end do - - if (size(strings) < 0_pInt) call IO_error(142_pInt) ! better to check for "allocated"? - -end function strings - - end module config diff --git a/src/material.f90 b/src/material.f90 index 5462f3e9d..5b005d87c 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -908,7 +908,7 @@ subroutine material_parseTexture implicit none integer(pInt) :: section, gauss, fiber, j, t, i - character(len=65536), dimension(:), allocatable :: lines + character(len=65536), dimension(:), allocatable :: strings ! Values for given key in material config integer(pInt), dimension(:), allocatable :: chunkPos character(len=65536) :: tag @@ -936,9 +936,9 @@ subroutine material_parseTexture fiber = 0_pInt if (textureConfig(t)%keyExists('axes')) then - lines = textureConfig(t)%getStrings('axes') + strings = textureConfig(t)%getStrings('axes') do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries - select case (lines(j)) + select case (strings(j)) case('x', '+x') texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis case('-x') @@ -973,70 +973,71 @@ subroutine material_parseTexture endif if (textureConfig(t)%keyExists('(random)')) then - lines = textureConfig(t)%getStrings('(random)',raw=.true.) - do i = 1_pInt, size(lines) + strings = textureConfig(t)%getStrings('(random)',raw=.true.) + do i = 1_pInt, size(strings) gauss = gauss + 1_pInt texture_Gauss(1:3,gauss,t) = math_sampleRandomOri() - chunkPos = IO_stringPos(lines(i)) + chunkPos = IO_stringPos(strings(i)) do j = 1_pInt,3_pInt,2_pInt - select case (IO_stringValue(lines(i),chunkPos,j)) + select case (IO_stringValue(strings(i),chunkPos,j)) case('scatter') - texture_Gauss(4,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad + texture_Gauss(4,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad case('fraction') - texture_Gauss(5,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt) + texture_Gauss(5,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt) end select enddo enddo endif - lines = textureConfig(t)%getStringsRaw() - - do i=1_pInt, size(lines) - - chunkPos = IO_stringPos(lines(i)) - tag = IO_stringValue(lines(i),chunkPos,1_pInt) ! extract key - textureType: select case(tag) - - case ('(gauss)') textureType - gauss = gauss + 1_pInt - do j = 2_pInt,10_pInt,2_pInt - tag = IO_stringValue(lines(i),chunkPos,j) - select case (tag) + + if (textureConfig(t)%keyExists('(gauss)')) then + gauss = gauss + 1_pInt + strings = textureConfig(t)%getStrings('(gauss)',raw= .true.) + do i = 1_pInt , size(strings) + chunkPos = IO_stringPos(strings(i)) + do j = 1_pInt,9_pInt,2_pInt + select case (IO_stringValue(strings(i),chunkPos,j)) case('phi1') - texture_Gauss(1,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad + texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad case('phi') - texture_Gauss(2,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad + texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad case('phi2') - texture_Gauss(3,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad + texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad case('scatter') - texture_Gauss(4,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad + texture_Gauss(4,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad case('fraction') - texture_Gauss(5,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt) - end select - enddo - - case ('(fiber)') textureType - fiber = fiber + 1_pInt - do j = 2_pInt,12_pInt,2_pInt - tag = IO_stringValue(lines(i),chunkPos,j) - select case (tag) + texture_Gauss(5,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt) + end select + enddo + enddo + endif + + + if (textureConfig(t)%keyExists('(fiber)')) then + gauss = gauss + 1_pInt + strings = textureConfig(t)%getStrings('(fiber)',raw= .true.) + do i = 1_pInt, size(strings) + chunkPos = IO_stringPos(strings(i)) + do j = 1_pInt,11_pInt,2_pInt + select case (IO_stringValue(strings(i),chunkPos,j)) case('alpha1') - texture_Fiber(1,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad + texture_Fiber(1,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad case('alpha2') - texture_Fiber(2,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad + texture_Fiber(2,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad case('beta1') - texture_Fiber(3,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad + texture_Fiber(3,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad case('beta2') - texture_Fiber(4,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad + texture_Fiber(4,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad case('scatter') - texture_Fiber(5,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad + texture_Fiber(5,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad case('fraction') - texture_Fiber(6,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt) - end select - enddo - end select textureType - enddo - enddo + texture_Fiber(6,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt) + end select + enddo + enddo + endif + enddo + end subroutine material_parseTexture From a91fa75a2826fc27e02e4ba2a829c899c0b41c1b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 07:38:03 +0200 Subject: [PATCH 75/94] sanity check, something is going wrong with intel 16.0 --- src/config.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 9b229b2ec..a469019ae 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -111,7 +111,7 @@ subroutine config_init() myDebug = debug_level(debug_material) - write(6,'(/,a)') ' <<<+- material init -+>>>' + write(6,'(/,a)') ' <<<+- config init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -442,7 +442,7 @@ character(len=65536) function getString(this,key,defaultVal,raw) logical :: found, & split - if (present(defaultVal)) getString = defaultVal + if (present(defaultVal)) getString = trim(defaultVal) split = merge(.not. raw,.true.,present(raw)) found = present(defaultVal) @@ -462,6 +462,7 @@ character(len=65536) function getString(this,key,defaultVal,raw) end do if (.not. found) call IO_error(140_pInt,ext_msg=key) + if (present(defaultVal) .and. len_trim(getString)/=len_trim(defaultVal)) write(6,*) 'mist';flush(6) end function getString From 0680b1706f801e6aed6425fbcddbc186218d7531 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 07:56:20 +0200 Subject: [PATCH 76/94] improved error handling --- src/config.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index a469019ae..679da24aa 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -462,8 +462,9 @@ character(len=65536) function getString(this,key,defaultVal,raw) end do if (.not. found) call IO_error(140_pInt,ext_msg=key) - if (present(defaultVal) .and. len_trim(getString)/=len_trim(defaultVal)) write(6,*) 'mist';flush(6) - + if (present(defaultVal)) then + if(len_trim(getString)/=len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString') + endif end function getString From a5ca26ab10ea441d73d05a00d1c5cd8cfd12c37b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 08:20:40 +0200 Subject: [PATCH 77/94] bug (copy and paste): fiber should be counted, not gauss --- src/material.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/material.f90 b/src/material.f90 index 5b005d87c..04946efe1 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -1014,7 +1014,7 @@ subroutine material_parseTexture if (textureConfig(t)%keyExists('(fiber)')) then - gauss = gauss + 1_pInt + fiber = fiber + 1_pInt strings = textureConfig(t)%getStrings('(fiber)',raw= .true.) do i = 1_pInt, size(strings) chunkPos = IO_stringPos(strings(i)) From b907acfbfa70741b814e9b0cf1020a01dc1ab416 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Tue, 26 Jun 2018 11:33:25 -0400 Subject: [PATCH 78/94] improved if then else logic here and there --- src/config.f90 | 59 +++++++++++++++++++++++--------------------------- 1 file changed, 27 insertions(+), 32 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 679da24aa..5674612eb 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -40,7 +40,7 @@ module config type(tPartitionedStringList), public :: emptyList - type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & + type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & ! QUESTION: rename to config_XXX? phaseConfig, & microstructureConfig, & homogenizationConfig, & @@ -201,7 +201,7 @@ subroutine parseFile(line,& line = IO_read(fileUnit) if (IO_isBlank(line)) cycle ! skip empty lines foundNextPart: if (IO_getTag(line,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read + devNull = IO_read(fileUnit, .true.) ! reset IO_read to close any recursively included files exit endif foundNextPart nextSection: if (IO_getTag(line,'[',']') /= '') then @@ -213,6 +213,7 @@ subroutine parseFile(line,& else GfortranBug86033 sectionNames = [sectionNames,tag] endif GfortranBug86033 + cycle endif nextSection chunkPos = IO_stringPos(line) tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key @@ -368,8 +369,8 @@ real(pReal) function getFloat(this,key,defaultVal) type(tPartitionedStringList), pointer :: item logical :: found - if (present(defaultVal)) getFloat = defaultVal found = present(defaultVal) + if (found) getFloat = defaultVal item => this%next do while (associated(item)) @@ -404,8 +405,8 @@ integer(pInt) function getInt(this,key,defaultVal) type(tPartitionedStringList), pointer :: item logical :: found - if (present(defaultVal)) getInt = defaultVal found = present(defaultVal) + if (found) getInt = defaultVal item => this%next do while (associated(item)) @@ -440,11 +441,11 @@ character(len=65536) function getString(this,key,defaultVal,raw) logical, intent(in), optional :: raw type(tPartitionedStringList), pointer :: item logical :: found, & - split + whole - if (present(defaultVal)) getString = trim(defaultVal) - split = merge(.not. raw,.true.,present(raw)) + whole = merge(raw,.false.,present(raw)) ! whole string or white space splitting found = present(defaultVal) + if (found) getString = trim(defaultVal) item => this%next do while (associated(item)) @@ -452,10 +453,10 @@ character(len=65536) function getString(this,key,defaultVal,raw) 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 + if (whole) then getString = trim(item%string%val(item%string%pos(4):)) ! raw string starting a second chunk + else + getString = IO_StringValue(item%string%val,item%string%pos,2) endif endif item => item%next @@ -463,7 +464,7 @@ character(len=65536) function getString(this,key,defaultVal,raw) if (.not. found) call IO_error(140_pInt,ext_msg=key) if (present(defaultVal)) then - if(len_trim(getString)/=len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString') + if (len_trim(getString) /= len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString') endif end function getString @@ -510,11 +511,9 @@ function getFloats(this,key,defaultVal) item => item%next end do - if (present(defaultVal) .and. .not. found) then - getFloats = defaultVal - found = .true. + if (.not. found) then + if (present(defaultVal)) then; getFloats = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif endif - if (.not. found) call IO_error(140_pInt,ext_msg=key) end function getFloats @@ -561,11 +560,9 @@ function getInts(this,key,defaultVal) item => item%next end do - if (present(defaultVal) .and. .not. found) then - getInts = defaultVal - found = .true. + if (.not. found) then + if (present(defaultVal)) then; getInts = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif endif - if (.not. found) call IO_error(140_pInt,ext_msg=key) end function getInts @@ -591,11 +588,11 @@ function getStrings(this,key,defaultVal,raw) character(len=65536) :: str integer(pInt) :: i logical :: found, & - split, & + whole, & cumulative cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')') - split = merge(.not. raw,.true.,present(raw)) + whole = merge(raw,.false.,present(raw)) found = .false. item => this%next @@ -606,36 +603,34 @@ function getStrings(this,key,defaultVal,raw) if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) notAllocated: if (.not. allocated(getStrings)) then - if (split) then + if (whole) then + str = item%string%val(item%string%pos(4):) + getStrings = [str] + else 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 + if (whole) then + getStrings = [getStrings,str] + else 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 - getStrings = defaultVal - found = .true. + if (.not. found) then + if (present(defaultVal)) then; getStrings = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif endif - if (.not. found) call IO_error(140_pInt,ext_msg=key) end function getStrings From 92bcf3a7aacb113d9c8c45a86b0f5e95b20fcc54 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 18:46:52 +0200 Subject: [PATCH 79/94] function to free elements of the string list. Note: Pointers that are allocated will never go out of scope. Pointers that are assigned (=>) will be deallocated/disaccociated like allocatables that go out of scope --- src/config.f90 | 38 +++++++++++++++++++++----------------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 5674612eb..6c53dc5e4 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -24,6 +24,7 @@ module config contains procedure :: add => add procedure :: show => show + procedure :: free => free procedure :: keyExists => keyExists procedure :: countKeys => countKeys @@ -166,8 +167,9 @@ subroutine config_init() end subroutine config_init + !-------------------------------------------------------------------------------------------------- -!> @brief parses the homogenization part in the material configuration file +!> @brief parses the material.config file !-------------------------------------------------------------------------------------------------- subroutine parseFile(line,& sectionNames,part,fileUnit) @@ -229,6 +231,7 @@ subroutine parseFile(line,& call part(s)%show() end do end if + end subroutine parseFile !-------------------------------------------------------------------------------------------------- @@ -283,23 +286,24 @@ end subroutine show !-------------------------------------------------------------------------------------------------- -!> @brief deallocates all elements of a given list -!> @details Strings are printed in order of insertion (FIFO) +!> @brief cleans entire list +!> @details list head is remains alive !-------------------------------------------------------------------------------------------------- -! 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 +subroutine free(this) + + implicit none + class(tPartitionedStringList), target, intent(in) :: this + type(tPartitionedStringList), pointer :: new, item + + item => this%next + do while (associated(item%next)) + new => item + deallocate(item) + item => new%next + enddo + deallocate(item) + +end subroutine free !-------------------------------------------------------------------------------------------------- From 6a75021bcad82a0863002a2900f0e658f023c8de Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 19:09:08 +0200 Subject: [PATCH 80/94] need to check at the beginning wrong logic in case default was overwritten --- src/config.f90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 6c53dc5e4..288e9d4c7 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -450,6 +450,9 @@ character(len=65536) function getString(this,key,defaultVal,raw) whole = merge(raw,.false.,present(raw)) ! whole string or white space splitting found = present(defaultVal) if (found) getString = trim(defaultVal) + if (found) then + if (len_trim(getString) /= len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString') + endif item => this%next do while (associated(item)) @@ -467,9 +470,7 @@ character(len=65536) function getString(this,key,defaultVal,raw) end do if (.not. found) call IO_error(140_pInt,ext_msg=key) - if (present(defaultVal)) then - if (len_trim(getString) /= len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString') - endif + end function getString From 66a254f8fb1866e6cdc75a0e5e752fc457c21bc6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 19:09:46 +0200 Subject: [PATCH 81/94] polishing --- src/IO.f90 | 4 ++-- src/material.f90 | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index d21f3a754..a7e77f0f4 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -560,8 +560,8 @@ function IO_hybridIA(Nast,ODFfileName) IO_hybridIA = 0.0_pReal ! initialize return value for case of error write(6,'(/,a,/)',advance='no') ' Using linear ODF file: '//trim(ODFfileName) - write(6,'(/,a)') 'Eisenlohr et al., Computational Materials Science, 42(4):670–678, 2008' - write(6,'(/,a)') 'https://doi.org/10.1016/j.commatsci.2007.09.015' + write(6,'(/,a)') ' Eisenlohr et al., Computational Materials Science, 42(4):670–678, 2008' + write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2007.09.015' !-------------------------------------------------------------------------------------------------- diff --git a/src/material.f90 b/src/material.f90 index 04946efe1..c66f422f8 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -1,6 +1,7 @@ !-------------------------------------------------------------------------------------------------- !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief Parses material config file, either solverJobName.materialConfig or material.config !> @details reads the material configuration file, where solverJobName.materialConfig takes !! precedence over material.config and parses the sections 'homogenization', 'crystallite', From a68c466fc621563e9c4b72ffb64305a1cc5d1539 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 19:18:23 +0200 Subject: [PATCH 82/94] simplified --- src/config.f90 | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 288e9d4c7..1fffbddcd 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -449,8 +449,8 @@ character(len=65536) function getString(this,key,defaultVal,raw) whole = merge(raw,.false.,present(raw)) ! whole string or white space splitting found = present(defaultVal) - if (found) getString = trim(defaultVal) if (found) then + getString = trim(defaultVal) if (len_trim(getString) /= len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString') endif @@ -504,10 +504,7 @@ function getFloats(this,key,defaultVal) 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 (.not. cumulative) getFloats = [real(pReal)::] 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)] @@ -553,10 +550,7 @@ function getInts(this,key,defaultVal) 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 (.not. cumulative) getInts = [integer(pInt)::] 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)] From 1abe7472045a2099c70e2172d5cf8b98811177d7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 20:30:41 +0200 Subject: [PATCH 83/94] possibility to deallocate material.config parts --- src/config.f90 | 61 +++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 56 insertions(+), 5 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index 1fffbddcd..e97bfa3f8 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -77,10 +77,15 @@ module config MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file -public :: config_init + public :: & + config_init, & + config_deallocate contains +!-------------------------------------------------------------------------------------------------- +!> @brief reads material.config and stores its content per part +!-------------------------------------------------------------------------------------------------- subroutine config_init() #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & @@ -109,13 +114,12 @@ subroutine config_init() line, & part - - myDebug = debug_level(debug_material) - write(6,'(/,a)') ' <<<+- config init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + myDebug = debug_level(debug_material) + if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file @@ -164,7 +168,6 @@ subroutine config_init() material_Ntexture = size(textureConfig) if (material_Ntexture < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) - end subroutine config_init @@ -234,6 +237,54 @@ subroutine parseFile(line,& end subroutine parseFile +subroutine config_deallocate(what) + use IO, only: & + IO_error + + implicit none + character(len=*), intent(in) :: what + integer(pInt) :: i + + select case(what) + + case('material.config/phase') + do i=1, size(phaseConfig) + call phaseConfig(i)%free + enddo + deallocate(phaseConfig) + + case('material.config/microstructure') + do i=1, size(microstructureConfig) + call microstructureConfig(i)%free + enddo + deallocate(microstructureConfig) + + case('material.config/crystallite') + do i=1, size(crystalliteConfig) + call crystalliteConfig(i)%free + enddo + deallocate(crystalliteConfig) + + case('material.config/homogenization') + do i=1, size(homogenizationConfig) + call homogenizationConfig(i)%free + enddo + deallocate(homogenizationConfig) + + case('material.config/texture') + do i=1, size(textureConfig) + call textureConfig(i)%free + enddo + deallocate(textureConfig) + + case default + call IO_error(0_pInt,ext_msg='config_deallocate') + + end select + +end subroutine config_deallocate + + !-------------------------------------------------------------------------------------------------- !> @brief add element !> @details Adds a string together with the start/end position of chunks in this string. The new From d786ead381cde7439b526f77b51e3dc577e1fe8b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 20:31:52 +0200 Subject: [PATCH 84/94] freeing space debug statements have been inactive for a while ... --- src/constitutive.f90 | 28 ++++------------------------ 1 file changed, 4 insertions(+), 24 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 81a6f17b9..e6f0c07ff 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -57,6 +57,8 @@ subroutine constitutive_init() IO_write_jobFile, & IO_write_jobIntFile, & IO_timeStamp + use config, only: & + config_deallocate use mesh, only: & FE_geomtype use config, only: & @@ -190,6 +192,8 @@ subroutine constitutive_init() if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) close(FILEUNIT) + call config_deallocate('material.config/phase') + write(6,'(/,a)') ' <<<+- constitutive init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -336,30 +340,6 @@ subroutine constitutive_init() enddo PhaseLoop2 -#ifdef TODO -!-------------------------------------------------------------------------------------------------- -! report - constitutive_maxSizeState = maxval(constitutive_sizeState) - constitutive_plasticity_maxSizeDotState = maxval(constitutive_sizeDotState) - - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then - write(6,'(a32,1x,7(i8,1x))') 'constitutive_state0: ', shape(constitutive_state0) - write(6,'(a32,1x,7(i8,1x))') 'constitutive_partionedState0: ', shape(constitutive_partionedState0) - write(6,'(a32,1x,7(i8,1x))') 'constitutive_subState0: ', shape(constitutive_subState0) - write(6,'(a32,1x,7(i8,1x))') 'constitutive_state: ', shape(constitutive_state) - write(6,'(a32,1x,7(i8,1x))') 'constitutive_aTolState: ', shape(constitutive_aTolState) - write(6,'(a32,1x,7(i8,1x))') 'constitutive_dotState: ', shape(constitutive_dotState) - write(6,'(a32,1x,7(i8,1x))') 'constitutive_deltaState: ', shape(constitutive_deltaState) - write(6,'(a32,1x,7(i8,1x))') 'constitutive_sizeState: ', shape(constitutive_sizeState) - write(6,'(a32,1x,7(i8,1x))') 'constitutive_sizeDotState: ', shape(constitutive_sizeDotState) - write(6,'(a32,1x,7(i8,1x),/)') 'constitutive_sizePostResults: ', shape(constitutive_sizePostResults) - write(6,'(a32,1x,7(i8,1x))') 'maxSizeState: ', constitutive_maxSizeState - write(6,'(a32,1x,7(i8,1x))') 'maxSizeDotState: ', constitutive_plasticity_maxSizeDotState - write(6,'(a32,1x,7(i8,1x))') 'maxSizePostResults: ', constitutive_plasticity_maxSizePostResults - endif - flush(6) -#endif - end subroutine constitutive_init From 98cc56968e1698cc7ea1cb8a4d3ddadbf2365b79 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 20:33:02 +0200 Subject: [PATCH 85/94] don't rely on a variable, use the array size directly --- src/material.f90 | 231 ++++++++++++++++++++++++++--------------------- 1 file changed, 127 insertions(+), 104 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index c66f422f8..53b7f89ea 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -8,7 +8,6 @@ !! 'phase', 'texture', and 'microstucture' !-------------------------------------------------------------------------------------------------- module material - use config use prec, only: & pReal, & pInt, & @@ -352,6 +351,16 @@ subroutine material_init() debug_material, & debug_levelBasic, & debug_levelExtensive + use config, only: & + crystalliteConfig, & + homogenizationConfig, & + microstructureConfig, & + phaseConfig, & + textureConfig, & + homogenization_name, & + microstructure_name, & + phase_name, & + texture_name use mesh, only: & mesh_maxNips, & mesh_NcpElems, & @@ -392,44 +401,44 @@ subroutine material_init() call material_parseTexture() if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) - allocate(plasticState (material_Nphase)) - allocate(sourceState (material_Nphase)) - do myPhase = 1,material_Nphase + allocate(plasticState (size(phaseConfig))) + allocate(sourceState (size(phaseConfig))) + do myPhase = 1,size(phaseConfig) allocate(sourceState(myPhase)%p(phase_Nsources(myPhase))) enddo - allocate(homogState (material_Nhomogenization)) - allocate(thermalState (material_Nhomogenization)) - allocate(damageState (material_Nhomogenization)) - allocate(vacancyfluxState (material_Nhomogenization)) - allocate(porosityState (material_Nhomogenization)) - allocate(hydrogenfluxState (material_Nhomogenization)) + allocate(homogState (size(homogenizationConfig))) + allocate(thermalState (size(homogenizationConfig))) + allocate(damageState (size(homogenizationConfig))) + allocate(vacancyfluxState (size(homogenizationConfig))) + allocate(porosityState (size(homogenizationConfig))) + allocate(hydrogenfluxState (size(homogenizationConfig))) - allocate(thermalMapping (material_Nhomogenization)) - allocate(damageMapping (material_Nhomogenization)) - allocate(vacancyfluxMapping (material_Nhomogenization)) - allocate(porosityMapping (material_Nhomogenization)) - allocate(hydrogenfluxMapping(material_Nhomogenization)) + allocate(thermalMapping (size(homogenizationConfig))) + allocate(damageMapping (size(homogenizationConfig))) + allocate(vacancyfluxMapping (size(homogenizationConfig))) + allocate(porosityMapping (size(homogenizationConfig))) + allocate(hydrogenfluxMapping(size(homogenizationConfig))) - allocate(temperature (material_Nhomogenization)) - allocate(damage (material_Nhomogenization)) - allocate(vacancyConc (material_Nhomogenization)) - allocate(porosity (material_Nhomogenization)) - allocate(hydrogenConc (material_Nhomogenization)) + allocate(temperature (size(homogenizationConfig))) + allocate(damage (size(homogenizationConfig))) + allocate(vacancyConc (size(homogenizationConfig))) + allocate(porosity (size(homogenizationConfig))) + allocate(hydrogenConc (size(homogenizationConfig))) - allocate(temperatureRate (material_Nhomogenization)) - allocate(vacancyConcRate (material_Nhomogenization)) - allocate(hydrogenConcRate (material_Nhomogenization)) + allocate(temperatureRate (size(homogenizationConfig))) + allocate(vacancyConcRate (size(homogenizationConfig))) + allocate(hydrogenConcRate (size(homogenizationConfig))) - do m = 1_pInt,material_Nmicrostructure + do m = 1_pInt,size(microstructureConfig) if(microstructure_crystallite(m) < 1_pInt .or. & - microstructure_crystallite(m) > material_Ncrystallite) & + microstructure_crystallite(m) > size(crystalliteConfig)) & call IO_error(150_pInt,m,ext_msg='crystallite') if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. & - maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > material_Nphase) & + maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > size(phaseConfig)) & call IO_error(150_pInt,m,ext_msg='phase') if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. & - maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > material_Ntexture) & + maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > size(textureConfig)) & call IO_error(150_pInt,m,ext_msg='texture') if(microstructure_Nconstituents(m) < 1_pInt) & call IO_error(151_pInt,m) @@ -438,11 +447,11 @@ subroutine material_init() debugOut: if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then write(6,'(/,a,/)') ' MATERIAL configuration' write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' - do h = 1_pInt,material_Nhomogenization + do h = 1_pInt,size(homogenizationConfig) write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h) enddo write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents','homogeneous' - do m = 1_pInt,material_Nmicrostructure + do m = 1_pInt,size(microstructureConfig) write(6,'(1x,a32,1x,i11,1x,i12,1x,l13)') microstructure_name(m), & microstructure_crystallite(m), & microstructure_Nconstituents(m), & @@ -466,9 +475,9 @@ subroutine material_init() allocate(mappingCrystallite (2,homogenization_maxNgrains, mesh_NcpElems),source=0_pInt) allocate(mappingHomogenizationConst( mesh_maxNips,mesh_NcpElems),source=1_pInt) - allocate(ConstitutivePosition (material_Nphase), source=0_pInt) - allocate(HomogenizationPosition(material_Nhomogenization),source=0_pInt) - allocate(CrystallitePosition (material_Nphase), source=0_pInt) + allocate(ConstitutivePosition (size(phaseConfig)), source=0_pInt) + allocate(HomogenizationPosition(size(homogenizationConfig)),source=0_pInt) + allocate(CrystallitePosition (size(phaseConfig)), source=0_pInt) ElemLoop:do e = 1_pInt,mesh_NcpElems myHomog = mesh_element(3,e) @@ -485,7 +494,7 @@ subroutine material_init() enddo ElemLoop ! hack needed to initialize field values used during constitutive and crystallite initializations - do myHomog = 1,material_Nhomogenization + do myHomog = 1,size(homogenizationConfig) thermalMapping (myHomog)%p => mappingHomogenizationConst damageMapping (myHomog)%p => mappingHomogenizationConst vacancyfluxMapping (myHomog)%p => mappingHomogenizationConst @@ -519,31 +528,31 @@ subroutine material_parseHomogenization integer(pInt) :: h character(len=65536) :: tag - allocate(homogenization_type(material_Nhomogenization), source=HOMOGENIZATION_undefined_ID) - allocate(thermal_type(material_Nhomogenization), source=THERMAL_isothermal_ID) - allocate(damage_type (material_Nhomogenization), source=DAMAGE_none_ID) - allocate(vacancyflux_type(material_Nhomogenization), source=VACANCYFLUX_isoconc_ID) - allocate(porosity_type (material_Nhomogenization), source=POROSITY_none_ID) - allocate(hydrogenflux_type(material_Nhomogenization), source=HYDROGENFLUX_isoconc_ID) - allocate(homogenization_typeInstance(material_Nhomogenization), source=0_pInt) - allocate(thermal_typeInstance(material_Nhomogenization), source=0_pInt) - allocate(damage_typeInstance(material_Nhomogenization), source=0_pInt) - allocate(vacancyflux_typeInstance(material_Nhomogenization), source=0_pInt) - allocate(porosity_typeInstance(material_Nhomogenization), source=0_pInt) - allocate(hydrogenflux_typeInstance(material_Nhomogenization), source=0_pInt) - allocate(homogenization_Ngrains(material_Nhomogenization), source=0_pInt) - allocate(homogenization_Noutput(material_Nhomogenization), source=0_pInt) - allocate(homogenization_active(material_Nhomogenization), source=.false.) !!!!!!!!!!!!!!! - allocate(thermal_initialT(material_Nhomogenization), source=300.0_pReal) - allocate(damage_initialPhi(material_Nhomogenization), source=1.0_pReal) - allocate(vacancyflux_initialCv(material_Nhomogenization), source=0.0_pReal) - allocate(porosity_initialPhi(material_Nhomogenization), source=1.0_pReal) - allocate(hydrogenflux_initialCh(material_Nhomogenization), source=0.0_pReal) + allocate(homogenization_type(size(homogenizationConfig)), source=HOMOGENIZATION_undefined_ID) + allocate(thermal_type(size(homogenizationConfig)), source=THERMAL_isothermal_ID) + allocate(damage_type (size(homogenizationConfig)), source=DAMAGE_none_ID) + allocate(vacancyflux_type(size(homogenizationConfig)), source=VACANCYFLUX_isoconc_ID) + allocate(porosity_type (size(homogenizationConfig)), source=POROSITY_none_ID) + allocate(hydrogenflux_type(size(homogenizationConfig)), source=HYDROGENFLUX_isoconc_ID) + allocate(homogenization_typeInstance(size(homogenizationConfig)), source=0_pInt) + allocate(thermal_typeInstance(size(homogenizationConfig)), source=0_pInt) + allocate(damage_typeInstance(size(homogenizationConfig)), source=0_pInt) + allocate(vacancyflux_typeInstance(size(homogenizationConfig)), source=0_pInt) + allocate(porosity_typeInstance(size(homogenizationConfig)), source=0_pInt) + allocate(hydrogenflux_typeInstance(size(homogenizationConfig)), source=0_pInt) + allocate(homogenization_Ngrains(size(homogenizationConfig)), source=0_pInt) + allocate(homogenization_Noutput(size(homogenizationConfig)), source=0_pInt) + allocate(homogenization_active(size(homogenizationConfig)), source=.false.) !!!!!!!!!!!!!!! + allocate(thermal_initialT(size(homogenizationConfig)), source=300.0_pReal) + allocate(damage_initialPhi(size(homogenizationConfig)), source=1.0_pReal) + allocate(vacancyflux_initialCv(size(homogenizationConfig)), source=0.0_pReal) + allocate(porosity_initialPhi(size(homogenizationConfig)), source=1.0_pReal) + allocate(hydrogenflux_initialCh(size(homogenizationConfig)), source=0.0_pReal) - forall (h = 1_pInt:material_Nhomogenization) homogenization_active(h) = any(mesh_element(3,:) == h) + forall (h = 1_pInt:size(homogenizationConfig)) homogenization_active(h) = any(mesh_element(3,:) == h) - do h=1_pInt, material_Nhomogenization + do h=1_pInt, size(homogenizationConfig) homogenization_Noutput(h) = homogenizationConfig(h)%countKeys('(output)') tag = homogenizationConfig(h)%getString('mech') @@ -646,7 +655,7 @@ subroutine material_parseHomogenization enddo - do h=1_pInt, material_Nhomogenization + do h=1_pInt, size(homogenizationConfig) homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h)) thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h)) damage_typeInstance(h) = count(damage_type (1:h) == damage_type (h)) @@ -672,6 +681,9 @@ subroutine material_parseMicrostructure IO_stringValue, & IO_stringPos, & IO_error + use config, only: & + microstructureConfig, & + microstructure_name use mesh, only: & mesh_element, & mesh_NcpElems @@ -684,28 +696,28 @@ subroutine material_parseMicrostructure character(len=65536) :: & tag - allocate(microstructure_crystallite(material_Nmicrostructure), source=0_pInt) - allocate(microstructure_Nconstituents(material_Nmicrostructure), source=0_pInt) - allocate(microstructure_active(material_Nmicrostructure), source=.false.) - allocate(microstructure_elemhomo(material_Nmicrostructure), source=.false.) + allocate(microstructure_crystallite(size(microstructureConfig)), source=0_pInt) + allocate(microstructure_Nconstituents(size(microstructureConfig)), source=0_pInt) + allocate(microstructure_active(size(microstructureConfig)), source=.false.) + allocate(microstructure_elemhomo(size(microstructureConfig)), source=.false.) - if(any(mesh_element(4,1:mesh_NcpElems) > material_Nmicrostructure)) & + if(any(mesh_element(4,1:mesh_NcpElems) > size(microstructureConfig))) & call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config') forall (e = 1_pInt:mesh_NcpElems) microstructure_active(mesh_element(4,e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements - do m=1_pInt, material_Nmicrostructure + do m=1_pInt, size(microstructureConfig) microstructure_Nconstituents(m) = microstructureConfig(m)%countKeys('(constituent)') microstructure_crystallite(m) = microstructureConfig(m)%getInt('crystallite') microstructure_elemhomo(m) = microstructureConfig(m)%keyExists('/elementhomogeneous/') enddo microstructure_maxNconstituents = maxval(microstructure_Nconstituents) - allocate(microstructure_phase (microstructure_maxNconstituents,material_Nmicrostructure),source=0_pInt) - allocate(microstructure_texture (microstructure_maxNconstituents,material_Nmicrostructure),source=0_pInt) - allocate(microstructure_fraction(microstructure_maxNconstituents,material_Nmicrostructure),source=0.0_pReal) + allocate(microstructure_phase (microstructure_maxNconstituents,size(microstructureConfig)),source=0_pInt) + allocate(microstructure_texture (microstructure_maxNconstituents,size(microstructureConfig)),source=0_pInt) + allocate(microstructure_fraction(microstructure_maxNconstituents,size(microstructureConfig)),source=0.0_pReal) - do m=1_pInt, material_Nmicrostructure + do m=1_pInt, size(microstructureConfig) str = microstructureConfig(m)%getStrings('(constituent)',raw=.true.) do c = 1_pInt, size(str) chunkPos = IO_stringPos(str(c)) @@ -726,11 +738,11 @@ subroutine material_parseMicrostructure enddo enddo - do m = 1_pInt, material_Nmicrostructure + do m = 1_pInt, size(microstructureConfig) if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) & call IO_error(153_pInt,ext_msg=microstructure_name(m)) enddo - + end subroutine material_parseMicrostructure @@ -738,12 +750,14 @@ end subroutine material_parseMicrostructure !> @brief parses the crystallite part in the material configuration file !-------------------------------------------------------------------------------------------------- subroutine material_parseCrystallite + use config, only: & + crystalliteConfig implicit none integer(pInt) :: c - allocate(crystallite_Noutput(material_Ncrystallite),source=0_pInt) - do c=1_pInt, material_Ncrystallite + allocate(crystallite_Noutput(size(crystalliteConfig)),source=0_pInt) + do c=1_pInt, size(crystalliteConfig) crystallite_Noutput(c) = crystalliteConfig(c)%countKeys('(output)') enddo @@ -758,21 +772,23 @@ subroutine material_parsePhase IO_error, & IO_getTag, & IO_stringValue + use config, only: & + phaseConfig implicit none integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p character(len=65536), dimension(:), allocatable :: str - allocate(phase_elasticity(material_Nphase),source=ELASTICITY_undefined_ID) - allocate(phase_plasticity(material_Nphase),source=PLASTICITY_undefined_ID) - allocate(phase_Nsources(material_Nphase), source=0_pInt) - allocate(phase_Nkinematics(material_Nphase), source=0_pInt) - allocate(phase_NstiffnessDegradations(material_Nphase),source=0_pInt) - allocate(phase_Noutput(material_Nphase), source=0_pInt) - allocate(phase_localPlasticity(material_Nphase), source=.false.) + allocate(phase_elasticity(size(phaseConfig)),source=ELASTICITY_undefined_ID) + allocate(phase_plasticity(size(phaseConfig)),source=PLASTICITY_undefined_ID) + allocate(phase_Nsources(size(phaseConfig)), source=0_pInt) + allocate(phase_Nkinematics(size(phaseConfig)), source=0_pInt) + allocate(phase_NstiffnessDegradations(size(phaseConfig)),source=0_pInt) + allocate(phase_Noutput(size(phaseConfig)), source=0_pInt) + allocate(phase_localPlasticity(size(phaseConfig)), source=.false.) - do p=1_pInt, material_Nphase + do p=1_pInt, size(phaseConfig) phase_Noutput(p) = phaseConfig(p)%countKeys('(output)') phase_Nsources(p) = phaseConfig(p)%countKeys('(source)') phase_Nkinematics(p) = phaseConfig(p)%countKeys('(kinematics)') @@ -807,11 +823,11 @@ subroutine material_parsePhase enddo - allocate(phase_source(maxval(phase_Nsources),material_Nphase), source=SOURCE_undefined_ID) - allocate(phase_kinematics(maxval(phase_Nkinematics),material_Nphase), source=KINEMATICS_undefined_ID) - allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),material_Nphase), & + allocate(phase_source(maxval(phase_Nsources),size(phaseConfig)), source=SOURCE_undefined_ID) + allocate(phase_kinematics(maxval(phase_Nkinematics),size(phaseConfig)), source=KINEMATICS_undefined_ID) + allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),size(phaseConfig)), & source=STIFFNESS_DEGRADATION_undefined_ID) - do p=1_pInt, material_Nphase + do p=1_pInt, size(phaseConfig) #if defined(__GFORTRAN__) str = ['GfortranBug86277'] str = phaseConfig(p)%getStrings('(source)',defaultVal=str) @@ -880,10 +896,10 @@ subroutine material_parsePhase enddo enddo - allocate(phase_plasticityInstance(material_Nphase), source=0_pInt) - allocate(phase_elasticityInstance(material_Nphase), source=0_pInt) + allocate(phase_plasticityInstance(size(phaseConfig)), source=0_pInt) + allocate(phase_elasticityInstance(size(phaseConfig)), source=0_pInt) - do p=1_pInt, material_Nphase + do p=1_pInt, size(phaseConfig) phase_elasticityInstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p)) phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) enddo @@ -901,6 +917,8 @@ subroutine material_parseTexture IO_stringPos, & IO_floatValue, & IO_stringValue + use config, only: & + textureConfig use math, only: & inRad, & math_sampleRandomOri, & @@ -913,12 +931,12 @@ subroutine material_parseTexture integer(pInt), dimension(:), allocatable :: chunkPos character(len=65536) :: tag - allocate(texture_ODFfile(material_Ntexture)); texture_ODFfile='' - allocate(texture_symmetry(material_Ntexture), source=1_pInt) - allocate(texture_Ngauss(material_Ntexture), source=0_pInt) - allocate(texture_Nfiber(material_Ntexture), source=0_pInt) + allocate(texture_ODFfile(size(textureConfig))); texture_ODFfile='' + allocate(texture_symmetry(size(textureConfig)), source=1_pInt) + allocate(texture_Ngauss(size(textureConfig)), source=0_pInt) + allocate(texture_Nfiber(size(textureConfig)), source=0_pInt) - do t=1_pInt, material_Ntexture + do t=1_pInt, size(textureConfig) texture_Ngauss(t) = textureConfig(t)%countKeys('(gauss)') & + textureConfig(t)%countKeys('(random)') texture_Nfiber(t) = textureConfig(t)%countKeys('(fiber)') @@ -926,12 +944,12 @@ subroutine material_parseTexture texture_maxNgauss = maxval(texture_Ngauss) texture_maxNfiber = maxval(texture_Nfiber) - allocate(texture_Gauss (5,texture_maxNgauss,material_Ntexture), source=0.0_pReal) - allocate(texture_Fiber (6,texture_maxNfiber,material_Ntexture), source=0.0_pReal) - allocate(texture_transformation(3,3,material_Ntexture), source=0.0_pReal) - texture_transformation = spread(math_I3,3,material_Ntexture) + allocate(texture_Gauss (5,texture_maxNgauss,size(textureConfig)), source=0.0_pReal) + allocate(texture_Fiber (6,texture_maxNfiber,size(textureConfig)), source=0.0_pReal) + allocate(texture_transformation(3,3,size(textureConfig)), source=0.0_pReal) + texture_transformation = spread(math_I3,3,size(textureConfig)) - do t=1_pInt, material_Ntexture + do t=1_pInt, size(textureConfig) section = t gauss = 0_pInt fiber = 0_pInt @@ -1067,6 +1085,11 @@ subroutine material_populateGrains mesh_ipVolume, & FE_Nips, & FE_geomtype + use config, only: & + homogenizationConfig, & + microstructureConfig, & + homogenization_name, & + microstructure_name use IO, only: & IO_error, & IO_hybridIA @@ -1103,8 +1126,8 @@ subroutine material_populateGrains allocate(material_texture(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source=0_pInt) allocate(material_EulerAngles(3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) - allocate(Ngrains(material_Nhomogenization,material_Nmicrostructure), source=0_pInt) - allocate(Nelems(material_Nhomogenization,material_Nmicrostructure), source=0_pInt) + allocate(Ngrains(size(homogenizationConfig),size(microstructureConfig)), source=0_pInt) + allocate(Nelems (size(homogenizationConfig),size(microstructureConfig)), source=0_pInt) ! populating homogenization schemes in each !-------------------------------------------------------------------------------------------------- @@ -1119,9 +1142,9 @@ subroutine material_populateGrains micro = mesh_element(4,e) Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt enddo - allocate(elemsOfHomogMicro(material_Nhomogenization,material_Nmicrostructure)) - do homog = 1,material_Nhomogenization - do micro = 1,material_Nmicrostructure + allocate(elemsOfHomogMicro(size(homogenizationConfig),size(microstructureConfig))) + do homog = 1,size(homogenizationConfig) + do micro = 1,size(microstructureConfig) if (Nelems(homog,micro) > 0_pInt) then allocate(elemsOfHomogMicro(homog,micro)%p(Nelems(homog,micro))) elemsOfHomogMicro(homog,micro)%p = 0_pInt @@ -1136,9 +1159,9 @@ subroutine material_populateGrains t = FE_geomtype(mesh_element(2,e)) homog = mesh_element(3,e) micro = mesh_element(4,e) - if (homog < 1_pInt .or. homog > material_Nhomogenization) & ! out of bounds + if (homog < 1_pInt .or. homog > size(homogenizationConfig)) & ! out of bounds call IO_error(154_pInt,e,0_pInt,0_pInt) - if (micro < 1_pInt .or. micro > material_Nmicrostructure) & ! out of bounds + if (micro < 1_pInt .or. micro > size(microstructureConfig)) & ! out of bounds call IO_error(155_pInt,e,0_pInt,0_pInt) if (microstructure_elemhomo(micro)) then ! how many grains are needed at this element? dGrains = homogenization_Ngrains(homog) ! only one set of Ngrains (other IPs are plain copies) @@ -1159,9 +1182,9 @@ subroutine material_populateGrains write(6,'(/,a/)') ' MATERIAL grain population' write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#' endif - homogenizationLoop: do homog = 1_pInt,material_Nhomogenization + homogenizationLoop: do homog = 1_pInt,size(homogenizationConfig) dGrains = homogenization_Ngrains(homog) ! grain number per material point - microstructureLoop: do micro = 1_pInt,material_Nmicrostructure ! all pairs of homog and micro + microstructureLoop: do micro = 1_pInt,size(microstructureConfig) ! all pairs of homog and micro activePair: if (Ngrains(homog,micro) > 0_pInt) then myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate myNconstituents = microstructure_Nconstituents(micro) ! assign short name for number of constituents From bb415e8a02406a48266467c724e61b57a0c76065 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 20:33:41 +0200 Subject: [PATCH 86/94] using array size not to rely on correctly set variable, cleaning crystallite data after use --- src/crystallite.f90 | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 4a086ba8a..38562be97 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -171,7 +171,10 @@ subroutine crystallite_init IO_write_jobFile, & IO_error use material - use config + use config, only: & + crystalliteConfig, & + crystallite_name, & + config_deallocate use constitutive, only: & constitutive_initialFi, & constitutive_microstructure ! derived (shortcut) quantities of given state @@ -259,15 +262,15 @@ subroutine crystallite_init allocate(crystallite_clearToCutback(iMax,eMax), source=.true.) allocate(crystallite_neighborEnforcedCutback(iMax,eMax), source=.false.) allocate(crystallite_output(maxval(crystallite_Noutput), & - material_Ncrystallite)) ; crystallite_output = '' + size(crystalliteConfig))) ; crystallite_output = '' allocate(crystallite_outputID(maxval(crystallite_Noutput), & - material_Ncrystallite), source=undefined_ID) - allocate(crystallite_sizePostResults(material_Ncrystallite),source=0_pInt) + size(crystalliteConfig)), source=undefined_ID) + allocate(crystallite_sizePostResults(size(crystalliteConfig)),source=0_pInt) allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), & - material_Ncrystallite), source=0_pInt) + size(crystalliteConfig)), source=0_pInt) - do c = 1_pInt, material_Ncrystallite + do c = 1_pInt, size(crystalliteConfig) #if defined(__GFORTRAN__) str = ['GfortranBug86277'] str = crystalliteConfig(c)%getStrings('(output)',defaultVal=str) @@ -329,7 +332,7 @@ subroutine crystallite_init enddo - do r = 1_pInt,material_Ncrystallite + do r = 1_pInt,size(crystalliteConfig) do o = 1_pInt,crystallite_Noutput(r) select case(crystallite_outputID(o,r)) case(phase_ID,texture_ID,volume_ID,grainrotationx_ID,grainrotationy_ID,grainrotationz_ID) @@ -354,14 +357,14 @@ subroutine crystallite_init crystallite_maxSizePostResults = & maxval(crystallite_sizePostResults(microstructure_crystallite),microstructure_active) - + !-------------------------------------------------------------------------------------------------- ! write description file for crystallite output if (worldrank == 0_pInt) then call IO_write_jobFile(FILEUNIT,'outputCrystallite') - do r = 1_pInt,material_Ncrystallite + do r = 1_pInt,size(crystalliteConfig) if (any(microstructure_crystallite(mesh_element(4,:)) == r)) then write(FILEUNIT,'(/,a,/)') '['//trim(crystallite_name(r))//']' do o = 1_pInt,crystallite_Noutput(r) @@ -373,6 +376,8 @@ subroutine crystallite_init close(FILEUNIT) endif + call config_deallocate('material.config/crystallite') + !-------------------------------------------------------------------------------------------------- ! initialize !$OMP PARALLEL DO PRIVATE(myNcomponents) From ea80e04ea8087ec30cb04e67c6cd4e9576b5bc97 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 20:50:06 +0200 Subject: [PATCH 87/94] deallocating config, simplifying --- src/config.f90 | 7 +++---- src/homogenization.f90 | 13 ++++++++++--- src/material.f90 | 10 +++++++--- 3 files changed, 20 insertions(+), 10 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index e97bfa3f8..dce4acc51 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -60,12 +60,12 @@ module config MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part MATERIAL_partPhase = 'phase', & !< keyword for phase part - MATERIAL_partMicrostructure = 'microstructure', & !< keyword for microstructure part + MATERIAL_partMicrostructure = 'microstructure' !< keyword for microstructure part + character(len=*), parameter, private :: & MATERIAL_partTexture = 'texture' !< keyword for texture part ! ToDo: Remove, use size(phaseConfig) etc integer(pInt), public, protected :: & - material_Ntexture, & !< number of textures material_Nphase, & !< number of phases material_Nhomogenization, & !< number of homogenizations material_Nmicrostructure, & !< number of microstructures @@ -165,8 +165,7 @@ subroutine config_init() if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite) material_Nphase = size(phaseConfig) if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase) - material_Ntexture = size(textureConfig) - if (material_Ntexture < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) + if (size(textureConfig) < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) end subroutine config_init diff --git a/src/homogenization.f90 b/src/homogenization.f90 index b50b6ff83..57dad3cbc 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -100,8 +100,13 @@ subroutine homogenization_init use crystallite, only: & crystallite_maxSizePostResults #endif + use config, only: & + config_deallocate, & + material_configFile, & + material_localFileExt, & + homogenizationConfig, & + homogenization_name use material - use config use homogenization_none use homogenization_isostrain use homogenization_RGC @@ -197,7 +202,7 @@ subroutine homogenization_init ! write description file for homogenization output mainProcess2: if (worldrank == 0) then call IO_write_jobFile(FILEUNIT,'outputHomogenization') - do p = 1,material_Nhomogenization + do p = 1,size(homogenizationConfig) if (any(material_homog == p)) then i = homogenization_typeInstance(p) ! which instance of this homogenization type valid = .true. ! assume valid @@ -370,6 +375,8 @@ subroutine homogenization_init close(FILEUNIT) endif mainProcess2 + call config_deallocate('material.config/homogenization') + !-------------------------------------------------------------------------------------------------- ! allocate and initialize global variables allocate(materialpoint_dPdF(3,3,3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) @@ -395,7 +402,7 @@ subroutine homogenization_init vacancyflux_maxSizePostResults = 0_pInt porosity_maxSizePostResults = 0_pInt hydrogenflux_maxSizePostResults = 0_pInt - do p = 1,material_Nhomogenization + do p = 1,size(homogenizationConfig) homogenization_maxSizePostResults = max(homogenization_maxSizePostResults,homogState (p)%sizePostResults) thermal_maxSizePostResults = max(thermal_maxSizePostResults, thermalState (p)%sizePostResults) damage_maxSizePostResults = max(damage_maxSizePostResults ,damageState (p)%sizePostResults) diff --git a/src/material.f90 b/src/material.f90 index 53b7f89ea..2aefb036a 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -360,7 +360,8 @@ subroutine material_init() homogenization_name, & microstructure_name, & phase_name, & - texture_name + texture_name, & + config_deallocate use mesh, only: & mesh_maxNips, & mesh_NcpElems, & @@ -468,6 +469,7 @@ subroutine material_init() endif debugOut call material_populateGrains + call config_deallocate('material.config/microstructure') allocate(phaseAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) allocate(phasememberAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) @@ -918,7 +920,8 @@ subroutine material_parseTexture IO_floatValue, & IO_stringValue use config, only: & - textureConfig + textureConfig, & + config_deallocate use math, only: & inRad, & math_sampleRandomOri, & @@ -1056,7 +1059,8 @@ subroutine material_parseTexture enddo endif enddo - + + call config_deallocate('material.config/texture') end subroutine material_parseTexture From fc83a763188f02fdca73b0bf9c715eaca11341a8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 26 Jun 2018 20:54:54 +0200 Subject: [PATCH 88/94] consistent naming --- src/config.f90 | 62 +++---- src/crystallite.f90 | 20 +-- src/homogenization.f90 | 6 +- src/material.f90 | 332 +++++++++++++++++++------------------- src/plastic_isotropic.f90 | 36 ++--- 5 files changed, 228 insertions(+), 228 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index dce4acc51..e417b2bd5 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -42,11 +42,11 @@ module config type(tPartitionedStringList), public :: emptyList type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & ! QUESTION: rename to config_XXX? - phaseConfig, & - microstructureConfig, & - homogenizationConfig, & - textureConfig, & - crystalliteConfig + config_phase, & + config_microstructure, & + config_homogenization, & + config_texture, & + config_crystallite character(len=64), dimension(:), allocatable, public, protected :: & phase_name, & !< name of each phase @@ -64,7 +64,7 @@ module config character(len=*), parameter, private :: & MATERIAL_partTexture = 'texture' !< keyword for texture part -! ToDo: Remove, use size(phaseConfig) etc +! ToDo: Remove, use size(config_phase) etc integer(pInt), public, protected :: & material_Nphase, & !< number of phases material_Nhomogenization, & !< number of homogenizations @@ -131,23 +131,23 @@ subroutine config_init() select case (trim(part)) case (trim(material_partPhase)) - call parseFile(line,phase_name,phaseConfig,FILEUNIT) + call parseFile(line,phase_name,config_phase,FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) case (trim(material_partMicrostructure)) - call parseFile(line,microstructure_name,microstructureConfig,FILEUNIT) + call parseFile(line,microstructure_name,config_microstructure,FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) case (trim(material_partCrystallite)) - call parseFile(line,crystallite_name,crystalliteConfig,FILEUNIT) + call parseFile(line,crystallite_name,config_crystallite,FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) case (trim(material_partHomogenization)) - call parseFile(line,homogenization_name,homogenizationConfig,FILEUNIT) + call parseFile(line,homogenization_name,config_homogenization,FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) case (trim(material_partTexture)) - call parseFile(line,texture_name,textureConfig,FILEUNIT) + call parseFile(line,texture_name,config_texture,FILEUNIT) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) case default @@ -157,15 +157,15 @@ subroutine config_init() enddo - material_Nhomogenization = size(homogenizationConfig) + material_Nhomogenization = size(config_homogenization) if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization) - material_Nmicrostructure = size(microstructureConfig) + material_Nmicrostructure = size(config_microstructure) if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure) - material_Ncrystallite = size(crystalliteConfig) + material_Ncrystallite = size(config_crystallite) if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite) - material_Nphase = size(phaseConfig) + material_Nphase = size(config_phase) if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase) - if (size(textureConfig) < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) + if (size(config_texture) < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture) end subroutine config_init @@ -247,34 +247,34 @@ subroutine config_deallocate(what) select case(what) case('material.config/phase') - do i=1, size(phaseConfig) - call phaseConfig(i)%free + do i=1, size(config_phase) + call config_phase(i)%free enddo - deallocate(phaseConfig) + deallocate(config_phase) case('material.config/microstructure') - do i=1, size(microstructureConfig) - call microstructureConfig(i)%free + do i=1, size(config_microstructure) + call config_microstructure(i)%free enddo - deallocate(microstructureConfig) + deallocate(config_microstructure) case('material.config/crystallite') - do i=1, size(crystalliteConfig) - call crystalliteConfig(i)%free + do i=1, size(config_crystallite) + call config_crystallite(i)%free enddo - deallocate(crystalliteConfig) + deallocate(config_crystallite) case('material.config/homogenization') - do i=1, size(homogenizationConfig) - call homogenizationConfig(i)%free + do i=1, size(config_homogenization) + call config_homogenization(i)%free enddo - deallocate(homogenizationConfig) + deallocate(config_homogenization) case('material.config/texture') - do i=1, size(textureConfig) - call textureConfig(i)%free + do i=1, size(config_texture) + call config_texture(i)%free enddo - deallocate(textureConfig) + deallocate(config_texture) case default call IO_error(0_pInt,ext_msg='config_deallocate') diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 38562be97..b17b4b3ee 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -172,7 +172,7 @@ subroutine crystallite_init IO_error use material use config, only: & - crystalliteConfig, & + config_crystallite, & crystallite_name, & config_deallocate use constitutive, only: & @@ -262,21 +262,21 @@ subroutine crystallite_init allocate(crystallite_clearToCutback(iMax,eMax), source=.true.) allocate(crystallite_neighborEnforcedCutback(iMax,eMax), source=.false.) allocate(crystallite_output(maxval(crystallite_Noutput), & - size(crystalliteConfig))) ; crystallite_output = '' + size(config_crystallite))) ; crystallite_output = '' allocate(crystallite_outputID(maxval(crystallite_Noutput), & - size(crystalliteConfig)), source=undefined_ID) - allocate(crystallite_sizePostResults(size(crystalliteConfig)),source=0_pInt) + size(config_crystallite)), source=undefined_ID) + allocate(crystallite_sizePostResults(size(config_crystallite)),source=0_pInt) allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), & - size(crystalliteConfig)), source=0_pInt) + size(config_crystallite)), source=0_pInt) - do c = 1_pInt, size(crystalliteConfig) + do c = 1_pInt, size(config_crystallite) #if defined(__GFORTRAN__) str = ['GfortranBug86277'] - str = crystalliteConfig(c)%getStrings('(output)',defaultVal=str) + str = config_crystallite(c)%getStrings('(output)',defaultVal=str) if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] #else - str = crystalliteConfig(c)%getStrings('(output)',defaultVal=[character(len=65536)::]) + str = config_crystallite(c)%getStrings('(output)',defaultVal=[character(len=65536)::]) #endif do o = 1_pInt, size(str) crystallite_output(o,c) = str(o) @@ -332,7 +332,7 @@ subroutine crystallite_init enddo - do r = 1_pInt,size(crystalliteConfig) + do r = 1_pInt,size(config_crystallite) do o = 1_pInt,crystallite_Noutput(r) select case(crystallite_outputID(o,r)) case(phase_ID,texture_ID,volume_ID,grainrotationx_ID,grainrotationy_ID,grainrotationz_ID) @@ -364,7 +364,7 @@ subroutine crystallite_init if (worldrank == 0_pInt) then call IO_write_jobFile(FILEUNIT,'outputCrystallite') - do r = 1_pInt,size(crystalliteConfig) + do r = 1_pInt,size(config_crystallite) if (any(microstructure_crystallite(mesh_element(4,:)) == r)) then write(FILEUNIT,'(/,a,/)') '['//trim(crystallite_name(r))//']' do o = 1_pInt,crystallite_Noutput(r) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 57dad3cbc..c1b244d0a 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -104,7 +104,7 @@ subroutine homogenization_init config_deallocate, & material_configFile, & material_localFileExt, & - homogenizationConfig, & + config_homogenization, & homogenization_name use material use homogenization_none @@ -202,7 +202,7 @@ subroutine homogenization_init ! write description file for homogenization output mainProcess2: if (worldrank == 0) then call IO_write_jobFile(FILEUNIT,'outputHomogenization') - do p = 1,size(homogenizationConfig) + do p = 1,size(config_homogenization) if (any(material_homog == p)) then i = homogenization_typeInstance(p) ! which instance of this homogenization type valid = .true. ! assume valid @@ -402,7 +402,7 @@ subroutine homogenization_init vacancyflux_maxSizePostResults = 0_pInt porosity_maxSizePostResults = 0_pInt hydrogenflux_maxSizePostResults = 0_pInt - do p = 1,size(homogenizationConfig) + do p = 1,size(config_homogenization) homogenization_maxSizePostResults = max(homogenization_maxSizePostResults,homogState (p)%sizePostResults) thermal_maxSizePostResults = max(thermal_maxSizePostResults, thermalState (p)%sizePostResults) damage_maxSizePostResults = max(damage_maxSizePostResults ,damageState (p)%sizePostResults) diff --git a/src/material.f90 b/src/material.f90 index 2aefb036a..2b83c9967 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -352,11 +352,11 @@ subroutine material_init() debug_levelBasic, & debug_levelExtensive use config, only: & - crystalliteConfig, & - homogenizationConfig, & - microstructureConfig, & - phaseConfig, & - textureConfig, & + config_crystallite, & + config_homogenization, & + config_microstructure, & + config_phase, & + config_texture, & homogenization_name, & microstructure_name, & phase_name, & @@ -402,44 +402,44 @@ subroutine material_init() call material_parseTexture() if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) - allocate(plasticState (size(phaseConfig))) - allocate(sourceState (size(phaseConfig))) - do myPhase = 1,size(phaseConfig) + allocate(plasticState (size(config_phase))) + allocate(sourceState (size(config_phase))) + do myPhase = 1,size(config_phase) allocate(sourceState(myPhase)%p(phase_Nsources(myPhase))) enddo - allocate(homogState (size(homogenizationConfig))) - allocate(thermalState (size(homogenizationConfig))) - allocate(damageState (size(homogenizationConfig))) - allocate(vacancyfluxState (size(homogenizationConfig))) - allocate(porosityState (size(homogenizationConfig))) - allocate(hydrogenfluxState (size(homogenizationConfig))) + allocate(homogState (size(config_homogenization))) + allocate(thermalState (size(config_homogenization))) + allocate(damageState (size(config_homogenization))) + allocate(vacancyfluxState (size(config_homogenization))) + allocate(porosityState (size(config_homogenization))) + allocate(hydrogenfluxState (size(config_homogenization))) - allocate(thermalMapping (size(homogenizationConfig))) - allocate(damageMapping (size(homogenizationConfig))) - allocate(vacancyfluxMapping (size(homogenizationConfig))) - allocate(porosityMapping (size(homogenizationConfig))) - allocate(hydrogenfluxMapping(size(homogenizationConfig))) + allocate(thermalMapping (size(config_homogenization))) + allocate(damageMapping (size(config_homogenization))) + allocate(vacancyfluxMapping (size(config_homogenization))) + allocate(porosityMapping (size(config_homogenization))) + allocate(hydrogenfluxMapping(size(config_homogenization))) - allocate(temperature (size(homogenizationConfig))) - allocate(damage (size(homogenizationConfig))) - allocate(vacancyConc (size(homogenizationConfig))) - allocate(porosity (size(homogenizationConfig))) - allocate(hydrogenConc (size(homogenizationConfig))) + allocate(temperature (size(config_homogenization))) + allocate(damage (size(config_homogenization))) + allocate(vacancyConc (size(config_homogenization))) + allocate(porosity (size(config_homogenization))) + allocate(hydrogenConc (size(config_homogenization))) - allocate(temperatureRate (size(homogenizationConfig))) - allocate(vacancyConcRate (size(homogenizationConfig))) - allocate(hydrogenConcRate (size(homogenizationConfig))) + allocate(temperatureRate (size(config_homogenization))) + allocate(vacancyConcRate (size(config_homogenization))) + allocate(hydrogenConcRate (size(config_homogenization))) - do m = 1_pInt,size(microstructureConfig) + do m = 1_pInt,size(config_microstructure) if(microstructure_crystallite(m) < 1_pInt .or. & - microstructure_crystallite(m) > size(crystalliteConfig)) & + microstructure_crystallite(m) > size(config_crystallite)) & call IO_error(150_pInt,m,ext_msg='crystallite') if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. & - maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > size(phaseConfig)) & + maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > size(config_phase)) & call IO_error(150_pInt,m,ext_msg='phase') if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. & - maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > size(textureConfig)) & + maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > size(config_texture)) & call IO_error(150_pInt,m,ext_msg='texture') if(microstructure_Nconstituents(m) < 1_pInt) & call IO_error(151_pInt,m) @@ -448,11 +448,11 @@ subroutine material_init() debugOut: if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then write(6,'(/,a,/)') ' MATERIAL configuration' write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' - do h = 1_pInt,size(homogenizationConfig) + do h = 1_pInt,size(config_homogenization) write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h) enddo write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents','homogeneous' - do m = 1_pInt,size(microstructureConfig) + do m = 1_pInt,size(config_microstructure) write(6,'(1x,a32,1x,i11,1x,i12,1x,l13)') microstructure_name(m), & microstructure_crystallite(m), & microstructure_Nconstituents(m), & @@ -477,9 +477,9 @@ subroutine material_init() allocate(mappingCrystallite (2,homogenization_maxNgrains, mesh_NcpElems),source=0_pInt) allocate(mappingHomogenizationConst( mesh_maxNips,mesh_NcpElems),source=1_pInt) - allocate(ConstitutivePosition (size(phaseConfig)), source=0_pInt) - allocate(HomogenizationPosition(size(homogenizationConfig)),source=0_pInt) - allocate(CrystallitePosition (size(phaseConfig)), source=0_pInt) + allocate(ConstitutivePosition (size(config_phase)), source=0_pInt) + allocate(HomogenizationPosition(size(config_homogenization)),source=0_pInt) + allocate(CrystallitePosition (size(config_phase)), source=0_pInt) ElemLoop:do e = 1_pInt,mesh_NcpElems myHomog = mesh_element(3,e) @@ -496,7 +496,7 @@ subroutine material_init() enddo ElemLoop ! hack needed to initialize field values used during constitutive and crystallite initializations - do myHomog = 1,size(homogenizationConfig) + do myHomog = 1,size(config_homogenization) thermalMapping (myHomog)%p => mappingHomogenizationConst damageMapping (myHomog)%p => mappingHomogenizationConst vacancyfluxMapping (myHomog)%p => mappingHomogenizationConst @@ -520,7 +520,7 @@ end subroutine material_init !-------------------------------------------------------------------------------------------------- subroutine material_parseHomogenization use config, only : & - homogenizationConfig + config_homogenization use IO, only: & IO_error use mesh, only: & @@ -530,54 +530,54 @@ subroutine material_parseHomogenization integer(pInt) :: h character(len=65536) :: tag - allocate(homogenization_type(size(homogenizationConfig)), source=HOMOGENIZATION_undefined_ID) - allocate(thermal_type(size(homogenizationConfig)), source=THERMAL_isothermal_ID) - allocate(damage_type (size(homogenizationConfig)), source=DAMAGE_none_ID) - allocate(vacancyflux_type(size(homogenizationConfig)), source=VACANCYFLUX_isoconc_ID) - allocate(porosity_type (size(homogenizationConfig)), source=POROSITY_none_ID) - allocate(hydrogenflux_type(size(homogenizationConfig)), source=HYDROGENFLUX_isoconc_ID) - allocate(homogenization_typeInstance(size(homogenizationConfig)), source=0_pInt) - allocate(thermal_typeInstance(size(homogenizationConfig)), source=0_pInt) - allocate(damage_typeInstance(size(homogenizationConfig)), source=0_pInt) - allocate(vacancyflux_typeInstance(size(homogenizationConfig)), source=0_pInt) - allocate(porosity_typeInstance(size(homogenizationConfig)), source=0_pInt) - allocate(hydrogenflux_typeInstance(size(homogenizationConfig)), source=0_pInt) - allocate(homogenization_Ngrains(size(homogenizationConfig)), source=0_pInt) - allocate(homogenization_Noutput(size(homogenizationConfig)), source=0_pInt) - allocate(homogenization_active(size(homogenizationConfig)), source=.false.) !!!!!!!!!!!!!!! - allocate(thermal_initialT(size(homogenizationConfig)), source=300.0_pReal) - allocate(damage_initialPhi(size(homogenizationConfig)), source=1.0_pReal) - allocate(vacancyflux_initialCv(size(homogenizationConfig)), source=0.0_pReal) - allocate(porosity_initialPhi(size(homogenizationConfig)), source=1.0_pReal) - allocate(hydrogenflux_initialCh(size(homogenizationConfig)), source=0.0_pReal) + allocate(homogenization_type(size(config_homogenization)), source=HOMOGENIZATION_undefined_ID) + allocate(thermal_type(size(config_homogenization)), source=THERMAL_isothermal_ID) + allocate(damage_type (size(config_homogenization)), source=DAMAGE_none_ID) + allocate(vacancyflux_type(size(config_homogenization)), source=VACANCYFLUX_isoconc_ID) + allocate(porosity_type (size(config_homogenization)), source=POROSITY_none_ID) + allocate(hydrogenflux_type(size(config_homogenization)), source=HYDROGENFLUX_isoconc_ID) + allocate(homogenization_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(thermal_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(damage_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(vacancyflux_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(porosity_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(hydrogenflux_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(homogenization_Ngrains(size(config_homogenization)), source=0_pInt) + allocate(homogenization_Noutput(size(config_homogenization)), source=0_pInt) + allocate(homogenization_active(size(config_homogenization)), source=.false.) !!!!!!!!!!!!!!! + allocate(thermal_initialT(size(config_homogenization)), source=300.0_pReal) + allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal) + allocate(vacancyflux_initialCv(size(config_homogenization)), source=0.0_pReal) + allocate(porosity_initialPhi(size(config_homogenization)), source=1.0_pReal) + allocate(hydrogenflux_initialCh(size(config_homogenization)), source=0.0_pReal) - forall (h = 1_pInt:size(homogenizationConfig)) homogenization_active(h) = any(mesh_element(3,:) == h) + forall (h = 1_pInt:size(config_homogenization)) homogenization_active(h) = any(mesh_element(3,:) == h) - do h=1_pInt, size(homogenizationConfig) - homogenization_Noutput(h) = homogenizationConfig(h)%countKeys('(output)') + do h=1_pInt, size(config_homogenization) + homogenization_Noutput(h) = config_homogenization(h)%countKeys('(output)') - tag = homogenizationConfig(h)%getString('mech') + tag = config_homogenization(h)%getString('mech') select case (trim(tag)) case(HOMOGENIZATION_NONE_label) homogenization_type(h) = HOMOGENIZATION_NONE_ID homogenization_Ngrains(h) = 1_pInt case(HOMOGENIZATION_ISOSTRAIN_label) homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID - homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents') + homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents') case(HOMOGENIZATION_RGC_label) homogenization_type(h) = HOMOGENIZATION_RGC_ID - homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents') + homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents') case default call IO_error(500_pInt,ext_msg=trim(tag)) end select homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h)) - if (homogenizationConfig(h)%keyExists('thermal')) then - thermal_initialT(h) = homogenizationConfig(h)%getFloat('t0',defaultVal=300.0_pReal) + if (config_homogenization(h)%keyExists('thermal')) then + thermal_initialT(h) = config_homogenization(h)%getFloat('t0',defaultVal=300.0_pReal) - tag = homogenizationConfig(h)%getString('thermal') + tag = config_homogenization(h)%getString('thermal') select case (trim(tag)) case(THERMAL_isothermal_label) thermal_type(h) = THERMAL_isothermal_ID @@ -591,10 +591,10 @@ subroutine material_parseHomogenization endif - if (homogenizationConfig(h)%keyExists('damage')) then - damage_initialPhi(h) = homogenizationConfig(h)%getFloat('initialdamage',defaultVal=1.0_pReal) + if (config_homogenization(h)%keyExists('damage')) then + damage_initialPhi(h) = config_homogenization(h)%getFloat('initialdamage',defaultVal=1.0_pReal) - tag = homogenizationConfig(h)%getString('damage') + tag = config_homogenization(h)%getString('damage') select case (trim(tag)) case(DAMAGE_NONE_label) damage_type(h) = DAMAGE_none_ID @@ -608,10 +608,10 @@ subroutine material_parseHomogenization endif - if (homogenizationConfig(h)%keyExists('vacancyflux')) then - vacancyflux_initialCv(h) = homogenizationConfig(h)%getFloat('cv0',defaultVal=0.0_pReal) + if (config_homogenization(h)%keyExists('vacancyflux')) then + vacancyflux_initialCv(h) = config_homogenization(h)%getFloat('cv0',defaultVal=0.0_pReal) - tag = homogenizationConfig(h)%getString('vacancyflux') + tag = config_homogenization(h)%getString('vacancyflux') select case (trim(tag)) case(VACANCYFLUX_isoconc_label) vacancyflux_type(h) = VACANCYFLUX_isoconc_ID @@ -625,10 +625,10 @@ subroutine material_parseHomogenization endif - if (homogenizationConfig(h)%keyExists('porosity')) then + if (config_homogenization(h)%keyExists('porosity')) then !ToDo? - tag = homogenizationConfig(h)%getString('porosity') + tag = config_homogenization(h)%getString('porosity') select case (trim(tag)) case(POROSITY_NONE_label) porosity_type(h) = POROSITY_none_ID @@ -640,10 +640,10 @@ subroutine material_parseHomogenization endif - if (homogenizationConfig(h)%keyExists('hydrogenflux')) then - hydrogenflux_initialCh(h) = homogenizationConfig(h)%getFloat('ch0',defaultVal=0.0_pReal) + if (config_homogenization(h)%keyExists('hydrogenflux')) then + hydrogenflux_initialCh(h) = config_homogenization(h)%getFloat('ch0',defaultVal=0.0_pReal) - tag = homogenizationConfig(h)%getString('hydrogenflux') + tag = config_homogenization(h)%getString('hydrogenflux') select case (trim(tag)) case(HYDROGENFLUX_isoconc_label) hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID @@ -657,7 +657,7 @@ subroutine material_parseHomogenization enddo - do h=1_pInt, size(homogenizationConfig) + do h=1_pInt, size(config_homogenization) homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h)) thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h)) damage_typeInstance(h) = count(damage_type (1:h) == damage_type (h)) @@ -684,7 +684,7 @@ subroutine material_parseMicrostructure IO_stringPos, & IO_error use config, only: & - microstructureConfig, & + config_microstructure, & microstructure_name use mesh, only: & mesh_element, & @@ -698,29 +698,29 @@ subroutine material_parseMicrostructure character(len=65536) :: & tag - allocate(microstructure_crystallite(size(microstructureConfig)), source=0_pInt) - allocate(microstructure_Nconstituents(size(microstructureConfig)), source=0_pInt) - allocate(microstructure_active(size(microstructureConfig)), source=.false.) - allocate(microstructure_elemhomo(size(microstructureConfig)), source=.false.) + allocate(microstructure_crystallite(size(config_microstructure)), source=0_pInt) + allocate(microstructure_Nconstituents(size(config_microstructure)), source=0_pInt) + allocate(microstructure_active(size(config_microstructure)), source=.false.) + allocate(microstructure_elemhomo(size(config_microstructure)), source=.false.) - if(any(mesh_element(4,1:mesh_NcpElems) > size(microstructureConfig))) & + if(any(mesh_element(4,1:mesh_NcpElems) > size(config_microstructure))) & call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config') forall (e = 1_pInt:mesh_NcpElems) microstructure_active(mesh_element(4,e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements - do m=1_pInt, size(microstructureConfig) - microstructure_Nconstituents(m) = microstructureConfig(m)%countKeys('(constituent)') - microstructure_crystallite(m) = microstructureConfig(m)%getInt('crystallite') - microstructure_elemhomo(m) = microstructureConfig(m)%keyExists('/elementhomogeneous/') + do m=1_pInt, size(config_microstructure) + microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)') + microstructure_crystallite(m) = config_microstructure(m)%getInt('crystallite') + microstructure_elemhomo(m) = config_microstructure(m)%keyExists('/elementhomogeneous/') enddo microstructure_maxNconstituents = maxval(microstructure_Nconstituents) - allocate(microstructure_phase (microstructure_maxNconstituents,size(microstructureConfig)),source=0_pInt) - allocate(microstructure_texture (microstructure_maxNconstituents,size(microstructureConfig)),source=0_pInt) - allocate(microstructure_fraction(microstructure_maxNconstituents,size(microstructureConfig)),source=0.0_pReal) + allocate(microstructure_phase (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt) + allocate(microstructure_texture (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt) + allocate(microstructure_fraction(microstructure_maxNconstituents,size(config_microstructure)),source=0.0_pReal) - do m=1_pInt, size(microstructureConfig) - str = microstructureConfig(m)%getStrings('(constituent)',raw=.true.) + do m=1_pInt, size(config_microstructure) + str = config_microstructure(m)%getStrings('(constituent)',raw=.true.) do c = 1_pInt, size(str) chunkPos = IO_stringPos(str(c)) @@ -740,7 +740,7 @@ subroutine material_parseMicrostructure enddo enddo - do m = 1_pInt, size(microstructureConfig) + do m = 1_pInt, size(config_microstructure) if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) & call IO_error(153_pInt,ext_msg=microstructure_name(m)) enddo @@ -753,14 +753,14 @@ end subroutine material_parseMicrostructure !-------------------------------------------------------------------------------------------------- subroutine material_parseCrystallite use config, only: & - crystalliteConfig + config_crystallite implicit none integer(pInt) :: c - allocate(crystallite_Noutput(size(crystalliteConfig)),source=0_pInt) - do c=1_pInt, size(crystalliteConfig) - crystallite_Noutput(c) = crystalliteConfig(c)%countKeys('(output)') + allocate(crystallite_Noutput(size(config_crystallite)),source=0_pInt) + do c=1_pInt, size(config_crystallite) + crystallite_Noutput(c) = config_crystallite(c)%countKeys('(output)') enddo end subroutine material_parseCrystallite @@ -775,36 +775,36 @@ subroutine material_parsePhase IO_getTag, & IO_stringValue use config, only: & - phaseConfig + config_phase implicit none integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p character(len=65536), dimension(:), allocatable :: str - allocate(phase_elasticity(size(phaseConfig)),source=ELASTICITY_undefined_ID) - allocate(phase_plasticity(size(phaseConfig)),source=PLASTICITY_undefined_ID) - allocate(phase_Nsources(size(phaseConfig)), source=0_pInt) - allocate(phase_Nkinematics(size(phaseConfig)), source=0_pInt) - allocate(phase_NstiffnessDegradations(size(phaseConfig)),source=0_pInt) - allocate(phase_Noutput(size(phaseConfig)), source=0_pInt) - allocate(phase_localPlasticity(size(phaseConfig)), source=.false.) + allocate(phase_elasticity(size(config_phase)),source=ELASTICITY_undefined_ID) + allocate(phase_plasticity(size(config_phase)),source=PLASTICITY_undefined_ID) + allocate(phase_Nsources(size(config_phase)), source=0_pInt) + allocate(phase_Nkinematics(size(config_phase)), source=0_pInt) + allocate(phase_NstiffnessDegradations(size(config_phase)),source=0_pInt) + allocate(phase_Noutput(size(config_phase)), source=0_pInt) + allocate(phase_localPlasticity(size(config_phase)), source=.false.) - do p=1_pInt, size(phaseConfig) - phase_Noutput(p) = phaseConfig(p)%countKeys('(output)') - phase_Nsources(p) = phaseConfig(p)%countKeys('(source)') - phase_Nkinematics(p) = phaseConfig(p)%countKeys('(kinematics)') - phase_NstiffnessDegradations(p) = phaseConfig(p)%countKeys('(stiffness_degradation)') - phase_localPlasticity(p) = .not. phaseConfig(p)%KeyExists('/nonlocal/') + do p=1_pInt, size(config_phase) + phase_Noutput(p) = config_phase(p)%countKeys('(output)') + phase_Nsources(p) = config_phase(p)%countKeys('(source)') + phase_Nkinematics(p) = config_phase(p)%countKeys('(kinematics)') + phase_NstiffnessDegradations(p) = config_phase(p)%countKeys('(stiffness_degradation)') + phase_localPlasticity(p) = .not. config_phase(p)%KeyExists('/nonlocal/') - select case (phaseConfig(p)%getString('elasticity')) + select case (config_phase(p)%getString('elasticity')) case (ELASTICITY_HOOKE_label) phase_elasticity(p) = ELASTICITY_HOOKE_ID case default - call IO_error(200_pInt,ext_msg=trim(phaseConfig(p)%getString('elasticity'))) + call IO_error(200_pInt,ext_msg=trim(config_phase(p)%getString('elasticity'))) end select - select case (phaseConfig(p)%getString('plasticity')) + select case (config_phase(p)%getString('plasticity')) case (PLASTICITY_NONE_label) phase_plasticity(p) = PLASTICITY_NONE_ID case (PLASTICITY_ISOTROPIC_label) @@ -820,22 +820,22 @@ subroutine material_parsePhase case (PLASTICITY_NONLOCAL_label) phase_plasticity(p) = PLASTICITY_NONLOCAL_ID case default - call IO_error(201_pInt,ext_msg=trim(phaseConfig(p)%getString('plasticity'))) + call IO_error(201_pInt,ext_msg=trim(config_phase(p)%getString('plasticity'))) end select enddo - allocate(phase_source(maxval(phase_Nsources),size(phaseConfig)), source=SOURCE_undefined_ID) - allocate(phase_kinematics(maxval(phase_Nkinematics),size(phaseConfig)), source=KINEMATICS_undefined_ID) - allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),size(phaseConfig)), & + allocate(phase_source(maxval(phase_Nsources),size(config_phase)), source=SOURCE_undefined_ID) + allocate(phase_kinematics(maxval(phase_Nkinematics),size(config_phase)), source=KINEMATICS_undefined_ID) + allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),size(config_phase)), & source=STIFFNESS_DEGRADATION_undefined_ID) - do p=1_pInt, size(phaseConfig) + do p=1_pInt, size(config_phase) #if defined(__GFORTRAN__) str = ['GfortranBug86277'] - str = phaseConfig(p)%getStrings('(source)',defaultVal=str) + str = config_phase(p)%getStrings('(source)',defaultVal=str) if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] #else - str = phaseConfig(p)%getStrings('(source)',defaultVal=[character(len=65536)::]) + str = config_phase(p)%getStrings('(source)',defaultVal=[character(len=65536)::]) #endif do sourceCtr = 1_pInt, size(str) select case (trim(str(sourceCtr))) @@ -862,10 +862,10 @@ subroutine material_parsePhase #if defined(__GFORTRAN__) str = ['GfortranBug86277'] - str = phaseConfig(p)%getStrings('(kinematics)',defaultVal=str) + str = config_phase(p)%getStrings('(kinematics)',defaultVal=str) if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] #else - str = phaseConfig(p)%getStrings('(kinematics)',defaultVal=[character(len=65536)::]) + str = config_phase(p)%getStrings('(kinematics)',defaultVal=[character(len=65536)::]) #endif do kinematicsCtr = 1_pInt, size(str) select case (trim(str(kinematicsCtr))) @@ -883,10 +883,10 @@ subroutine material_parsePhase enddo #if defined(__GFORTRAN__) str = ['GfortranBug86277'] - str = phaseConfig(p)%getStrings('(stiffness_degradation)',defaultVal=str) + str = config_phase(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)::]) + str = config_phase(p)%getStrings('(stiffness_degradation)',defaultVal=[character(len=65536)::]) #endif do stiffDegradationCtr = 1_pInt, size(str) select case (trim(str(stiffDegradationCtr))) @@ -898,10 +898,10 @@ subroutine material_parsePhase enddo enddo - allocate(phase_plasticityInstance(size(phaseConfig)), source=0_pInt) - allocate(phase_elasticityInstance(size(phaseConfig)), source=0_pInt) + allocate(phase_plasticityInstance(size(config_phase)), source=0_pInt) + allocate(phase_elasticityInstance(size(config_phase)), source=0_pInt) - do p=1_pInt, size(phaseConfig) + do p=1_pInt, size(config_phase) phase_elasticityInstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p)) phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) enddo @@ -920,7 +920,7 @@ subroutine material_parseTexture IO_floatValue, & IO_stringValue use config, only: & - textureConfig, & + config_texture, & config_deallocate use math, only: & inRad, & @@ -934,31 +934,31 @@ subroutine material_parseTexture integer(pInt), dimension(:), allocatable :: chunkPos character(len=65536) :: tag - allocate(texture_ODFfile(size(textureConfig))); texture_ODFfile='' - allocate(texture_symmetry(size(textureConfig)), source=1_pInt) - allocate(texture_Ngauss(size(textureConfig)), source=0_pInt) - allocate(texture_Nfiber(size(textureConfig)), source=0_pInt) + allocate(texture_ODFfile(size(config_texture))); texture_ODFfile='' + allocate(texture_symmetry(size(config_texture)), source=1_pInt) + allocate(texture_Ngauss(size(config_texture)), source=0_pInt) + allocate(texture_Nfiber(size(config_texture)), source=0_pInt) - do t=1_pInt, size(textureConfig) - texture_Ngauss(t) = textureConfig(t)%countKeys('(gauss)') & - + textureConfig(t)%countKeys('(random)') - texture_Nfiber(t) = textureConfig(t)%countKeys('(fiber)') + do t=1_pInt, size(config_texture) + texture_Ngauss(t) = config_texture(t)%countKeys('(gauss)') & + + config_texture(t)%countKeys('(random)') + texture_Nfiber(t) = config_texture(t)%countKeys('(fiber)') enddo texture_maxNgauss = maxval(texture_Ngauss) texture_maxNfiber = maxval(texture_Nfiber) - allocate(texture_Gauss (5,texture_maxNgauss,size(textureConfig)), source=0.0_pReal) - allocate(texture_Fiber (6,texture_maxNfiber,size(textureConfig)), source=0.0_pReal) - allocate(texture_transformation(3,3,size(textureConfig)), source=0.0_pReal) - texture_transformation = spread(math_I3,3,size(textureConfig)) + allocate(texture_Gauss (5,texture_maxNgauss,size(config_texture)), source=0.0_pReal) + allocate(texture_Fiber (6,texture_maxNfiber,size(config_texture)), source=0.0_pReal) + allocate(texture_transformation(3,3,size(config_texture)), source=0.0_pReal) + texture_transformation = spread(math_I3,3,size(config_texture)) - do t=1_pInt, size(textureConfig) + do t=1_pInt, size(config_texture) section = t gauss = 0_pInt fiber = 0_pInt - if (textureConfig(t)%keyExists('axes')) then - strings = textureConfig(t)%getStrings('axes') + if (config_texture(t)%keyExists('axes')) then + strings = config_texture(t)%getStrings('axes') do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries select case (strings(j)) case('x', '+x') @@ -981,10 +981,10 @@ subroutine material_parseTexture endif tag='' - texture_ODFfile(t) = textureConfig(t)%getString('hybridia',defaultVal=tag) + texture_ODFfile(t) = config_texture(t)%getString('hybridia',defaultVal=tag) - if (textureConfig(t)%keyExists('symmetry')) then - select case (textureConfig(t)%getString('symmetry')) + if (config_texture(t)%keyExists('symmetry')) then + select case (config_texture(t)%getString('symmetry')) case('orthotropic') texture_symmetry(t) = 4_pInt case('monoclinic') @@ -994,8 +994,8 @@ subroutine material_parseTexture end select endif - if (textureConfig(t)%keyExists('(random)')) then - strings = textureConfig(t)%getStrings('(random)',raw=.true.) + if (config_texture(t)%keyExists('(random)')) then + strings = config_texture(t)%getStrings('(random)',raw=.true.) do i = 1_pInt, size(strings) gauss = gauss + 1_pInt texture_Gauss(1:3,gauss,t) = math_sampleRandomOri() @@ -1012,9 +1012,9 @@ subroutine material_parseTexture endif - if (textureConfig(t)%keyExists('(gauss)')) then + if (config_texture(t)%keyExists('(gauss)')) then gauss = gauss + 1_pInt - strings = textureConfig(t)%getStrings('(gauss)',raw= .true.) + strings = config_texture(t)%getStrings('(gauss)',raw= .true.) do i = 1_pInt , size(strings) chunkPos = IO_stringPos(strings(i)) do j = 1_pInt,9_pInt,2_pInt @@ -1035,9 +1035,9 @@ subroutine material_parseTexture endif - if (textureConfig(t)%keyExists('(fiber)')) then + if (config_texture(t)%keyExists('(fiber)')) then fiber = fiber + 1_pInt - strings = textureConfig(t)%getStrings('(fiber)',raw= .true.) + strings = config_texture(t)%getStrings('(fiber)',raw= .true.) do i = 1_pInt, size(strings) chunkPos = IO_stringPos(strings(i)) do j = 1_pInt,11_pInt,2_pInt @@ -1090,8 +1090,8 @@ subroutine material_populateGrains FE_Nips, & FE_geomtype use config, only: & - homogenizationConfig, & - microstructureConfig, & + config_homogenization, & + config_microstructure, & homogenization_name, & microstructure_name use IO, only: & @@ -1130,8 +1130,8 @@ subroutine material_populateGrains allocate(material_texture(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source=0_pInt) allocate(material_EulerAngles(3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) - allocate(Ngrains(size(homogenizationConfig),size(microstructureConfig)), source=0_pInt) - allocate(Nelems (size(homogenizationConfig),size(microstructureConfig)), source=0_pInt) + allocate(Ngrains(size(config_homogenization),size(config_microstructure)), source=0_pInt) + allocate(Nelems (size(config_homogenization),size(config_microstructure)), source=0_pInt) ! populating homogenization schemes in each !-------------------------------------------------------------------------------------------------- @@ -1146,9 +1146,9 @@ subroutine material_populateGrains micro = mesh_element(4,e) Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt enddo - allocate(elemsOfHomogMicro(size(homogenizationConfig),size(microstructureConfig))) - do homog = 1,size(homogenizationConfig) - do micro = 1,size(microstructureConfig) + allocate(elemsOfHomogMicro(size(config_homogenization),size(config_microstructure))) + do homog = 1,size(config_homogenization) + do micro = 1,size(config_microstructure) if (Nelems(homog,micro) > 0_pInt) then allocate(elemsOfHomogMicro(homog,micro)%p(Nelems(homog,micro))) elemsOfHomogMicro(homog,micro)%p = 0_pInt @@ -1163,9 +1163,9 @@ subroutine material_populateGrains t = FE_geomtype(mesh_element(2,e)) homog = mesh_element(3,e) micro = mesh_element(4,e) - if (homog < 1_pInt .or. homog > size(homogenizationConfig)) & ! out of bounds + if (homog < 1_pInt .or. homog > size(config_homogenization)) & ! out of bounds call IO_error(154_pInt,e,0_pInt,0_pInt) - if (micro < 1_pInt .or. micro > size(microstructureConfig)) & ! out of bounds + if (micro < 1_pInt .or. micro > size(config_microstructure)) & ! out of bounds call IO_error(155_pInt,e,0_pInt,0_pInt) if (microstructure_elemhomo(micro)) then ! how many grains are needed at this element? dGrains = homogenization_Ngrains(homog) ! only one set of Ngrains (other IPs are plain copies) @@ -1186,9 +1186,9 @@ subroutine material_populateGrains write(6,'(/,a/)') ' MATERIAL grain population' write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#' endif - homogenizationLoop: do homog = 1_pInt,size(homogenizationConfig) + homogenizationLoop: do homog = 1_pInt,size(config_homogenization) dGrains = homogenization_Ngrains(homog) ! grain number per material point - microstructureLoop: do micro = 1_pInt,size(microstructureConfig) ! all pairs of homog and micro + microstructureLoop: do micro = 1_pInt,size(config_microstructure) ! all pairs of homog and micro activePair: if (Ngrains(homog,micro) > 0_pInt) then myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate myNconstituents = microstructure_Nconstituents(micro) ! assign short name for number of constituents diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 6c2dc2ce4..264fe7e18 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -100,7 +100,7 @@ use IO plasticState use config, only: & MATERIAL_partPhase, & - phaseConfig + config_phase use lattice @@ -145,29 +145,29 @@ use IO if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then instance = phase_plasticityInstance(phase) 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) + prm%tau0 = config_phase(phase)%getFloat('tau0') + prm%tausat = config_phase(phase)%getFloat('tausat') + prm%gdot0 = config_phase(phase)%getFloat('gdot0') + prm%n = config_phase(phase)%getFloat('n') + prm%h0 = config_phase(phase)%getFloat('h0') + prm%fTaylor = config_phase(phase)%getFloat('m') + prm%h0_slopeLnRate = config_phase(phase)%getFloat('h0_slopelnrate', defaultVal=0.0_pReal) + prm%tausat_SinhFitA = config_phase(phase)%getFloat('tausat_sinhfita',defaultVal=0.0_pReal) + prm%tausat_SinhFitB = config_phase(phase)%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal) + prm%tausat_SinhFitC = config_phase(phase)%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal) + prm%tausat_SinhFitD = config_phase(phase)%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal) + prm%a = config_phase(phase)%getFloat('a') + prm%aTolFlowStress = config_phase(phase)%getFloat('atol_flowstress',defaultVal=1.0_pReal) + prm%aTolShear = config_phase(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - prm%dilatation = phaseConfig(phase)%keyExists('/dilatation/') + prm%dilatation = config_phase(phase)%keyExists('/dilatation/') #if defined(__GFORTRAN__) outputs = ['GfortranBug86277'] - outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=outputs) + outputs = config_phase(phase)%getStrings('(output)',defaultVal=outputs) if (outputs(1) == 'GfortranBug86277') outputs = [character(len=65536)::] #else - outputs = phaseConfig(phase)%getStrings('(output)',defaultVal=[character(len=65536)::]) + outputs = config_phase(phase)%getStrings('(output)',defaultVal=[character(len=65536)::]) #endif allocate(prm%outputID(0)) do i=1_pInt, size(outputs) From 78f9a107fe950d23c90c8548d7133f8f36709efb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 27 Jun 2018 09:04:14 +0200 Subject: [PATCH 89/94] exception for empty list --- src/config.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/config.f90 b/src/config.f90 index e417b2bd5..d87bb754d 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -345,6 +345,8 @@ subroutine free(this) class(tPartitionedStringList), target, intent(in) :: this type(tPartitionedStringList), pointer :: new, item + if (.not. associated(this%next)) return + item => this%next do while (associated(item%next)) new => item From 2bee95bfee00d48615462b2aa2d76954a2055adf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 27 Jun 2018 18:04:06 +0200 Subject: [PATCH 90/94] argument for checking expected shape in the future --- src/config.f90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index d87bb754d..9d2ddde4c 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -531,7 +531,7 @@ end function getString !> @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 getFloats(this,key,defaultVal) +function getFloats(this,key,defaultVal,requiredShape) use IO, only: & IO_error, & IO_stringValue, & @@ -542,6 +542,7 @@ function getFloats(this,key,defaultVal) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key real(pReal), dimension(:), intent(in), optional :: defaultVal + integer(pInt), dimension(:), intent(in), optional :: requiredShape type(tPartitionedStringList), pointer :: item integer(pInt) :: i logical :: found, & @@ -577,7 +578,7 @@ end function getFloats !> @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) +function getInts(this,key,defaultVal,requiredShape) use IO, only: & IO_error, & IO_stringValue, & @@ -587,7 +588,8 @@ function getInts(this,key,defaultVal) integer(pInt), dimension(:), allocatable :: getInts class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key - integer(pInt), dimension(:), intent(in), optional :: defaultVal + integer(pInt), dimension(:), intent(in), optional :: defaultVal, & + requiredShape type(tPartitionedStringList), pointer :: item integer(pInt) :: i logical :: found, & @@ -624,7 +626,7 @@ end function getInts !! 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 getStrings(this,key,defaultVal,raw) +function getStrings(this,key,defaultVal,requiredShape,raw) use IO, only: & IO_error, & IO_StringValue @@ -634,6 +636,7 @@ function getStrings(this,key,defaultVal,raw) class(tPartitionedStringList), intent(in) :: this character(len=*), intent(in) :: key character(len=65536),dimension(:), intent(in), optional :: defaultVal + integer(pInt), dimension(:), intent(in), optional :: requiredShape logical, intent(in), optional :: raw type(tPartitionedStringList), pointer :: item character(len=65536) :: str From 9101af84c66944d001d4b8733f24da4854c79291 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 28 Jun 2018 06:47:22 +0200 Subject: [PATCH 91/94] only testing Marc 2017 Using Intel 17 Compiler even though recommended Compiler is 16.0.2 We only have 16.0.0 and that gives random segmenation faults --- .gitlab-ci.yml | 25 +++++++++++-------------- CONFIG | 2 +- lib/damask/solver/marc.py | 4 +--- 3 files changed, 13 insertions(+), 18 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index d0c1f7100..829020e0f 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -7,7 +7,7 @@ stages: - compileSpectralGNU - prepareSpectral - spectral - - compileMarc2016 + - compileMarc2017 - marc - compileAbaqus2016 - compileAbaqus2017 @@ -69,13 +69,10 @@ variables: # ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++ Abaqus2016: "FEM/Abaqus/2016" Abaqus2017: "FEM/Abaqus/2017" - MSC2014: "FEM/MSC/2014" - MSC2014_2: "FEM/MSC/2014.2" - MSC2015: "FEM/MSC/2015" - MSC2016: "FEM/MSC/2016" + MSC2017: "FEM/MSC/2017" # ------------ Defaults ---------------------------------------------- Abaqus: "$Abaqus2017" - MSC: "$MSC2016" + MSC: "$MSC2017" # ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++ Doxygen1_8_13: "Documentation/Doxygen/1.8.13" # ------------ Defaults ---------------------------------------------- @@ -330,11 +327,11 @@ TextureComponents: ################################################################################################### -Marc_compileIfort2016: - stage: compileMarc2016 +Marc_compileIfort2017: + stage: compileMarc2017 script: - - module load $IntelCompiler16_0 $MSC2016 - - Marc_compileIfort/test.py -m 2016 + - module load $IntelCompiler17_0 $MSC2017 + - Marc_compileIfort/test.py -m 2017 except: - master - release @@ -343,7 +340,7 @@ Marc_compileIfort2016: Hex_elastic: stage: marc script: - - module load $IntelCompiler16_0 $MSC + - module load $IntelCompiler17_0 $MSC - Hex_elastic/test.py except: - master @@ -352,7 +349,7 @@ Hex_elastic: CubicFCC_elastic: stage: marc script: - - module load $IntelCompiler16_0 $MSC + - module load $IntelCompiler17_0 $MSC - CubicFCC_elastic/test.py except: - master @@ -361,7 +358,7 @@ CubicFCC_elastic: CubicBCC_elastic: stage: marc script: - - module load $IntelCompiler16_0 $MSC + - module load $IntelCompiler17_0 $MSC - CubicBCC_elastic/test.py except: - master @@ -370,7 +367,7 @@ CubicBCC_elastic: J2_plasticBehavior: stage: marc script: - - module load $IntelCompiler16_0 $MSC + - module load $IntelCompiler17_0 $MSC - J2_plasticBehavior/test.py except: - master diff --git a/CONFIG b/CONFIG index db75fa811..459216375 100644 --- a/CONFIG +++ b/CONFIG @@ -6,6 +6,6 @@ set DAMASK_BIN = ${DAMASK_ROOT}/bin set DAMASK_NUM_THREADS = 4 set MSC_ROOT = /opt/msc -set MARC_VERSION = 2016 +set MARC_VERSION = 2017 set ABAQUS_VERSION = 2017 diff --git a/lib/damask/solver/marc.py b/lib/damask/solver/marc.py index 16f3c8451..59feb3325 100644 --- a/lib/damask/solver/marc.py +++ b/lib/damask/solver/marc.py @@ -9,10 +9,8 @@ class Marc(Solver): def __init__(self): self.solver = 'Marc' self.releases = { \ + '2017': ['linux64',''], '2016': ['linux64',''], - '2015': ['linux64',''], - '2014.2':['linux64',''], - '2014' :['linux64',''], } From b3862ef800ba300bf872f817118330ce9092d51e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 28 Jun 2018 07:22:32 +0200 Subject: [PATCH 92/94] enough to support 3 versions (2018 should be out already/soon) --- src/DAMASK_marc2015.f90 | 1 - 1 file changed, 1 deletion(-) delete mode 120000 src/DAMASK_marc2015.f90 diff --git a/src/DAMASK_marc2015.f90 b/src/DAMASK_marc2015.f90 deleted file mode 120000 index 2c5bec706..000000000 --- a/src/DAMASK_marc2015.f90 +++ /dev/null @@ -1 +0,0 @@ -DAMASK_marc.f90 \ No newline at end of file From c9b2614c340c6dbee67d2c19eaee3c559f52c1ff Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 28 Jun 2018 18:04:25 +0200 Subject: [PATCH 93/94] [skip ci] updated version information after successful test of v2.0.2-156-g5e5f975b --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6c338b298..591bc9f15 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-48-gaebb06e +v2.0.2-156-g5e5f975b From a38a3ef83edaf0bacd5945359c202c48ad9fb292 Mon Sep 17 00:00:00 2001 From: Yang Su Date: Fri, 29 Jun 2018 18:45:04 -0400 Subject: [PATCH 94/94] changed state assignment to b=a;c=b from b=a;c=a --- caused memory fault in ifort15 --- src/constitutive.f90 | 59 ++++++++++++++++++++++---------------------- 1 file changed, 29 insertions(+), 30 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e6f0c07ff..dabd3c7d1 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -141,7 +141,7 @@ subroutine constitutive_init() integer(pInt), parameter :: FILEUNIT = 200_pInt integer(pInt) :: & o, & !< counter in output loop - p, & !< counter in phase loop + ph, & !< counter in phase loop s, & !< counter in source loop ins !< instance of plasticity/source @@ -202,11 +202,11 @@ subroutine constitutive_init() !-------------------------------------------------------------------------------------------------- ! write description file for constitutive output call IO_write_jobFile(FILEUNIT,'outputConstitutive') - PhaseLoop: do p = 1_pInt,material_Nphase - activePhase: if (any(material_phase == p)) then - ins = phase_plasticityInstance(p) + PhaseLoop: do ph = 1_pInt,material_Nphase + activePhase: if (any(material_phase == ph)) then + ins = phase_plasticityInstance(ph) knownPlasticity = .true. ! assume valid - plasticityType: select case(phase_plasticity(p)) + plasticityType: select case(phase_plasticity(ph)) case (PLASTICITY_NONE_ID) plasticityType outputName = PLASTICITY_NONE_label thisOutput => null() @@ -238,62 +238,62 @@ subroutine constitutive_init() case default plasticityType knownPlasticity = .false. end select plasticityType - write(FILEUNIT,'(/,a,/)') '['//trim(phase_name(p))//']' + write(FILEUNIT,'(/,a,/)') '['//trim(phase_name(ph))//']' if (knownPlasticity) then - write(FILEUNIT,'(a)') '(plasticity)'//char(9)//trim(outputName) - if (phase_plasticity(p) /= PLASTICITY_NONE_ID) then + if (phase_plasticity(ph) /= PLASTICITY_NONE_ID) then OutputPlasticityLoop: do o = 1_pInt,size(thisOutput(:,ins)) if(len(trim(thisOutput(o,ins))) > 0_pInt) & write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins) enddo OutputPlasticityLoop endif endif - SourceLoop: do s = 1_pInt, phase_Nsources(p) + + SourceLoop: do s = 1_pInt, phase_Nsources(ph) knownSource = .true. ! assume valid - sourceType: select case (phase_source(s,p)) + sourceType: select case (phase_source(s,ph)) case (SOURCE_thermal_dissipation_ID) sourceType - ins = source_thermal_dissipation_instance(p) + ins = source_thermal_dissipation_instance(ph) outputName = SOURCE_thermal_dissipation_label thisOutput => source_thermal_dissipation_output thisSize => source_thermal_dissipation_sizePostResult case (SOURCE_thermal_externalheat_ID) sourceType - ins = source_thermal_externalheat_instance(p) + ins = source_thermal_externalheat_instance(ph) outputName = SOURCE_thermal_externalheat_label thisOutput => source_thermal_externalheat_output thisSize => source_thermal_externalheat_sizePostResult case (SOURCE_damage_isoBrittle_ID) sourceType - ins = source_damage_isoBrittle_instance(p) + ins = source_damage_isoBrittle_instance(ph) outputName = SOURCE_damage_isoBrittle_label thisOutput => source_damage_isoBrittle_output thisSize => source_damage_isoBrittle_sizePostResult case (SOURCE_damage_isoDuctile_ID) sourceType - ins = source_damage_isoDuctile_instance(p) + ins = source_damage_isoDuctile_instance(ph) outputName = SOURCE_damage_isoDuctile_label thisOutput => source_damage_isoDuctile_output thisSize => source_damage_isoDuctile_sizePostResult case (SOURCE_damage_anisoBrittle_ID) sourceType - ins = source_damage_anisoBrittle_instance(p) + ins = source_damage_anisoBrittle_instance(ph) outputName = SOURCE_damage_anisoBrittle_label thisOutput => source_damage_anisoBrittle_output thisSize => source_damage_anisoBrittle_sizePostResult case (SOURCE_damage_anisoDuctile_ID) sourceType - ins = source_damage_anisoDuctile_instance(p) + ins = source_damage_anisoDuctile_instance(ph) outputName = SOURCE_damage_anisoDuctile_label thisOutput => source_damage_anisoDuctile_output thisSize => source_damage_anisoDuctile_sizePostResult case (SOURCE_vacancy_phenoplasticity_ID) sourceType - ins = source_vacancy_phenoplasticity_instance(p) + ins = source_vacancy_phenoplasticity_instance(ph) outputName = SOURCE_vacancy_phenoplasticity_label thisOutput => source_vacancy_phenoplasticity_output thisSize => source_vacancy_phenoplasticity_sizePostResult case (SOURCE_vacancy_irradiation_ID) sourceType - ins = source_vacancy_irradiation_instance(p) + ins = source_vacancy_irradiation_instance(ph) outputName = SOURCE_vacancy_irradiation_label thisOutput => source_vacancy_irradiation_output thisSize => source_vacancy_irradiation_sizePostResult case (SOURCE_vacancy_thermalfluc_ID) sourceType - ins = source_vacancy_thermalfluc_instance(p) + ins = source_vacancy_thermalfluc_instance(ph) outputName = SOURCE_vacancy_thermalfluc_label thisOutput => source_vacancy_thermalfluc_output thisSize => source_vacancy_thermalfluc_sizePostResult @@ -318,29 +318,28 @@ subroutine constitutive_init() constitutive_source_maxSizeDotState = 0_pInt constitutive_source_maxSizePostResults = 0_pInt - PhaseLoop2:do p = 1_pInt,material_Nphase + PhaseLoop2:do ph = 1_pInt,material_Nphase !-------------------------------------------------------------------------------------------------- ! partition and inititalize state - plasticState(p)%partionedState0 = plasticState(p)%State0 - plasticState(p)%State = plasticState(p)%State0 - forall(s = 1_pInt:phase_Nsources(p)) - sourceState(p)%p(s)%partionedState0 = sourceState(p)%p(s)%State0 - sourceState(p)%p(s)%State = sourceState(p)%p(s)%State0 + plasticState(ph)%partionedState0 = plasticState(ph)%state0 + plasticState(ph)%state = plasticState(ph)%partionedState0 + forall(s = 1_pInt:phase_Nsources(ph)) + sourceState(ph)%p(s)%partionedState0 = sourceState(ph)%p(s)%state0 + sourceState(ph)%p(s)%state = sourceState(ph)%p(s)%partionedState0 end forall !-------------------------------------------------------------------------------------------------- ! determine max size of state and output constitutive_plasticity_maxSizeDotState = max(constitutive_plasticity_maxSizeDotState, & - plasticState(p)%sizeDotState) + plasticState(ph)%sizeDotState) constitutive_plasticity_maxSizePostResults = max(constitutive_plasticity_maxSizePostResults, & - plasticState(p)%sizePostResults) + plasticState(ph)%sizePostResults) constitutive_source_maxSizeDotState = max(constitutive_source_maxSizeDotState, & - maxval(sourceState(p)%p(:)%sizeDotState)) + maxval(sourceState(ph)%p(:)%sizeDotState)) constitutive_source_maxSizePostResults = max(constitutive_source_maxSizePostResults, & - maxval(sourceState(p)%p(:)%sizePostResults)) + maxval(sourceState(ph)%p(:)%sizePostResults)) enddo PhaseLoop2 - end subroutine constitutive_init