From 49ae38d0f9a56598e142765c9a022a855490ab5b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 11:03:43 +0200 Subject: [PATCH 001/107] using parameters from linked list and removed output homogenization models should only provide model specific output in accordance with http://dx.doi.org/10.1007/s40192-017-0084-5 --- src/homogenization.f90 | 20 +-- src/homogenization_isostrain.f90 | 224 +++++-------------------------- 2 files changed, 39 insertions(+), 205 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 3565999a8..e1d0e9f7c 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -147,7 +147,7 @@ subroutine homogenization_init if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) & call homogenization_none_init() if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) & - call homogenization_isostrain_init(FILEUNIT) + call homogenization_isostrain_init() if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) & call homogenization_RGC_init(FILEUNIT) @@ -207,16 +207,11 @@ subroutine homogenization_init i = homogenization_typeInstance(p) ! which instance of this homogenization type valid = .true. ! assume valid select case(homogenization_type(p)) ! split per homogenization type - case (HOMOGENIZATION_NONE_ID) + case (HOMOGENIZATION_NONE_ID,HOMOGENIZATION_ISOSTRAIN_ID) outputName = HOMOGENIZATION_NONE_label thisNoutput => null() thisOutput => null() thisSize => null() - case (HOMOGENIZATION_ISOSTRAIN_ID) - outputName = HOMOGENIZATION_ISOSTRAIN_label - thisNoutput => homogenization_isostrain_Noutput - thisOutput => homogenization_isostrain_output - thisSize => homogenization_isostrain_sizePostResult case (HOMOGENIZATION_RGC_ID) outputName = HOMOGENIZATION_RGC_label thisNoutput => homogenization_RGC_Noutput @@ -1246,8 +1241,6 @@ function homogenization_postResults(ip,el) POROSITY_phasefield_ID, & HYDROGENFLUX_isoconc_ID, & HYDROGENFLUX_cahnhilliard_ID - use homogenization_isostrain, only: & - homogenization_isostrain_postResults use homogenization_RGC, only: & homogenization_RGC_postResults use thermal_adiabatic, only: & @@ -1286,15 +1279,8 @@ function homogenization_postResults(ip,el) startPos = 1_pInt endPos = homogState(mappingHomogenization(2,ip,el))%sizePostResults chosenHomogenization: select case (homogenization_type(mesh_element(3,el))) - case (HOMOGENIZATION_NONE_ID) chosenHomogenization + case (HOMOGENIZATION_NONE_ID,HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - homogenization_postResults(startPos:endPos) = & - homogenization_isostrain_postResults(& - ip, & - el, & - materialpoint_P(1:3,1:3,ip,el), & - materialpoint_F(1:3,1:3,ip,el)) case (HOMOGENIZATION_RGC_ID) chosenHomogenization homogenization_postResults(startPos:endPos) = & homogenization_RGC_postResults(& diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index 8ee0df73d..83396e206 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -9,30 +9,14 @@ module homogenization_isostrain implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - homogenization_isostrain_sizePostResults - integer(pInt), dimension(:,:), allocatable, target, public :: & - homogenization_isostrain_sizePostResult - - character(len=64), dimension(:,:), allocatable, target, public :: & - homogenization_isostrain_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & - homogenization_isostrain_Noutput !< number of outputs per homog instance integer(pInt), dimension(:), allocatable, private :: & homogenization_isostrain_Ngrains - enum, bind(c) - enumerator :: undefined_ID, & - nconstituents_ID, & - ipcoords_ID, & - avgdefgrad_ID, & - avgfirstpiola_ID - end enum + enum, bind(c) enumerator :: parallel_ID, & average_ID end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - homogenization_isostrain_outputID !< ID of each post result output + integer(kind(average_ID)), dimension(:), allocatable, private :: & homogenization_isostrain_mapping !< mapping type @@ -40,15 +24,14 @@ module homogenization_isostrain public :: & homogenization_isostrain_init, & homogenization_isostrain_partitionDeformation, & - homogenization_isostrain_averageStressAndItsTangent, & - homogenization_isostrain_postResults + homogenization_isostrain_averageStressAndItsTangent contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -subroutine homogenization_isostrain_init(fileUnit) +subroutine homogenization_isostrain_init() #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -65,19 +48,15 @@ subroutine homogenization_isostrain_init(fileUnit) use config implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & - section = 0_pInt, i, mySize, o + h integer :: & maxNinstance, & - homog, & instance integer :: & NofMyHomog ! no pInt (stores a system dependen value from 'count' character(len=65536) :: & - tag = '', & - line = '' + tag = '' write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -88,115 +67,36 @@ subroutine homogenization_isostrain_init(fileUnit) if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(homogenization_isostrain_sizePostResults(maxNinstance), source=0_pInt) - allocate(homogenization_isostrain_sizePostResult(maxval(homogenization_Noutput),maxNinstance), & - source=0_pInt) - allocate(homogenization_isostrain_Noutput(maxNinstance), source=0_pInt) - allocate(homogenization_isostrain_Ngrains(maxNinstance), source=0_pInt) - allocate(homogenization_isostrain_mapping(maxNinstance), source=average_ID) - allocate(homogenization_isostrain_output(maxval(homogenization_Noutput),maxNinstance)) - homogenization_isostrain_output = '' - allocate(homogenization_isostrain_outputID(maxval(homogenization_Noutput),maxNinstance), & - source=undefined_ID) - rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to - line = IO_read(fileUnit) + allocate(homogenization_isostrain_Ngrains(maxNinstance),source=0_pInt) + allocate(homogenization_isostrain_mapping(maxNinstance),source=average_ID) + + do h = 1_pInt, size(homogenization_type) + if (homogenization_type(h) /= HOMOGENIZATION_ISOSTRAIN_ID) cycle + instance = homogenization_typeInstance(h) + + homogenization_isostrain_Ngrains(instance) = config_homogenization(h)%getInt('nconstituents') + tag = 'sum' + tag = config_homogenization(h)%getString('mapping',defaultVal = tag) + select case(trim(tag)) + case ('parallel','sum') + homogenization_isostrain_mapping(instance) = parallel_ID + case ('average','mean','avg') + homogenization_isostrain_mapping(instance) = average_ID + case default + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_isostrain_label//')') + end select + + NofMyHomog = count(material_homog == h) + + homogState(h)%sizeState = 0_pInt + homogState(h)%sizePostResults = 0_pInt + allocate(homogState(h)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) + allocate(homogState(h)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) + allocate(homogState(h)%state (0_pInt,NofMyHomog), source=0.0_pReal) + enddo - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homogenization 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 - cycle - endif - if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if-statement). It's not safe in Fortran - if (homogenization_type(section) == HOMOGENIZATION_ISOSTRAIN_ID) then ! one of my sections - i = homogenization_typeInstance(section) ! which instance of my type is present homogenization - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case('nconstituents','ngrains') - homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt - homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = nconstituents_ID - homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case('ipcoords') - homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt - homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = ipcoords_ID - homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case('avgdefgrad','avgf') - homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt - homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = avgdefgrad_ID - homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case('avgp','avgfirstpiola','avg1stpiola') - homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt - homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = avgfirstpiola_ID - homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - - end select - case ('nconstituents','ngrains') - homogenization_isostrain_Ngrains(i) = IO_intValue(line,chunkPos,2_pInt) - case ('mapping') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('parallel','sum') - homogenization_isostrain_mapping(i) = parallel_ID - case ('average','mean','avg') - homogenization_isostrain_mapping(i) = average_ID - case default - call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_isostrain_label//')') - end select - - end select - endif - endif - enddo parsingFile - - initializeInstances: do homog = 1_pInt, material_Nhomogenization - myHomog: if (homogenization_type(homog) == HOMOGENIZATION_ISOSTRAIN_ID) then - NofMyHomog = count(material_homog == homog) - instance = homogenization_typeInstance(homog) - -! * Determine size of postResults array - outputsLoop: do o = 1_pInt, homogenization_isostrain_Noutput(instance) - select case(homogenization_isostrain_outputID(o,instance)) - case(nconstituents_ID) - mySize = 1_pInt - case(ipcoords_ID) - mySize = 3_pInt - case(avgdefgrad_ID, avgfirstpiola_ID) - mySize = 9_pInt - case default - mySize = 0_pInt - end select - - outputFound: if (mySize > 0_pInt) then - homogenization_isostrain_sizePostResult(o,instance) = mySize - homogenization_isostrain_sizePostResults(instance) = & - homogenization_isostrain_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop - -! allocate state arrays - homogState(homog)%sizeState = 0_pInt - homogState(homog)%sizePostResults = homogenization_isostrain_sizePostResults(instance) - allocate(homogState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) - allocate(homogState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) - allocate(homogState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal) - - endif myHomog - enddo initializeInstances - end subroutine homogenization_isostrain_init @@ -217,9 +117,9 @@ subroutine homogenization_isostrain_partitionDeformation(F,avgF,el) real(pReal), dimension (3,3), intent(in) :: avgF !< my average def grad integer(pInt), intent(in) :: & el !< element number - F=0.0_pReal - F(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)))= & - spread(avgF,3,homogenization_Ngrains(mesh_element(3,el))) + F = 0.0_pReal + F(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el))) = & + spread(avgF,3,homogenization_Ngrains(mesh_element(3,el))) end subroutine homogenization_isostrain_partitionDeformation @@ -261,56 +161,4 @@ subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P end subroutine homogenization_isostrain_averageStressAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of homogenization results for post file inclusion -!-------------------------------------------------------------------------------------------------- -pure function homogenization_isostrain_postResults(ip,el,avgP,avgF) - use prec, only: & - pReal - use mesh, only: & - mesh_element, & - mesh_ipCoordinates - use material, only: & - homogenization_typeInstance, & - homogenization_Noutput - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3), intent(in) :: & - avgP, & !< average stress at material point - avgF !< average deformation gradient at material point - real(pReal), dimension(homogenization_isostrain_sizePostResults & - (homogenization_typeInstance(mesh_element(3,el)))) :: & - homogenization_isostrain_postResults - - integer(pInt) :: & - homID, & - o, c - - c = 0_pInt - homID = homogenization_typeInstance(mesh_element(3,el)) - homogenization_isostrain_postResults = 0.0_pReal - - do o = 1_pInt,homogenization_Noutput(mesh_element(3,el)) - select case(homogenization_isostrain_outputID(o,homID)) - case (nconstituents_ID) - homogenization_isostrain_postResults(c+1_pInt) = real(homogenization_isostrain_Ngrains(homID),pReal) - c = c + 1_pInt - case (avgdefgrad_ID) - homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(avgF,[9]) - c = c + 9_pInt - case (avgfirstpiola_ID) - homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(avgP,[9]) - c = c + 9_pInt - case (ipcoords_ID) - homogenization_isostrain_postResults(c+1_pInt:c+3_pInt) = mesh_ipCoordinates(1:3,ip,el) ! current ip coordinates - c = c + 3_pInt - end select - enddo - -end function homogenization_isostrain_postResults - end module homogenization_isostrain From 6800a5a6f6b87324dfa2eccfd2aee7e8ae29d29c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 11:07:56 +0200 Subject: [PATCH 002/107] just adopting naming convention --- src/homogenization_none.f90 | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index c33aabe89..18df41209 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -33,26 +33,24 @@ subroutine homogenization_none_init() implicit none integer(pInt) :: & - homog, & + h, & NofMyHomog write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - initializeInstances: do homog = 1_pInt, material_Nhomogenization + do h = 1_pInt, size(homogenization_type) + if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle - myhomog: if (homogenization_type(homog) == HOMOGENIZATION_none_ID) then - NofMyHomog = count(material_homog == homog) - homogState(homog)%sizeState = 0_pInt - homogState(homog)%sizePostResults = 0_pInt - allocate(homogState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) - allocate(homogState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) - allocate(homogState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal) - - endif myhomog - enddo initializeInstances + NofMyHomog = count(material_homog == h) + homogState(h)%sizeState = 0_pInt + homogState(h)%sizePostResults = 0_pInt + allocate(homogState(h)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) + allocate(homogState(h)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) + allocate(homogState(h)%state (0_pInt,NofMyHomog), source=0.0_pReal) + enddo end subroutine homogenization_none_init From e6408e0ce3290d7863bcb7522efc9bd04b0e86cb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 26 Aug 2018 21:05:59 +0200 Subject: [PATCH 003/107] corrected careless changes using unallocated pointer and asigning wrong label --- src/homogenization.f90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index e1d0e9f7c..5fce1d247 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -207,11 +207,16 @@ subroutine homogenization_init i = homogenization_typeInstance(p) ! which instance of this homogenization type valid = .true. ! assume valid select case(homogenization_type(p)) ! split per homogenization type - case (HOMOGENIZATION_NONE_ID,HOMOGENIZATION_ISOSTRAIN_ID) + case (HOMOGENIZATION_NONE_ID) outputName = HOMOGENIZATION_NONE_label thisNoutput => null() thisOutput => null() thisSize => null() + case (HOMOGENIZATION_ISOSTRAIN_ID) + outputName = HOMOGENIZATION_ISOSTRAIN_label + thisNoutput => null() + thisOutput => null() + thisSize => null() case (HOMOGENIZATION_RGC_ID) outputName = HOMOGENIZATION_RGC_label thisNoutput => homogenization_RGC_Noutput @@ -224,7 +229,8 @@ subroutine homogenization_init if (valid) then write(FILEUNIT,'(a)') '(type)'//char(9)//trim(outputName) write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) - if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID) then + if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID .and. & + homogenization_type(p) /= HOMOGENIZATION_ISOSTRAIN_ID) then do e = 1,thisNoutput(i) write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) enddo From 11a7103675faa7a43d96b43eb5d0dc920b6de4ba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 27 Aug 2018 00:00:21 +0200 Subject: [PATCH 004/107] more explicit --- src/homogenization_none.f90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index 18df41209..0e23867f2 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -28,9 +28,13 @@ subroutine homogenization_none_init() pInt use IO, only: & IO_timeStamp - use material - use config - + use material, only: & + homogenization_type, & + material_homog, & + homogState, & + HOMOGENIZATION_NONE_LABEL, & + HOMOGENIZATION_NONE_ID + implicit none integer(pInt) :: & h, & From 331eaabaa40886618245ee1fc2ba52c58142321a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 27 Aug 2018 00:11:15 +0200 Subject: [PATCH 005/107] standard style from plasticity using derived type for parameters explicit "use" to see dependencies --- src/homogenization_isostrain.f90 | 80 ++++++++++++++++++++------------ 1 file changed, 50 insertions(+), 30 deletions(-) diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index 83396e206..af16aaddd 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -9,17 +9,19 @@ module homogenization_isostrain implicit none private - integer(pInt), dimension(:), allocatable, private :: & - homogenization_isostrain_Ngrains - enum, bind(c) enumerator :: parallel_ID, & average_ID end enum - integer(kind(average_ID)), dimension(:), allocatable, private :: & - homogenization_isostrain_mapping !< mapping type + type, private :: tParameters !< container type for internal constitutive parameters + integer(pInt) :: & + Nconstituents + integer(kind(average_ID)) :: & + mapping + end type + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) public :: & homogenization_isostrain_init, & @@ -43,9 +45,19 @@ subroutine homogenization_isostrain_init() debug_HOMOGENIZATION, & debug_level, & debug_levelBasic - use IO - use material - use config + use IO, only: & + IO_timeStamp, & + IO_error, & + IO_warning + use material, only: & + homogenization_type, & + material_homog, & + homogState, & + HOMOGENIZATION_ISOSTRAIN_ID, & + HOMOGENIZATION_ISOSTRAIN_LABEL, & + homogenization_typeInstance + use config, only: & + config_homogenization implicit none integer(pInt) :: & @@ -57,6 +69,7 @@ subroutine homogenization_isostrain_init() NofMyHomog ! no pInt (stores a system dependen value from 'count' character(len=65536) :: & tag = '' + type(tParameters) :: prm write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -68,21 +81,21 @@ subroutine homogenization_isostrain_init() if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(homogenization_isostrain_Ngrains(maxNinstance),source=0_pInt) - allocate(homogenization_isostrain_mapping(maxNinstance),source=average_ID) + allocate(param(maxNinstance)) ! one container of parameters per instance do h = 1_pInt, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_ISOSTRAIN_ID) cycle instance = homogenization_typeInstance(h) + associate(prm => param(instance)) - homogenization_isostrain_Ngrains(instance) = config_homogenization(h)%getInt('nconstituents') + prm%Nconstituents = config_homogenization(h)%getInt('nconstituents') tag = 'sum' tag = config_homogenization(h)%getString('mapping',defaultVal = tag) select case(trim(tag)) - case ('parallel','sum') - homogenization_isostrain_mapping(instance) = parallel_ID - case ('average','mean','avg') - homogenization_isostrain_mapping(instance) = average_ID + case ('sum') + prm%mapping = parallel_ID + case ('avg') + prm%mapping = average_ID case default call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_isostrain_label//')') end select @@ -94,6 +107,7 @@ subroutine homogenization_isostrain_init() allocate(homogState(h)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) allocate(homogState(h)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) allocate(homogState(h)%state (0_pInt,NofMyHomog), source=0.0_pReal) + end associate enddo @@ -110,16 +124,22 @@ subroutine homogenization_isostrain_partitionDeformation(F,avgF,el) mesh_element use material, only: & homogenization_maxNgrains, & - homogenization_Ngrains + homogenization_typeInstance implicit none real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned def grad per grain real(pReal), dimension (3,3), intent(in) :: avgF !< my average def grad - integer(pInt), intent(in) :: & - el !< element number + type(tParameters) :: & + prm + integer(pInt) :: & + el, & + instance + + instance = homogenization_typeInstance(mesh_element(3,el)) + associate(prm => param(instance)) F = 0.0_pReal - F(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el))) = & - spread(avgF,3,homogenization_Ngrains(mesh_element(3,el))) + F(1:3,1:3,1:prm%Nconstituents) = spread(avgF,3,prm%Nconstituents) + end associate end subroutine homogenization_isostrain_partitionDeformation @@ -134,7 +154,6 @@ subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P mesh_element use material, only: & homogenization_maxNgrains, & - homogenization_Ngrains, & homogenization_typeInstance implicit none @@ -142,22 +161,23 @@ subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: P !< array of current grain stresses real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< array of current grain stiffnesses - integer(pInt), intent(in) :: el !< element number + type(tParameters) :: & + prm integer(pInt) :: & - homID, & - Ngrains + el, & + instance - homID = homogenization_typeInstance(mesh_element(3,el)) - Ngrains = homogenization_Ngrains(mesh_element(3,el)) - - select case (homogenization_isostrain_mapping(homID)) + instance = homogenization_typeInstance(mesh_element(3,el)) + associate(prm => param(instance)) + select case (prm%mapping) case (parallel_ID) avgP = sum(P,3) dAvgPdAvgF = sum(dPdF,5) case (average_ID) - avgP = sum(P,3) /real(Ngrains,pReal) - dAvgPdAvgF = sum(dPdF,5)/real(Ngrains,pReal) + avgP = sum(P,3) /real(prm%Nconstituents,pReal) + dAvgPdAvgF = sum(dPdF,5)/real(prm%Nconstituents,pReal) end select + end associate end subroutine homogenization_isostrain_averageStressAndItsTangent From 9b3ddcd2c2373493abc46fb1152e37063d5d255a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 Aug 2018 06:27:38 +0200 Subject: [PATCH 006/107] more explicit --- src/homogenization_isostrain.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index af16aaddd..3ac64e6da 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -137,8 +137,9 @@ subroutine homogenization_isostrain_partitionDeformation(F,avgF,el) instance = homogenization_typeInstance(mesh_element(3,el)) associate(prm => param(instance)) - F = 0.0_pReal F(1:3,1:3,1:prm%Nconstituents) = spread(avgF,3,prm%Nconstituents) + if (homogenization_maxNgrains > prm%Nconstituents) & + F(1:3,1:3,prm%Nconstituents+1_pInt:homogenization_maxNgrains) = 0.0_pReal end associate end subroutine homogenization_isostrain_partitionDeformation From 7f00082d60fb946cf2b2dd8a0d9d9dcb94101f36 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 Aug 2018 12:57:22 +0200 Subject: [PATCH 007/107] parameters easier to identify --- src/homogenization_RGC.f90 | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 92ea5301d..84815cded 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -21,16 +21,32 @@ module homogenization_RGC homogenization_RGC_output ! name of each post result output integer(pInt), dimension(:), allocatable,target, public :: & homogenization_RGC_Noutput !< number of outputs per homog instance + + type, private :: tParameters !< container type for internal constitutive parameters + integer(pInt), dimension(:), allocatable :: & + Nconstituents + real(pReal) :: & + xiAlpha, & + ciAlpha + real(pReal), dimension(:), allocatable :: & + dAlpha, & + angles + end type + +! BEGIN DEPRECATED integer(pInt), dimension(:,:), allocatable, private :: & homogenization_RGC_Ngrains real(pReal), dimension(:,:), allocatable, private :: & homogenization_RGC_dAlpha, & homogenization_RGC_angles - real(pReal), dimension(:,:,:,:), allocatable, private :: & - homogenization_RGC_orientation real(pReal), dimension(:), allocatable, private :: & homogenization_RGC_xiAlpha, & homogenization_RGC_ciAlpha +! END DEPRECATED + + real(pReal), dimension(:,:,:,:), allocatable, private :: & + homogenization_RGC_orientation + enum, bind(c) enumerator :: undefined_ID, & constitutivework_ID, & @@ -126,10 +142,11 @@ subroutine homogenization_RGC_init(fileUnit) maxNinstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt) if (maxNinstance == 0_pInt) return - if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & + if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance allocate(homogenization_RGC_sizeState(maxNinstance), source=0_pInt) allocate(homogenization_RGC_sizePostResults(maxNinstance), source=0_pInt) + allocate(homogenization_RGC_Noutput(maxNinstance), source=0_pInt) allocate(homogenization_RGC_Ngrains(3,maxNinstance), source=0_pInt) allocate(homogenization_RGC_ciAlpha(maxNinstance), source=0.0_pReal) @@ -149,7 +166,7 @@ subroutine homogenization_RGC_init(fileUnit) line = IO_read(fileUnit) enddo - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homogenization part + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homogenization part line = IO_read(fileUnit) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') then ! stop at next part From f9214c8e1bbefcfa238f801d292db8e916083f80 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 Aug 2018 13:02:44 +0200 Subject: [PATCH 008/107] should not be handled by the individual model avg(P) and avg(F) exist independently of RGC --- src/homogenization_RGC.f90 | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 84815cded..416db979a 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -162,7 +162,7 @@ subroutine homogenization_RGC_init(fileUnit) homogenization_RGC_orientation = spread(spread(math_I3,3,mesh_maxNips),4,mesh_NcpElems) ! initialize to identity rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>'))/=material_partHomogenization) ! wind forward to + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>'))/=material_partHomogenization) ! wind forward to line = IO_read(fileUnit) enddo @@ -200,12 +200,7 @@ subroutine homogenization_RGC_init(fileUnit) homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = maximumrelaxrate_ID case('magnitudemismatch') homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = magnitudemismatch_ID - case('ipcoords') - homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = ipcoords_ID - case('avgdefgrad','avgf') - homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = avgdefgrad_ID - case('avgp','avgfirstpiola','avg1stpiola') - homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = avgfirstpiola_ID + case default homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) -1_pInt ! correct for invalid From 63b939489b610fd71c768ea5cb92f9fdeedf80b1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 Aug 2018 13:15:38 +0200 Subject: [PATCH 009/107] reading in parameters using new style in parallel --- src/homogenization_RGC.f90 | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 416db979a..6236e95b7 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -1,9 +1,10 @@ !-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Denny Tjahjanto, Max-Planck-Institut für Eisenforschung GmbH !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @brief Relaxed grain cluster (RGC) homogenization scheme -!> Ngrains is defined as p x q x r (cluster) +!> Nconstituents is defined as p x q x r (cluster) !-------------------------------------------------------------------------------------------------- module homogenization_RGC use prec, only: & @@ -62,6 +63,8 @@ module homogenization_RGC integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & homogenization_RGC_outputID !< ID of each post result output + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + public :: & homogenization_RGC_init, & homogenization_RGC_partitionDeformation, & @@ -124,13 +127,14 @@ subroutine homogenization_RGC_init(fileUnit) integer :: & homog, & NofMyHomog, & - o, & + o, h, & instance, & sizeHState integer(pInt) :: section=0_pInt, maxNinstance, i,j,e, mySize, myInstance character(len=65536) :: & tag = '', & line = '' + type(tParameters) :: prm write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming, 2(1):939–942, 2009' @@ -161,6 +165,20 @@ subroutine homogenization_RGC_init(fileUnit) allocate(homogenization_RGC_orientation(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) homogenization_RGC_orientation = spread(spread(math_I3,3,mesh_maxNips),4,mesh_NcpElems) ! initialize to identity + do h = 1_pInt, size(homogenization_type) + if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle + instance = homogenization_typeInstance(h) + associate(prm => param(instance)) + prm%Nconstituents = config_homogenization(h)%getInts('clustersize',requiredShape=[3]) + if (homogenization_Ngrains(section) /= product(prm%Nconstituents)) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_RGC_label//')') + prm%xiAlpha = config_homogenization(h)%getFloat('scalingparameter') + prm%ciAlpha = config_homogenization(h)%getFloat('overproportionality') + prm%dAlpha = config_homogenization(h)%getFloats('grainsize',requiredShape=[3]) + prm%angles = config_homogenization(h)%getFloats('clusterorientation', requiredShape=[3]) + end associate + enddo + rewind(fileUnit) do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>'))/=material_partHomogenization) ! wind forward to line = IO_read(fileUnit) From ef506b801edb18b321b5d4d882642ea7da194d40 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 29 Aug 2018 09:52:22 +0200 Subject: [PATCH 010/107] fixed two memory faults (unallocated and wrong index) --- src/homogenization_RGC.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 6236e95b7..66825d6f9 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -151,6 +151,8 @@ subroutine homogenization_RGC_init(fileUnit) allocate(homogenization_RGC_sizeState(maxNinstance), source=0_pInt) allocate(homogenization_RGC_sizePostResults(maxNinstance), source=0_pInt) + allocate(param(maxNinstance)) ! one container of parameters per instance + allocate(homogenization_RGC_Noutput(maxNinstance), source=0_pInt) allocate(homogenization_RGC_Ngrains(3,maxNinstance), source=0_pInt) allocate(homogenization_RGC_ciAlpha(maxNinstance), source=0.0_pReal) @@ -164,13 +166,13 @@ subroutine homogenization_RGC_init(fileUnit) source=0_pInt) allocate(homogenization_RGC_orientation(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) homogenization_RGC_orientation = spread(spread(math_I3,3,mesh_maxNips),4,mesh_NcpElems) ! initialize to identity - + do h = 1_pInt, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle instance = homogenization_typeInstance(h) associate(prm => param(instance)) prm%Nconstituents = config_homogenization(h)%getInts('clustersize',requiredShape=[3]) - if (homogenization_Ngrains(section) /= product(prm%Nconstituents)) & + if (homogenization_Ngrains(h) /= product(prm%Nconstituents)) & call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_RGC_label//')') prm%xiAlpha = config_homogenization(h)%getFloat('scalingparameter') prm%ciAlpha = config_homogenization(h)%getFloat('overproportionality') From 0b2dd86bbf30d4ae5bb6e9a2cdc52621960782a0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 29 Aug 2018 13:36:46 +0200 Subject: [PATCH 011/107] handling cluster orientation --- src/homogenization_RGC.f90 | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 66825d6f9..4a8b7c6c4 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -165,7 +165,6 @@ subroutine homogenization_RGC_init(fileUnit) allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),maxNinstance),& source=0_pInt) allocate(homogenization_RGC_orientation(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - homogenization_RGC_orientation = spread(spread(math_I3,3,mesh_maxNips),4,mesh_NcpElems) ! initialize to identity do h = 1_pInt, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle @@ -177,7 +176,28 @@ subroutine homogenization_RGC_init(fileUnit) prm%xiAlpha = config_homogenization(h)%getFloat('scalingparameter') prm%ciAlpha = config_homogenization(h)%getFloat('overproportionality') prm%dAlpha = config_homogenization(h)%getFloats('grainsize',requiredShape=[3]) - prm%angles = config_homogenization(h)%getFloats('clusterorientation', requiredShape=[3]) + prm%angles = config_homogenization(h)%getFloats('clusterorientation',requiredShape=[3],& + defaultVal=[400.0_pReal,400.0_pReal,400.0_pReal]) + +!-------------------------------------------------------------------------------------------------- +! * assigning cluster orientations + elementLooping: do e = 1_pInt,mesh_NcpElems + if (homogenization_typeInstance(mesh_element(3,e)) == instance) then + noOrientationGiven: if (all (prm%angles >= 399.9_pReal)) then + homogenization_RGC_orientation(1:3,1:3,1,e) = math_EulerToR(math_sampleRandomOri()) + do i = 2_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + homogenization_RGC_orientation(1:3,1:3,i,e) = merge(homogenization_RGC_orientation(1:3,1:3,1,e), & + math_EulerToR(math_sampleRandomOri()), & + microstructure_elemhomo(mesh_element(4,e))) + enddo + else noOrientationGiven + do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + homogenization_RGC_orientation(1:3,1:3,i,e) = math_EulerToR(prm%angles*inRad) + enddo + endif noOrientationGiven + endif + enddo elementLooping + end associate enddo From bcff95ddf8b5f74aa3953343050079eb8af7bc12 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 29 Aug 2018 13:52:26 +0200 Subject: [PATCH 012/107] using new values for initialization --- src/homogenization_RGC.f90 | 65 ++++++++++++-------------------------- 1 file changed, 20 insertions(+), 45 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 4a8b7c6c4..baaf7fd8d 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -130,7 +130,7 @@ subroutine homogenization_RGC_init(fileUnit) o, h, & instance, & sizeHState - integer(pInt) :: section=0_pInt, maxNinstance, i,j,e, mySize, myInstance + integer(pInt) :: section=0_pInt, maxNinstance, i,j,e, mySize character(len=65536) :: & tag = '', & line = '' @@ -198,6 +198,16 @@ subroutine homogenization_RGC_init(fileUnit) endif enddo elementLooping + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then + write(6,'(a15,1x,i4,/)') 'instance: ', instance + write(6,'(a25,3(1x,i8))') 'cluster size: ',(prm%Nconstituents(j),j=1_pInt,3_pInt) + write(6,'(a25,1x,e10.3)') 'scaling parameter: ', prm%xiAlpha + write(6,'(a25,1x,e10.3)') 'over-proportionality: ', prm%ciAlpha + write(6,'(a25,3(1x,e10.3))') 'grain size: ',(prm%dAlpha(j),j=1_pInt,3_pInt) + write(6,'(a25,3(1x,e10.3))') 'cluster orientation: ',(prm%angles(j),j=1_pInt,3_pInt) + endif + + homogenization_RGC_Ngrains(:,instance) = prm%nConstituents end associate enddo @@ -269,39 +279,6 @@ subroutine homogenization_RGC_init(fileUnit) endif enddo parsingFile -!-------------------------------------------------------------------------------------------------- -! * assigning cluster orientations - elementLooping: do e = 1_pInt,mesh_NcpElems - if (homogenization_type(mesh_element(3,e)) == HOMOGENIZATION_RGC_ID) then - myInstance = homogenization_typeInstance(mesh_element(3,e)) - if (all (homogenization_RGC_angles(1:3,myInstance) >= 399.9_pReal)) then - homogenization_RGC_orientation(1:3,1:3,1,e) = math_EulerToR(math_sampleRandomOri()) - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) - if (microstructure_elemhomo(mesh_element(4,e))) then - homogenization_RGC_orientation(1:3,1:3,i,e) = homogenization_RGC_orientation(1:3,1:3,1,e) - else - homogenization_RGC_orientation(1:3,1:3,i,e) = math_EulerToR(math_sampleRandomOri()) - endif - enddo - else - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) - homogenization_RGC_orientation(1:3,1:3,i,e) = & - math_EulerToR(homogenization_RGC_angles(1:3,myInstance)*inRad) - enddo - endif - endif - enddo elementLooping - - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then - do i = 1_pInt,maxNinstance - write(6,'(a15,1x,i4,/)') 'instance: ', i - write(6,'(a25,3(1x,i8))') 'cluster size: ',(homogenization_RGC_Ngrains(j,i),j=1_pInt,3_pInt) - write(6,'(a25,1x,e10.3)') 'scaling parameter: ', homogenization_RGC_xiAlpha(i) - write(6,'(a25,1x,e10.3)') 'over-proportionality: ', homogenization_RGC_ciAlpha(i) - write(6,'(a25,3(1x,e10.3))') 'grain size: ',(homogenization_RGC_dAlpha(j,i),j=1_pInt,3_pInt) - write(6,'(a25,3(1x,e10.3))') 'cluster orientation: ',(homogenization_RGC_angles(j,i),j=1_pInt,3_pInt) - enddo - endif !-------------------------------------------------------------------------------------------------- initializeInstances: do homog = 1_pInt, material_Nhomogenization myHomog: if (homogenization_type(homog) == HOMOGENIZATION_RGC_ID) then @@ -1425,17 +1402,15 @@ end function homogenization_RGC_grain1to3 !-------------------------------------------------------------------------------------------------- !> @brief map grain ID from in 3D (local position) to in 1D (global array) !-------------------------------------------------------------------------------------------------- -pure function homogenization_RGC_grain3to1(grain3,homID) +pure function homogenization_RGC_grain3to1(grain3,instance) implicit none integer(pInt), dimension (3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z) + integer(pInt), intent(in) :: instance ! homogenization ID integer(pInt) :: homogenization_RGC_grain3to1 integer(pInt), dimension (3) :: nGDim - integer(pInt), intent(in) :: homID ! homogenization ID -!-------------------------------------------------------------------------------------------------- -! get the grain ID - nGDim = homogenization_RGC_Ngrains(1:3,homID) + nGDim = param(instance)%Nconstituents homogenization_RGC_grain3to1 = grain3(1) + nGDim(1)*(grain3(2)-1_pInt) + nGDim(1)*nGDim(2)*(grain3(3)-1_pInt) end function homogenization_RGC_grain3to1 @@ -1444,14 +1419,14 @@ end function homogenization_RGC_grain3to1 !-------------------------------------------------------------------------------------------------- !> @brief maps interface ID from 4D (normal and local position) into 1D (global array) !-------------------------------------------------------------------------------------------------- -integer(pInt) pure function homogenization_RGC_interface4to1(iFace4D, homID) +integer(pInt) pure function homogenization_RGC_interface4to1(iFace4D, instance) implicit none integer(pInt), dimension (4), intent(in) :: iFace4D !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z) integer(pInt), dimension (3) :: nGDim,nIntFace - integer(pInt), intent(in) :: homID !< homogenization ID + integer(pInt), intent(in) :: instance - nGDim = homogenization_RGC_Ngrains(1:3,homID) + nGDim = param(instance)%Nconstituents !-------------------------------------------------------------------------------------------------- ! compute the total number of interfaces, which ... @@ -1483,15 +1458,15 @@ end function homogenization_RGC_interface4to1 !-------------------------------------------------------------------------------------------------- !> @brief maps interface ID from 1D (global array) into 4D (normal and local position) !-------------------------------------------------------------------------------------------------- -function homogenization_RGC_interface1to4(iFace1D, homID) +pure function homogenization_RGC_interface1to4(iFace1D, instance) implicit none integer(pInt), dimension (4) :: homogenization_RGC_interface1to4 integer(pInt), intent(in) :: iFace1D !< interface ID in 1D array integer(pInt), dimension (3) :: nGDim,nIntFace - integer(pInt), intent(in) :: homID !< homogenization ID + integer(pInt), intent(in) :: instance - nGDim = homogenization_RGC_Ngrains(:,homID) + nGDim = param(instance)%Nconstituents !-------------------------------------------------------------------------------------------------- ! compute the total number of interfaces, which ... From 88d776cad6b3193d449a6c9eaf93130bf26c526c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 30 Aug 2018 10:46:30 +0200 Subject: [PATCH 013/107] consistent renames --- src/homogenization_RGC.f90 | 112 ++++++++++++++++++------------------- 1 file changed, 56 insertions(+), 56 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index baaf7fd8d..e4f4a8728 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -355,19 +355,19 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,ip,el) real(pReal), dimension (3) :: aVect,nVect integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3 - integer(pInt) :: homID, iGrain,iFace,i,j + integer(pInt) :: instance, iGrain,iFace,i,j integer(pInt), parameter :: nFace = 6_pInt !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations - homID = homogenization_typeInstance(mesh_element(3,el)) + instance = homogenization_typeInstance(mesh_element(3,el)) F = 0.0_pReal do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) - iGrain3 = homogenization_RGC_grain1to3(iGrain,homID) + iGrain3 = homogenization_RGC_grain1to3(iGrain,instance) do iFace = 1_pInt,nFace intFace = homogenization_RGC_getInterface(iFace,iGrain3) ! identifying 6 interfaces of each grain - aVect = homogenization_RGC_relaxationVector(intFace,homID, ip, el) ! get the relaxation vectors for each interface from global relaxation vector array + aVect = homogenization_RGC_relaxationVector(intFace,instance, ip, el) ! get the relaxation vectors for each interface from global relaxation vector array nVect = homogenization_RGC_interfaceNormal(intFace,ip,el) ! get the normal of each interface forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & @@ -443,7 +443,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) integer(pInt), dimension (4) :: intFaceN,intFaceP,faceID integer(pInt), dimension (3) :: nGDim,iGr3N,iGr3P,stresLoc integer(pInt), dimension (2) :: residLoc - integer(pInt) homID,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain + integer(pInt) instance,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain real(pReal), dimension (3,3,homogenization_maxNgrains) :: R,pF,pR,D,pD real(pReal), dimension (3,homogenization_maxNgrains) :: NN,pNN real(pReal), dimension (3) :: normP,normN,mornP,mornN @@ -462,8 +462,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! get the dimension of the cluster (grains and interfaces) - homID = homogenization_typeInstance(mesh_element(3,el)) - nGDim = homogenization_RGC_Ngrains(1:3,homID) + instance = homogenization_typeInstance(mesh_element(3,el)) + nGDim = param(instance)%Nconstituents nGrain = homogenization_Ngrains(mesh_element(3,el)) nIntFaceTot = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) & + nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) @@ -492,7 +492,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! computing interface mismatch and stress penalty tensor for all interfaces of all grains - call homogenization_RGC_stressPenalty(R,NN,avgF,F,ip,el,homID) + call homogenization_RGC_stressPenalty(R,NN,avgF,F,ip,el,instance) !-------------------------------------------------------------------------------------------------- ! calculating volume discrepancy and stress penalty related to overall volume discrepancy @@ -519,12 +519,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !------------------------------------------------------------------------------------------------ ! computing the residual stress from the balance of traction at all (interior) interfaces do iNum = 1_pInt,nIntFaceTot - faceID = homogenization_RGC_interface1to4(iNum,homID) ! identifying the interface ID in local coordinate system (4-dimensional index) + faceID = homogenization_RGC_interface1to4(iNum,instance) ! identifying the interface ID in local coordinate system (4-dimensional index) !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrN = homogenization_RGC_grain3to1(iGr3N,homID) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrN = homogenization_RGC_grain3to1(iGr3N,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceN = homogenization_RGC_getInterface(2_pInt*faceID(1),iGr3N) normN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get the interface normal @@ -532,7 +532,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrP = homogenization_RGC_grain3to1(iGr3P,homID) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrP = homogenization_RGC_grain3to1(iGr3P,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceP = homogenization_RGC_getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) normP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get the interface normal @@ -678,18 +678,18 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! ... of the constitutive stress tangent, assembled from dPdF or material constitutive model "smatrix" allocate(smatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal) do iNum = 1_pInt,nIntFaceTot - faceID = homogenization_RGC_interface1to4(iNum,homID) ! assembling of local dPdF into global Jacobian matrix + faceID = homogenization_RGC_interface1to4(iNum,instance) ! assembling of local dPdF into global Jacobian matrix !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate sytem - iGrN = homogenization_RGC_grain3to1(iGr3N,homID) ! translate into global grain ID + iGrN = homogenization_RGC_grain3to1(iGr3N,instance) ! translate into global grain ID intFaceN = homogenization_RGC_getInterface(2_pInt*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system normN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get the interface normal do iFace = 1_pInt,nFace intFaceN = homogenization_RGC_getInterface(iFace,iGr3N) ! identifying all interfaces that influence relaxation of the above interface mornN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get normal of the interfaces - iMun = homogenization_RGC_interface4to1(intFaceN,homID) ! translate the interfaces ID into local 4-dimensional index + iMun = homogenization_RGC_interface4to1(intFaceN,instance) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0) then ! get the corresponding tangent do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) + dPdF(i,k,j,l,iGrN)*normN(k)*mornN(l) @@ -703,13 +703,13 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate sytem - iGrP = homogenization_RGC_grain3to1(iGr3P,homID) ! translate into global grain ID + iGrP = homogenization_RGC_grain3to1(iGr3P,instance) ! translate into global grain ID intFaceP = homogenization_RGC_getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the connecting interface in local coordinate system normP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get the interface normal do iFace = 1_pInt,nFace intFaceP = homogenization_RGC_getInterface(iFace,iGr3P) ! identifying all interfaces that influence relaxation of the above interface mornP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get normal of the interfaces - iMun = homogenization_RGC_interface4to1(intFaceP,homID) ! translate the interfaces ID into local 4-dimensional index + iMun = homogenization_RGC_interface4to1(intFaceP,instance) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0_pInt) then ! get the corresponding tangent do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) + dPdF(i,k,j,l,iGrP)*normP(k)*mornP(l) @@ -741,20 +741,20 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) p_relax = relax p_relax(ipert) = relax(ipert) + pPert_RGC ! perturb the relaxation vector homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,mappingHomogenization(1,ip,el)) = p_relax - call homogenization_RGC_grainDeformation(pF,avgF,ip,el) ! compute the grains deformation from perturbed state - call homogenization_RGC_stressPenalty(pR,pNN,avgF,pF,ip,el,homID) ! compute stress penalty due to interface mismatch from perturbed state + call homogenization_RGC_grainDeformation(pF,avgF,ip,el) ! compute the grains deformation from perturbed state + call homogenization_RGC_stressPenalty(pR,pNN,avgF,pF,ip,el,instance) ! compute stress penalty due to interface mismatch from perturbed state call homogenization_RGC_volumePenalty(pD,volDiscrep,pF,avgF,ip,el) ! compute stress penalty due to volume discrepancy from perturbed state !-------------------------------------------------------------------------------------------------- ! computing the global stress residual array from the perturbed state p_resid = 0.0_pReal do iNum = 1_pInt,nIntFaceTot - faceID = homogenization_RGC_interface1to4(iNum,homID) ! identifying the interface ID in local coordinate system (4-dimensional index) + faceID = homogenization_RGC_interface1to4(iNum,instance) ! identifying the interface ID in local coordinate system (4-dimensional index) !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrN = homogenization_RGC_grain3to1(iGr3N,homID) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrN = homogenization_RGC_grain3to1(iGr3N,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceN = homogenization_RGC_getInterface(2_pInt*faceID(1),iGr3N) ! identifying the interface ID of the grain normN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get the corresponding interface normal @@ -762,7 +762,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrP = homogenization_RGC_grain3to1(iGr3P,homID) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrP = homogenization_RGC_grain3to1(iGr3P,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceP = homogenization_RGC_getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the interface ID of the grain normP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get the corresponding normal @@ -907,16 +907,16 @@ subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF, integer(pInt), intent(in) :: el !< element number real(pReal), dimension (9,9) :: dPdF99 - integer(pInt) :: homID, i, j, Ngrains, iGrain + integer(pInt) :: instance, i, j, Nconstituents, iGrain - homID = homogenization_typeInstance(mesh_element(3,el)) - Ngrains = homogenization_Ngrains(mesh_element(3,el)) + instance = homogenization_typeInstance(mesh_element(3,el)) + Nconstituents = sum(param(instance)%Nconstituents) !-------------------------------------------------------------------------------------------------- ! debugging the grain tangent if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then !$OMP CRITICAL (write2out) - do iGrain = 1_pInt,Ngrains + do iGrain = 1_pInt,Nconstituents dPdF99 = math_Plain3333to99(dPdF(1:3,1:3,1:3,1:3,iGrain)) write(6,'(1x,a30,1x,i3)')'Stress tangent of grain: ',iGrain do i = 1_pInt,9_pInt @@ -930,8 +930,8 @@ subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF, !-------------------------------------------------------------------------------------------------- ! computing the average first Piola-Kirchhoff stress P and the average tangent dPdF - avgP = sum(P,3)/real(Ngrains,pReal) - dAvgPdAvgF = sum(dPdF,5)/real(Ngrains,pReal) + avgP = sum(P,3)/real(Nconstituents,pReal) + dAvgPdAvgF = sum(dPdF,5)/real(Nconstituents,pReal) end subroutine homogenization_RGC_averageStressAndItsTangent @@ -957,19 +957,21 @@ pure function homogenization_RGC_postResults(ip,el,avgP,avgF) avgP, & !< average stress at material point avgF !< average deformation gradient at material point - integer(pInt) homID,o,c,nIntFaceTot + integer(pInt) instance,o,c,nIntFaceTot + type(tParameters) :: prm real(pReal), dimension(homogenization_RGC_sizePostResults(homogenization_typeInstance(mesh_element(3,el)))) :: & homogenization_RGC_postResults - homID = homogenization_typeInstance(mesh_element(3,el)) - nIntFaceTot=(homogenization_RGC_Ngrains(1,homID)-1_pInt)*homogenization_RGC_Ngrains(2,homID)*homogenization_RGC_Ngrains(3,homID)& - + homogenization_RGC_Ngrains(1,homID)*(homogenization_RGC_Ngrains(2,homID)-1_pInt)*homogenization_RGC_Ngrains(3,homID)& - + homogenization_RGC_Ngrains(1,homID)*homogenization_RGC_Ngrains(2,homID)*(homogenization_RGC_Ngrains(3,homID)-1_pInt) + instance = homogenization_typeInstance(mesh_element(3,el)) + associate(prm => param(instance)) + nIntFaceTot=(prm%Nconstituents(1)-1_pInt)*prm%Nconstituents(2)* prm%Nconstituents(3)& + + prm%Nconstituents(1)* (prm%Nconstituents(2)-1_pInt)*prm%Nconstituents(3)& + + prm%Nconstituents(1)* prm%Nconstituents(2)* (prm%Nconstituents(3)-1_pInt) c = 0_pInt homogenization_RGC_postResults = 0.0_pReal do o = 1_pInt,homogenization_Noutput(mesh_element(3,el)) - select case(homogenization_RGC_outputID(o,homID)) + select case(homogenization_RGC_outputID(o,instance)) case (avgdefgrad_ID) homogenization_RGC_postResults(c+1_pInt:c+9_pInt) = reshape(avgF,[9]) c = c + 9_pInt @@ -1009,14 +1011,14 @@ pure function homogenization_RGC_postResults(ip,el,avgP,avgF) c = c + 1_pInt end select enddo - + end associate end function homogenization_RGC_postResults !-------------------------------------------------------------------------------------------------- !> @brief calculate stress-like penalty due to deformation mismatch !-------------------------------------------------------------------------------------------------- -subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,homID) +subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) use debug, only: & debug_level, & debug_homogenization,& @@ -1040,19 +1042,19 @@ subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,homID) real(pReal), dimension (3,homogenization_maxNgrains), intent(out) :: nMis !< total amount of mismatch real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef !< deformation gradients real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor - integer(pInt), intent(in) :: ip,el + integer(pInt), intent(in) :: ip,el,instance integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3,iGNghb3,nGDim real(pReal), dimension (3,3) :: gDef,nDef real(pReal), dimension (3) :: nVect,surfCorr real(pReal), dimension (2) :: Gmoduli - integer(pInt) :: homID,iGrain,iGNghb,iFace,i,j,k,l + integer(pInt) :: iGrain,iGNghb,iFace,i,j,k,l real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb integer(pInt), parameter :: nFace = 6_pInt real(pReal), parameter :: nDefToler = 1.0e-10_pReal - nGDim = homogenization_RGC_Ngrains(1:3,homID) + nGDim = param(instance)%Nconstituents rPen = 0.0_pReal nMis = 0.0_pReal @@ -1077,7 +1079,7 @@ subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,homID) Gmoduli = homogenization_RGC_equivalentModuli(iGrain,ip,el) muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector - iGrain3 = homogenization_RGC_grain1to3(iGrain,homID) ! get the grain ID in local 3-dimensional index (x,y,z)-position + iGrain3 = homogenization_RGC_grain1to3(iGrain,instance) ! get the grain ID in local 3-dimensional index (x,y,z)-position !* Looping over all six interfaces of each grain do iFace = 1_pInt,nFace @@ -1091,7 +1093,7 @@ subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,homID) if (iGNghb3(2) > nGDim(2)) iGNghb3(2) = 1_pInt if (iGNghb3(3) < 1) iGNghb3(3) = nGDim(3) ! with periodicity along e3 direction if (iGNghb3(3) > nGDim(3)) iGNghb3(3) = 1_pInt - iGNghb = homogenization_RGC_grain3to1(iGNghb3,homID) ! get the ID of the neighboring grain + iGNghb = homogenization_RGC_grain3to1(iGNghb3,instance) ! get the ID of the neighboring grain Gmoduli = homogenization_RGC_equivalentModuli(iGNghb,ip,el) ! collecting the shear modulus and Burgers vector of the neighbor muGNghb = Gmoduli(1) bgGNghb = Gmoduli(2) @@ -1127,9 +1129,9 @@ subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,homID) ! compute the stress penalty of all interfaces do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt - rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*homogenization_RGC_xiAlpha(homID) & - *surfCorr(abs(intFace(1)))/homogenization_RGC_dAlpha(abs(intFace(1)),homID) & - *cosh(homogenization_RGC_ciAlpha(homID)*nDefNorm) & + rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*homogenization_RGC_xiAlpha(instance) & + *surfCorr(abs(intFace(1)))/homogenization_RGC_dAlpha(abs(intFace(1)),instance) & + *cosh(homogenization_RGC_ciAlpha(instance)*nDefNorm) & *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_civita(k,l,j) & *tanh(nDefNorm/xSmoo_RGC) enddo; enddo @@ -1298,7 +1300,7 @@ end function homogenization_RGC_equivalentModuli !-------------------------------------------------------------------------------------------------- !> @brief collect relaxation vectors of an interface !-------------------------------------------------------------------------------------------------- -function homogenization_RGC_relaxationVector(intFace,homID, ip, el) +function homogenization_RGC_relaxationVector(intFace,instance, ip, el) use material, only: & homogState, & mappingHomogenization @@ -1310,13 +1312,13 @@ function homogenization_RGC_relaxationVector(intFace,homID, ip, el) integer(pInt), dimension (3) :: nGDim integer(pInt) :: & iNum, & - homID !< homogenization ID + instance !< homogenization ID !-------------------------------------------------------------------------------------------------- ! collect the interface relaxation vector from the global state array homogenization_RGC_relaxationVector = 0.0_pReal - nGDim = homogenization_RGC_Ngrains(1:3,homID) - iNum = homogenization_RGC_interface4to1(intFace,homID) ! identify the position of the interface in global state array + nGDim = homogenization_RGC_Ngrains(1:3,instance) + iNum = homogenization_RGC_interface4to1(intFace,instance) ! identify the position of the interface in global state array if (iNum > 0_pInt) homogenization_RGC_relaxationVector = homogState(mappingHomogenization(2,ip,el))% & state((3*iNum-2):(3*iNum),mappingHomogenization(1,ip,el)) ! get the corresponding entries @@ -1380,18 +1382,16 @@ end function homogenization_RGC_getInterface !-------------------------------------------------------------------------------------------------- !> @brief map grain ID from in 1D (global array) to in 3D (local position) !-------------------------------------------------------------------------------------------------- -function homogenization_RGC_grain1to3(grain1,homID) +function homogenization_RGC_grain1to3(grain1,instance) implicit none integer(pInt), dimension (3) :: homogenization_RGC_grain1to3 integer(pInt), intent(in) :: & grain1,& !< grain ID in 1D array - homID !< homogenization ID + instance integer(pInt), dimension (3) :: nGDim -!-------------------------------------------------------------------------------------------------- -! get the grain position - nGDim = homogenization_RGC_Ngrains(1:3,homID) + nGDim = param(instance)%Nconstituents homogenization_RGC_grain1to3(3) = 1_pInt+(grain1-1_pInt)/(nGDim(1)*nGDim(2)) homogenization_RGC_grain1to3(2) = 1_pInt+mod((grain1-1_pInt)/nGDim(1),nGDim(2)) homogenization_RGC_grain1to3(1) = 1_pInt+mod((grain1-1_pInt),nGDim(1)) @@ -1544,18 +1544,18 @@ subroutine homogenization_RGC_grainDeformation(F, avgF, ip, el) real(pReal), dimension (3) :: aVect,nVect integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3 - integer(pInt) :: homID, iGrain,iFace,i,j + integer(pInt) :: instance, iGrain,iFace,i,j integer(pInt), parameter :: nFace = 6_pInt !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations - homID = homogenization_typeInstance(mesh_element(3,el)) + instance = homogenization_typeInstance(mesh_element(3,el)) F = 0.0_pReal do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) - iGrain3 = homogenization_RGC_grain1to3(iGrain,homID) + iGrain3 = homogenization_RGC_grain1to3(iGrain,instance) do iFace = 1_pInt,nFace intFace = homogenization_RGC_getInterface(iFace,iGrain3) - aVect = homogenization_RGC_relaxationVector(intFace,homID, ip, el) + aVect = homogenization_RGC_relaxationVector(intFace,instance, ip, el) nVect = homogenization_RGC_interfaceNormal(intFace,ip,el) forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! effective relaxations From 1f9a6143887dfbbe363fce81258399bd26696da9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 30 Aug 2018 10:50:52 +0200 Subject: [PATCH 014/107] no need to have long prefixes for local variables and functions --- src/homogenization_RGC.f90 | 295 ++++++++++++++++++------------------- 1 file changed, 143 insertions(+), 152 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index e4f4a8728..524ae5790 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -72,18 +72,18 @@ module homogenization_RGC homogenization_RGC_updateState, & homogenization_RGC_postResults private :: & - homogenization_RGC_stressPenalty, & - homogenization_RGC_volumePenalty, & - homogenization_RGC_grainDeformation, & - homogenization_RGC_surfaceCorrection, & - homogenization_RGC_equivalentModuli, & - homogenization_RGC_relaxationVector, & - homogenization_RGC_interfaceNormal, & - homogenization_RGC_getInterface, & - homogenization_RGC_grain1to3, & - homogenization_RGC_grain3to1, & - homogenization_RGC_interface4to1, & - homogenization_RGC_interface1to4 + stressPenalty, & + volumePenalty, & + grainDeformation, & + surfaceCorrection, & + equivalentModuli, & + relaxationVector, & + interfaceNormal, & + getInterface, & + grain1to3, & + grain3to1, & + interface4to1, & + interface1to4 contains @@ -363,13 +363,13 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,ip,el) instance = homogenization_typeInstance(mesh_element(3,el)) F = 0.0_pReal do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) - iGrain3 = homogenization_RGC_grain1to3(iGrain,instance) + iGrain3 = grain1to3(iGrain,instance) do iFace = 1_pInt,nFace - intFace = homogenization_RGC_getInterface(iFace,iGrain3) ! identifying 6 interfaces of each grain + intFace = getInterface(iFace,iGrain3) ! identifying 6 interfaces of each grain - aVect = homogenization_RGC_relaxationVector(intFace,instance, ip, el) ! get the relaxation vectors for each interface from global relaxation vector array + aVect = relaxationVector(intFace,instance, ip, el) ! get the relaxation vectors for each interface from global relaxation vector array - nVect = homogenization_RGC_interfaceNormal(intFace,ip,el) ! get the normal of each interface + nVect = interfaceNormal(intFace,ip,el) ! get the normal of each interface forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! calculating deformation relaxations due to interface relaxation enddo @@ -492,11 +492,11 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! computing interface mismatch and stress penalty tensor for all interfaces of all grains - call homogenization_RGC_stressPenalty(R,NN,avgF,F,ip,el,instance) + call stressPenalty(R,NN,avgF,F,ip,el,instance) !-------------------------------------------------------------------------------------------------- ! calculating volume discrepancy and stress penalty related to overall volume discrepancy - call homogenization_RGC_volumePenalty(D,volDiscrep,F,avgF,ip,el) + call volumePenalty(D,volDiscrep,F,avgF,ip,el) !-------------------------------------------------------------------------------------------------- ! debugging the mismatch, stress and penalties of grains @@ -519,22 +519,22 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !------------------------------------------------------------------------------------------------ ! computing the residual stress from the balance of traction at all (interior) interfaces do iNum = 1_pInt,nIntFaceTot - faceID = homogenization_RGC_interface1to4(iNum,instance) ! identifying the interface ID in local coordinate system (4-dimensional index) + faceID = interface1to4(iNum,instance) ! identifying the interface ID in local coordinate system (4-dimensional index) !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrN = homogenization_RGC_grain3to1(iGr3N,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) - intFaceN = homogenization_RGC_getInterface(2_pInt*faceID(1),iGr3N) - normN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get the interface normal + iGrN = grain3to1(iGr3N,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) + intFaceN = getInterface(2_pInt*faceID(1),iGr3N) + normN = interfaceNormal(intFaceN,ip,el) ! get the interface normal !-------------------------------------------------------------------------------------------------- ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrP = homogenization_RGC_grain3to1(iGr3P,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) - intFaceP = homogenization_RGC_getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) - normP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get the interface normal + iGrP = grain3to1(iGr3P,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) + intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) + normP = interfaceNormal(intFaceP,ip,el) ! get the interface normal !-------------------------------------------------------------------------------------------------- ! compute the residual of traction at the interface (in local system, 4-dimensional index) @@ -678,18 +678,18 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! ... of the constitutive stress tangent, assembled from dPdF or material constitutive model "smatrix" allocate(smatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal) do iNum = 1_pInt,nIntFaceTot - faceID = homogenization_RGC_interface1to4(iNum,instance) ! assembling of local dPdF into global Jacobian matrix + faceID = interface1to4(iNum,instance) ! assembling of local dPdF into global Jacobian matrix !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate sytem - iGrN = homogenization_RGC_grain3to1(iGr3N,instance) ! translate into global grain ID - intFaceN = homogenization_RGC_getInterface(2_pInt*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system - normN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get the interface normal + iGrN = grain3to1(iGr3N,instance) ! translate into global grain ID + intFaceN = getInterface(2_pInt*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system + normN = interfaceNormal(intFaceN,ip,el) ! get the interface normal do iFace = 1_pInt,nFace - intFaceN = homogenization_RGC_getInterface(iFace,iGr3N) ! identifying all interfaces that influence relaxation of the above interface - mornN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get normal of the interfaces - iMun = homogenization_RGC_interface4to1(intFaceN,instance) ! translate the interfaces ID into local 4-dimensional index + intFaceN = getInterface(iFace,iGr3N) ! identifying all interfaces that influence relaxation of the above interface + mornN = interfaceNormal(intFaceN,ip,el) ! get normal of the interfaces + iMun = interface4to1(intFaceN,instance) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0) then ! get the corresponding tangent do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) + dPdF(i,k,j,l,iGrN)*normN(k)*mornN(l) @@ -703,13 +703,13 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate sytem - iGrP = homogenization_RGC_grain3to1(iGr3P,instance) ! translate into global grain ID - intFaceP = homogenization_RGC_getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the connecting interface in local coordinate system - normP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get the interface normal + iGrP = grain3to1(iGr3P,instance) ! translate into global grain ID + intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the connecting interface in local coordinate system + normP = interfaceNormal(intFaceP,ip,el) ! get the interface normal do iFace = 1_pInt,nFace - intFaceP = homogenization_RGC_getInterface(iFace,iGr3P) ! identifying all interfaces that influence relaxation of the above interface - mornP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get normal of the interfaces - iMun = homogenization_RGC_interface4to1(intFaceP,instance) ! translate the interfaces ID into local 4-dimensional index + intFaceP = getInterface(iFace,iGr3P) ! identifying all interfaces that influence relaxation of the above interface + mornP = interfaceNormal(intFaceP,ip,el) ! get normal of the interfaces + iMun = interface4to1(intFaceP,instance) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0_pInt) then ! get the corresponding tangent do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) + dPdF(i,k,j,l,iGrP)*normP(k)*mornP(l) @@ -741,30 +741,30 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) p_relax = relax p_relax(ipert) = relax(ipert) + pPert_RGC ! perturb the relaxation vector homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,mappingHomogenization(1,ip,el)) = p_relax - call homogenization_RGC_grainDeformation(pF,avgF,ip,el) ! compute the grains deformation from perturbed state - call homogenization_RGC_stressPenalty(pR,pNN,avgF,pF,ip,el,instance) ! compute stress penalty due to interface mismatch from perturbed state - call homogenization_RGC_volumePenalty(pD,volDiscrep,pF,avgF,ip,el) ! compute stress penalty due to volume discrepancy from perturbed state + call grainDeformation(pF,avgF,ip,el) ! compute the grains deformation from perturbed state + call stressPenalty(pR,pNN,avgF,pF,ip,el,instance) ! compute stress penalty due to interface mismatch from perturbed state + call volumePenalty(pD,volDiscrep,pF,avgF,ip,el) ! compute stress penalty due to volume discrepancy from perturbed state !-------------------------------------------------------------------------------------------------- ! computing the global stress residual array from the perturbed state p_resid = 0.0_pReal do iNum = 1_pInt,nIntFaceTot - faceID = homogenization_RGC_interface1to4(iNum,instance) ! identifying the interface ID in local coordinate system (4-dimensional index) + faceID = interface1to4(iNum,instance) ! identifying the interface ID in local coordinate system (4-dimensional index) !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrN = homogenization_RGC_grain3to1(iGr3N,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) - intFaceN = homogenization_RGC_getInterface(2_pInt*faceID(1),iGr3N) ! identifying the interface ID of the grain - normN = homogenization_RGC_interfaceNormal(intFaceN,ip,el) ! get the corresponding interface normal + iGrN = grain3to1(iGr3N,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) + intFaceN = getInterface(2_pInt*faceID(1),iGr3N) ! identifying the interface ID of the grain + normN = interfaceNormal(intFaceN,ip,el) ! get the corresponding interface normal !-------------------------------------------------------------------------------------------------- ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrP = homogenization_RGC_grain3to1(iGr3P,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) - intFaceP = homogenization_RGC_getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the interface ID of the grain - normP = homogenization_RGC_interfaceNormal(intFaceP,ip,el) ! get the corresponding normal + iGrP = grain3to1(iGr3P,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) + intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the interface ID of the grain + normP = interfaceNormal(intFaceP,ip,el) ! get the corresponding normal !-------------------------------------------------------------------------------------------------- ! compute the residual stress (contribution of mismatch and volume penalties) from perturbed state @@ -939,7 +939,7 @@ end subroutine homogenization_RGC_averageStressAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief return array of homogenization results for post file inclusion !-------------------------------------------------------------------------------------------------- -pure function homogenization_RGC_postResults(ip,el,avgP,avgF) +pure function homogenization_RGC_postResults(ip,el,avgP,avgF) result(postResults) use mesh, only: & mesh_element, & mesh_ipCoordinates @@ -960,7 +960,7 @@ pure function homogenization_RGC_postResults(ip,el,avgP,avgF) integer(pInt) instance,o,c,nIntFaceTot type(tParameters) :: prm real(pReal), dimension(homogenization_RGC_sizePostResults(homogenization_typeInstance(mesh_element(3,el)))) :: & - homogenization_RGC_postResults + postResults instance = homogenization_typeInstance(mesh_element(3,el)) associate(prm => param(instance)) @@ -969,44 +969,35 @@ pure function homogenization_RGC_postResults(ip,el,avgP,avgF) + prm%Nconstituents(1)* prm%Nconstituents(2)* (prm%Nconstituents(3)-1_pInt) c = 0_pInt - homogenization_RGC_postResults = 0.0_pReal + postResults = 0.0_pReal do o = 1_pInt,homogenization_Noutput(mesh_element(3,el)) select case(homogenization_RGC_outputID(o,instance)) - case (avgdefgrad_ID) - homogenization_RGC_postResults(c+1_pInt:c+9_pInt) = reshape(avgF,[9]) - c = c + 9_pInt - case (avgfirstpiola_ID) - homogenization_RGC_postResults(c+1_pInt:c+9_pInt) = reshape(avgP,[9]) - c = c + 9_pInt - case (ipcoords_ID) - homogenization_RGC_postResults(c+1_pInt:c+3_pInt) = mesh_ipCoordinates(1:3,ip,el) ! current ip coordinates - c = c + 3_pInt case (constitutivework_ID) - homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & state(3*nIntFaceTot+1,mappingHomogenization(1,ip,el)) c = c + 1_pInt case (magnitudemismatch_ID) - homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & state(3*nIntFaceTot+2,mappingHomogenization(1,ip,el)) - homogenization_RGC_postResults(c+2) = homogState(mappingHomogenization(2,ip,el))% & + postResults(c+2) = homogState(mappingHomogenization(2,ip,el))% & state(3*nIntFaceTot+3,mappingHomogenization(1,ip,el)) - homogenization_RGC_postResults(c+3) = homogState(mappingHomogenization(2,ip,el))% & + postResults(c+3) = homogState(mappingHomogenization(2,ip,el))% & state(3*nIntFaceTot+4,mappingHomogenization(1,ip,el)) c = c + 3_pInt case (penaltyenergy_ID) - homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & state(3*nIntFaceTot+5,mappingHomogenization(1,ip,el)) c = c + 1_pInt case (volumediscrepancy_ID) - homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & state(3*nIntFaceTot+6,mappingHomogenization(1,ip,el)) c = c + 1_pInt case (averagerelaxrate_ID) - homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & state(3*nIntFaceTot+7,mappingHomogenization(1,ip,el)) c = c + 1_pInt case (maximumrelaxrate_ID) - homogenization_RGC_postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & + postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & state(3*nIntFaceTot+8,mappingHomogenization(1,ip,el)) c = c + 1_pInt end select @@ -1018,7 +1009,7 @@ end function homogenization_RGC_postResults !-------------------------------------------------------------------------------------------------- !> @brief calculate stress-like penalty due to deformation mismatch !-------------------------------------------------------------------------------------------------- -subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) +subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) use debug, only: & debug_level, & debug_homogenization,& @@ -1061,7 +1052,7 @@ subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) !-------------------------------------------------------------------------------------------------- ! get the correction factor the modulus of penalty stress representing the evolution of area of ! the interfaces due to deformations - surfCorr = homogenization_RGC_surfaceCorrection(avgF,ip,el) + surfCorr = surfaceCorrection(avgF,ip,el) !-------------------------------------------------------------------------------------------------- ! debugging the surface correction factor @@ -1076,15 +1067,15 @@ subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) !-------------------------------------------------------------------------------------------------- ! computing the mismatch and penalty stress tensor of all grains do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) - Gmoduli = homogenization_RGC_equivalentModuli(iGrain,ip,el) + Gmoduli = equivalentModuli(iGrain,ip,el) muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector - iGrain3 = homogenization_RGC_grain1to3(iGrain,instance) ! get the grain ID in local 3-dimensional index (x,y,z)-position + iGrain3 = grain1to3(iGrain,instance) ! get the grain ID in local 3-dimensional index (x,y,z)-position !* Looping over all six interfaces of each grain do iFace = 1_pInt,nFace - intFace = homogenization_RGC_getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain - nVect = homogenization_RGC_interfaceNormal(intFace,ip,el) ! get the interface normal + intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain + nVect = interfaceNormal(intFace,ip,el) ! get the interface normal iGNghb3 = iGrain3 ! identify the neighboring grain across the interface iGNghb3(abs(intFace(1))) = iGNghb3(abs(intFace(1))) + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal),pInt) if (iGNghb3(1) < 1) iGNghb3(1) = nGDim(1) ! with periodicity along e1 direction @@ -1093,8 +1084,8 @@ subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) if (iGNghb3(2) > nGDim(2)) iGNghb3(2) = 1_pInt if (iGNghb3(3) < 1) iGNghb3(3) = nGDim(3) ! with periodicity along e3 direction if (iGNghb3(3) > nGDim(3)) iGNghb3(3) = 1_pInt - iGNghb = homogenization_RGC_grain3to1(iGNghb3,instance) ! get the ID of the neighboring grain - Gmoduli = homogenization_RGC_equivalentModuli(iGNghb,ip,el) ! collecting the shear modulus and Burgers vector of the neighbor + iGNghb = grain3to1(iGNghb3,instance) ! get the ID of the neighboring grain + Gmoduli = equivalentModuli(iGNghb,ip,el) ! collecting the shear modulus and Burgers vector of the neighbor muGNghb = Gmoduli(1) bgGNghb = Gmoduli(2) gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! compute the difference/jump in deformation gradeint across the neighbor @@ -1152,13 +1143,13 @@ subroutine homogenization_RGC_stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) enddo -end subroutine homogenization_RGC_stressPenalty +end subroutine stressPenalty !-------------------------------------------------------------------------------------------------- !> @brief calculate stress-like penalty due to volume discrepancy !-------------------------------------------------------------------------------------------------- -subroutine homogenization_RGC_volumePenalty(vPen,vDiscrep,fDef,fAvg,ip,el) +subroutine volumePenalty(vPen,vDiscrep,fDef,fAvg,ip,el) use debug, only: & debug_level, & debug_homogenization,& @@ -1220,20 +1211,20 @@ subroutine homogenization_RGC_volumePenalty(vPen,vDiscrep,fDef,fAvg,ip,el) endif enddo -end subroutine homogenization_RGC_volumePenalty +end subroutine volumePenalty !-------------------------------------------------------------------------------------------------- !> @brief compute the correction factor accouted for surface evolution (area change) due to ! deformation !-------------------------------------------------------------------------------------------------- -function homogenization_RGC_surfaceCorrection(avgF,ip,el) +function surfaceCorrection(avgF,ip,el) use math, only: & math_invert33, & math_mul33x33 implicit none - real(pReal), dimension(3) :: homogenization_RGC_surfaceCorrection + real(pReal), dimension(3) :: surfaceCorrection real(pReal), dimension(3,3), intent(in) :: avgF !< average F integer(pInt), intent(in) :: ip,& !< integration point number el !< element number @@ -1246,25 +1237,25 @@ function homogenization_RGC_surfaceCorrection(avgF,ip,el) avgC = math_mul33x33(transpose(avgF),avgF) call math_invert33(avgC,invC,detF,error) - homogenization_RGC_surfaceCorrection = 0.0_pReal + surfaceCorrection = 0.0_pReal do iBase = 1_pInt,3_pInt intFace = [iBase,1_pInt,1_pInt,1_pInt] - nVect = homogenization_RGC_interfaceNormal(intFace,ip,el) ! get the normal of the interface + nVect = interfaceNormal(intFace,ip,el) ! get the normal of the interface do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt - homogenization_RGC_surfaceCorrection(iBase) = & ! compute the component of (the inverse of) the stretch in the direction of the normal - homogenization_RGC_surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j) + surfaceCorrection(iBase) = & ! compute the component of (the inverse of) the stretch in the direction of the normal + surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j) enddo; enddo - homogenization_RGC_surfaceCorrection(iBase) = & ! get the surface correction factor (area contraction/enlargement) - sqrt(homogenization_RGC_surfaceCorrection(iBase))*detF + surfaceCorrection(iBase) = & ! get the surface correction factor (area contraction/enlargement) + sqrt(surfaceCorrection(iBase))*detF enddo -end function homogenization_RGC_surfaceCorrection +end function surfaceCorrection !-------------------------------------------------------------------------------------------------- !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor !-------------------------------------------------------------------------------------------------- -function homogenization_RGC_equivalentModuli(grainID,ip,el) +function equivalentModuli(grainID,ip,el) use constitutive, only: & constitutive_homogenizedC @@ -1274,7 +1265,7 @@ function homogenization_RGC_equivalentModuli(grainID,ip,el) ip, & !< integration point number el !< element number real(pReal), dimension (6,6) :: elasTens - real(pReal), dimension(2) :: homogenization_RGC_equivalentModuli + real(pReal), dimension(2) :: equivalentModuli real(pReal) :: & cEquiv_11, & cEquiv_12, & @@ -1288,26 +1279,26 @@ function homogenization_RGC_equivalentModuli(grainID,ip,el) cEquiv_12 = (elasTens(1,2) + elasTens(2,3) + elasTens(3,1) + & elasTens(1,3) + elasTens(2,1) + elasTens(3,2))/6.0_pReal cEquiv_44 = (elasTens(4,4) + elasTens(5,5) + elasTens(6,6))/3.0_pReal - homogenization_RGC_equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44 + equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44 !-------------------------------------------------------------------------------------------------- ! obtain the length of Burgers vector (could be model dependend) - homogenization_RGC_equivalentModuli(2) = 2.5e-10_pReal + equivalentModuli(2) = 2.5e-10_pReal -end function homogenization_RGC_equivalentModuli +end function equivalentModuli !-------------------------------------------------------------------------------------------------- !> @brief collect relaxation vectors of an interface !-------------------------------------------------------------------------------------------------- -function homogenization_RGC_relaxationVector(intFace,instance, ip, el) +function relaxationVector(intFace,instance, ip, el) use material, only: & homogState, & mappingHomogenization implicit none integer(pInt), intent(in) :: ip, el - real(pReal), dimension (3) :: homogenization_RGC_relaxationVector + real(pReal), dimension (3) :: relaxationVector integer(pInt), dimension (4), intent(in) :: intFace !< set of interface ID in 4D array (normal and position) integer(pInt), dimension (3) :: nGDim integer(pInt) :: & @@ -1316,19 +1307,19 @@ function homogenization_RGC_relaxationVector(intFace,instance, ip, el) !-------------------------------------------------------------------------------------------------- ! collect the interface relaxation vector from the global state array - homogenization_RGC_relaxationVector = 0.0_pReal + relaxationVector = 0.0_pReal nGDim = homogenization_RGC_Ngrains(1:3,instance) - iNum = homogenization_RGC_interface4to1(intFace,instance) ! identify the position of the interface in global state array - if (iNum > 0_pInt) homogenization_RGC_relaxationVector = homogState(mappingHomogenization(2,ip,el))% & + iNum = interface4to1(intFace,instance) ! identify the position of the interface in global state array + if (iNum > 0_pInt) relaxationVector = homogState(mappingHomogenization(2,ip,el))% & state((3*iNum-2):(3*iNum),mappingHomogenization(1,ip,el)) ! get the corresponding entries -end function homogenization_RGC_relaxationVector +end function relaxationVector !-------------------------------------------------------------------------------------------------- !> @brief identify the normal of an interface !-------------------------------------------------------------------------------------------------- -function homogenization_RGC_interfaceNormal(intFace,ip,el) +function interfaceNormal(intFace,ip,el) use debug, only: & debug_homogenization,& debug_levelExtensive @@ -1336,7 +1327,7 @@ function homogenization_RGC_interfaceNormal(intFace,ip,el) math_mul33x3 implicit none - real(pReal), dimension (3) :: homogenization_RGC_interfaceNormal + real(pReal), dimension (3) :: interfaceNormal integer(pInt), dimension (4), intent(in) :: intFace !< interface ID in 4D array (normal and position) integer(pInt), intent(in) :: & ip, & !< integration point number @@ -1345,81 +1336,81 @@ function homogenization_RGC_interfaceNormal(intFace,ip,el) !-------------------------------------------------------------------------------------------------- ! get the normal of the interface, identified from the value of intFace(1) - homogenization_RGC_interfaceNormal = 0.0_pReal + interfaceNormal = 0.0_pReal nPos = abs(intFace(1)) ! identify the position of the interface in global state array - homogenization_RGC_interfaceNormal(nPos) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis + interfaceNormal(nPos) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis - homogenization_RGC_interfaceNormal = & - math_mul33x3(homogenization_RGC_orientation(1:3,1:3,ip,el),homogenization_RGC_interfaceNormal) + interfaceNormal = & + math_mul33x3(homogenization_RGC_orientation(1:3,1:3,ip,el),interfaceNormal) ! map the normal vector into sample coordinate system (basis) -end function homogenization_RGC_interfaceNormal +end function interfaceNormal !-------------------------------------------------------------------------------------------------- !> @brief collect six faces of a grain in 4D (normal and position) !-------------------------------------------------------------------------------------------------- -function homogenization_RGC_getInterface(iFace,iGrain3) +function getInterface(iFace,iGrain3) implicit none - integer(pInt), dimension (4) :: homogenization_RGC_getInterface + integer(pInt), dimension (4) :: getInterface integer(pInt), dimension (3), intent(in) :: iGrain3 !< grain ID in 3D array integer(pInt), intent(in) :: iFace !< face index (1..6) mapped like (-e1,-e2,-e3,+e1,+e2,+e3) or iDir = (-1,-2,-3,1,2,3) integer(pInt) :: iDir !* Direction of interface normal iDir = (int(real(iFace-1_pInt,pReal)/2.0_pReal,pInt)+1_pInt)*(-1_pInt)**iFace - homogenization_RGC_getInterface(1) = iDir + getInterface(1) = iDir !-------------------------------------------------------------------------------------------------- ! identify the interface position by the direction of its normal - homogenization_RGC_getInterface(2:4) = iGrain3 + getInterface(2:4) = iGrain3 if (iDir < 0_pInt) & ! to have a correlation with coordinate/position in real space - homogenization_RGC_getInterface(1_pInt-iDir) = homogenization_RGC_getInterface(1_pInt-iDir)-1_pInt + getInterface(1_pInt-iDir) = getInterface(1_pInt-iDir)-1_pInt -end function homogenization_RGC_getInterface +end function getInterface !-------------------------------------------------------------------------------------------------- !> @brief map grain ID from in 1D (global array) to in 3D (local position) !-------------------------------------------------------------------------------------------------- -function homogenization_RGC_grain1to3(grain1,instance) +function grain1to3(grain1,instance) implicit none - integer(pInt), dimension (3) :: homogenization_RGC_grain1to3 + integer(pInt), dimension (3) :: grain1to3 integer(pInt), intent(in) :: & grain1,& !< grain ID in 1D array instance integer(pInt), dimension (3) :: nGDim nGDim = param(instance)%Nconstituents - homogenization_RGC_grain1to3(3) = 1_pInt+(grain1-1_pInt)/(nGDim(1)*nGDim(2)) - homogenization_RGC_grain1to3(2) = 1_pInt+mod((grain1-1_pInt)/nGDim(1),nGDim(2)) - homogenization_RGC_grain1to3(1) = 1_pInt+mod((grain1-1_pInt),nGDim(1)) + grain1to3(3) = 1_pInt+(grain1-1_pInt)/(nGDim(1)*nGDim(2)) + grain1to3(2) = 1_pInt+mod((grain1-1_pInt)/nGDim(1),nGDim(2)) + grain1to3(1) = 1_pInt+mod((grain1-1_pInt),nGDim(1)) -end function homogenization_RGC_grain1to3 +end function grain1to3 !-------------------------------------------------------------------------------------------------- !> @brief map grain ID from in 3D (local position) to in 1D (global array) !-------------------------------------------------------------------------------------------------- -pure function homogenization_RGC_grain3to1(grain3,instance) +pure function grain3to1(grain3,instance) implicit none integer(pInt), dimension (3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z) integer(pInt), intent(in) :: instance ! homogenization ID - integer(pInt) :: homogenization_RGC_grain3to1 + integer(pInt) :: grain3to1 integer(pInt), dimension (3) :: nGDim nGDim = param(instance)%Nconstituents - homogenization_RGC_grain3to1 = grain3(1) + nGDim(1)*(grain3(2)-1_pInt) + nGDim(1)*nGDim(2)*(grain3(3)-1_pInt) + grain3to1 = grain3(1) + nGDim(1)*(grain3(2)-1_pInt) + nGDim(1)*nGDim(2)*(grain3(3)-1_pInt) -end function homogenization_RGC_grain3to1 +end function grain3to1 !-------------------------------------------------------------------------------------------------- !> @brief maps interface ID from 4D (normal and local position) into 1D (global array) !-------------------------------------------------------------------------------------------------- -integer(pInt) pure function homogenization_RGC_interface4to1(iFace4D, instance) +integer(pInt) pure function interface4to1(iFace4D, instance) implicit none integer(pInt), dimension (4), intent(in) :: iFace4D !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z) @@ -1434,34 +1425,34 @@ integer(pInt) pure function homogenization_RGC_interface4to1(iFace4D, instance) nIntFace(2) = nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) ! ... normal //e2 nIntFace(3) = nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) ! ... normal //e3 - homogenization_RGC_interface4to1 = -1_pInt + interface4to1 = -1_pInt !-------------------------------------------------------------------------------------------------- ! get the corresponding interface ID in 1D global array if (abs(iFace4D(1)) == 1_pInt) then ! interface with normal //e1 - homogenization_RGC_interface4to1 = iFace4D(3) + nGDim(2)*(iFace4D(4)-1_pInt) & + interface4to1 = iFace4D(3) + nGDim(2)*(iFace4D(4)-1_pInt) & + nGDim(2)*nGDim(3)*(iFace4D(2)-1_pInt) - if ((iFace4D(2) == 0_pInt) .or. (iFace4D(2) == nGDim(1))) homogenization_RGC_interface4to1 = 0_pInt + if ((iFace4D(2) == 0_pInt) .or. (iFace4D(2) == nGDim(1))) interface4to1 = 0_pInt elseif (abs(iFace4D(1)) == 2_pInt) then ! interface with normal //e2 - homogenization_RGC_interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1_pInt) & + interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1_pInt) & + nGDim(3)*nGDim(1)*(iFace4D(3)-1_pInt) + nIntFace(1) - if ((iFace4D(3) == 0_pInt) .or. (iFace4D(3) == nGDim(2))) homogenization_RGC_interface4to1 = 0_pInt + if ((iFace4D(3) == 0_pInt) .or. (iFace4D(3) == nGDim(2))) interface4to1 = 0_pInt elseif (abs(iFace4D(1)) == 3_pInt) then ! interface with normal //e3 - homogenization_RGC_interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1_pInt) & + interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1_pInt) & + nGDim(1)*nGDim(2)*(iFace4D(4)-1_pInt) + nIntFace(1) + nIntFace(2) - if ((iFace4D(4) == 0_pInt) .or. (iFace4D(4) == nGDim(3))) homogenization_RGC_interface4to1 = 0_pInt + if ((iFace4D(4) == 0_pInt) .or. (iFace4D(4) == nGDim(3))) interface4to1 = 0_pInt endif -end function homogenization_RGC_interface4to1 +end function interface4to1 !-------------------------------------------------------------------------------------------------- !> @brief maps interface ID from 1D (global array) into 4D (normal and local position) !-------------------------------------------------------------------------------------------------- -pure function homogenization_RGC_interface1to4(iFace1D, instance) +pure function interface1to4(iFace1D, instance) implicit none - integer(pInt), dimension (4) :: homogenization_RGC_interface1to4 + integer(pInt), dimension (4) :: interface1to4 integer(pInt), intent(in) :: iFace1D !< interface ID in 1D array integer(pInt), dimension (3) :: nGDim,nIntFace integer(pInt), intent(in) :: instance @@ -1477,57 +1468,57 @@ pure function homogenization_RGC_interface1to4(iFace1D, instance) !-------------------------------------------------------------------------------------------------- ! get the corresponding interface ID in 4D (normal and local position) if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then ! interface with normal //e1 - homogenization_RGC_interface1to4(1) = 1_pInt - homogenization_RGC_interface1to4(3) = mod((iFace1D-1_pInt),nGDim(2))+1_pInt - homogenization_RGC_interface1to4(4) = mod(& + interface1to4(1) = 1_pInt + interface1to4(3) = mod((iFace1D-1_pInt),nGDim(2))+1_pInt + interface1to4(4) = mod(& int(& real(iFace1D-1_pInt,pReal)/& real(nGDim(2),pReal)& ,pInt)& ,nGDim(3))+1_pInt - homogenization_RGC_interface1to4(2) = int(& + interface1to4(2) = int(& real(iFace1D-1_pInt,pReal)/& real(nGDim(2),pReal)/& real(nGDim(3),pReal)& ,pInt)+1_pInt elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then ! interface with normal //e2 - homogenization_RGC_interface1to4(1) = 2_pInt - homogenization_RGC_interface1to4(4) = mod((iFace1D-nIntFace(1)-1_pInt),nGDim(3))+1_pInt - homogenization_RGC_interface1to4(2) = mod(& + interface1to4(1) = 2_pInt + interface1to4(4) = mod((iFace1D-nIntFace(1)-1_pInt),nGDim(3))+1_pInt + interface1to4(2) = mod(& int(& real(iFace1D-nIntFace(1)-1_pInt,pReal)/& real(nGDim(3),pReal)& ,pInt)& ,nGDim(1))+1_pInt - homogenization_RGC_interface1to4(3) = int(& + interface1to4(3) = int(& real(iFace1D-nIntFace(1)-1_pInt,pReal)/& real(nGDim(3),pReal)/& real(nGDim(1),pReal)& ,pInt)+1_pInt elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal //e3 - homogenization_RGC_interface1to4(1) = 3_pInt - homogenization_RGC_interface1to4(2) = mod((iFace1D-nIntFace(2)-nIntFace(1)-1_pInt),nGDim(1))+1_pInt - homogenization_RGC_interface1to4(3) = mod(& + interface1to4(1) = 3_pInt + interface1to4(2) = mod((iFace1D-nIntFace(2)-nIntFace(1)-1_pInt),nGDim(1))+1_pInt + interface1to4(3) = mod(& int(& real(iFace1D-nIntFace(2)-nIntFace(1)-1_pInt,pReal)/& real(nGDim(1),pReal)& ,pInt)& ,nGDim(2))+1_pInt - homogenization_RGC_interface1to4(4) = int(& + interface1to4(4) = int(& real(iFace1D-nIntFace(2)-nIntFace(1)-1_pInt,pReal)/& real(nGDim(1),pReal)/& real(nGDim(2),pReal)& ,pInt)+1_pInt endif -end function homogenization_RGC_interface1to4 +end function interface1to4 !-------------------------------------------------------------------------------------------------- !> @brief calculating the grain deformation gradient (the same with ! homogenization_RGC_partionDeformation, but used only for perturbation scheme) !-------------------------------------------------------------------------------------------------- -subroutine homogenization_RGC_grainDeformation(F, avgF, ip, el) +subroutine grainDeformation(F, avgF, ip, el) use mesh, only: & mesh_element use material, only: & @@ -1552,17 +1543,17 @@ subroutine homogenization_RGC_grainDeformation(F, avgF, ip, el) instance = homogenization_typeInstance(mesh_element(3,el)) F = 0.0_pReal do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) - iGrain3 = homogenization_RGC_grain1to3(iGrain,instance) + iGrain3 = grain1to3(iGrain,instance) do iFace = 1_pInt,nFace - intFace = homogenization_RGC_getInterface(iFace,iGrain3) - aVect = homogenization_RGC_relaxationVector(intFace,instance, ip, el) - nVect = homogenization_RGC_interfaceNormal(intFace,ip,el) + intFace = getInterface(iFace,iGrain3) + aVect = relaxationVector(intFace,instance, ip, el) + nVect = interfaceNormal(intFace,ip,el) forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! effective relaxations enddo F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! relaxed deformation gradient enddo -end subroutine homogenization_RGC_grainDeformation +end subroutine grainDeformation end module homogenization_RGC From 6b45afa72f5b789eb55614212637fe8e5511bb6e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 30 Aug 2018 17:51:31 +0200 Subject: [PATCH 015/107] using parameters from config.f90 --- src/homogenization_RGC.f90 | 56 +++++++++++++------------------------- 1 file changed, 19 insertions(+), 37 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 524ae5790..cddd0524b 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -38,11 +38,7 @@ module homogenization_RGC integer(pInt), dimension(:,:), allocatable, private :: & homogenization_RGC_Ngrains real(pReal), dimension(:,:), allocatable, private :: & - homogenization_RGC_dAlpha, & homogenization_RGC_angles - real(pReal), dimension(:), allocatable, private :: & - homogenization_RGC_xiAlpha, & - homogenization_RGC_ciAlpha ! END DEPRECATED real(pReal), dimension(:,:,:,:), allocatable, private :: & @@ -155,10 +151,6 @@ subroutine homogenization_RGC_init(fileUnit) allocate(homogenization_RGC_Noutput(maxNinstance), source=0_pInt) allocate(homogenization_RGC_Ngrains(3,maxNinstance), source=0_pInt) - allocate(homogenization_RGC_ciAlpha(maxNinstance), source=0.0_pReal) - allocate(homogenization_RGC_xiAlpha(maxNinstance), source=0.0_pReal) - allocate(homogenization_RGC_dAlpha(3,maxNinstance), source=0.0_pReal) - allocate(homogenization_RGC_angles(3,maxNinstance), source=400.0_pReal) allocate(homogenization_RGC_output(maxval(homogenization_Noutput),maxNinstance)) homogenization_RGC_output='' allocate(homogenization_RGC_outputID(maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) @@ -261,18 +253,6 @@ subroutine homogenization_RGC_init(fileUnit) homogenization_RGC_Ngrains(3,i) = IO_intValue(line,chunkPos,4_pInt) if (homogenization_Ngrains(section) /= product(homogenization_RGC_Ngrains(1:3,i))) & call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_RGC_label//')') - case ('scalingparameter') - homogenization_RGC_xiAlpha(i) = IO_floatValue(line,chunkPos,2_pInt) - case ('overproportionality') - homogenization_RGC_ciAlpha(i) = IO_floatValue(line,chunkPos,2_pInt) - case ('grainsize') - homogenization_RGC_dAlpha(1,i) = IO_floatValue(line,chunkPos,2_pInt) - homogenization_RGC_dAlpha(2,i) = IO_floatValue(line,chunkPos,3_pInt) - homogenization_RGC_dAlpha(3,i) = IO_floatValue(line,chunkPos,4_pInt) - case ('clusterorientation') - homogenization_RGC_angles(1,i) = IO_floatValue(line,chunkPos,2_pInt) - homogenization_RGC_angles(2,i) = IO_floatValue(line,chunkPos,3_pInt) - homogenization_RGC_angles(3,i) = IO_floatValue(line,chunkPos,4_pInt) end select endif @@ -895,7 +875,6 @@ subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF, use mesh, only: mesh_element use material, only: & homogenization_maxNgrains, & - homogenization_Ngrains, & homogenization_typeInstance use math, only: math_Plain3333to99 @@ -1042,6 +1021,7 @@ subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) integer(pInt) :: iGrain,iGNghb,iFace,i,j,k,l real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb + type(tParameters) :: prm integer(pInt), parameter :: nFace = 6_pInt real(pReal), parameter :: nDefToler = 1.0e-10_pReal @@ -1054,6 +1034,7 @@ subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) ! the interfaces due to deformations surfCorr = surfaceCorrection(avgF,ip,el) + associate(prm => param(instance)) !-------------------------------------------------------------------------------------------------- ! debugging the surface correction factor if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & @@ -1120,9 +1101,9 @@ subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) ! compute the stress penalty of all interfaces do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt - rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*homogenization_RGC_xiAlpha(instance) & - *surfCorr(abs(intFace(1)))/homogenization_RGC_dAlpha(abs(intFace(1)),instance) & - *cosh(homogenization_RGC_ciAlpha(instance)*nDefNorm) & + rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xiAlpha & + *surfCorr(abs(intFace(1)))/prm%dAlpha(abs(intFace(1))) & + *cosh(prm%ciAlpha*nDefNorm) & *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_civita(k,l,j) & *tanh(nDefNorm/xSmoo_RGC) enddo; enddo @@ -1142,6 +1123,7 @@ subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) endif enddo + end associate end subroutine stressPenalty @@ -1338,7 +1320,7 @@ function interfaceNormal(intFace,ip,el) ! get the normal of the interface, identified from the value of intFace(1) interfaceNormal = 0.0_pReal nPos = abs(intFace(1)) ! identify the position of the interface in global state array - interfaceNormal(nPos) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis + interfaceNormal(nPos) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis interfaceNormal = & math_mul33x3(homogenization_RGC_orientation(1:3,1:3,ip,el),interfaceNormal) @@ -1383,9 +1365,9 @@ function grain1to3(grain1,instance) integer(pInt), dimension (3) :: nGDim nGDim = param(instance)%Nconstituents - grain1to3(3) = 1_pInt+(grain1-1_pInt)/(nGDim(1)*nGDim(2)) - grain1to3(2) = 1_pInt+mod((grain1-1_pInt)/nGDim(1),nGDim(2)) - grain1to3(1) = 1_pInt+mod((grain1-1_pInt),nGDim(1)) + grain1to3 = 1_pInt + [mod((grain1-1_pInt),nGDim(1)), & + mod((grain1-1_pInt)/nGDim(1),nGDim(2)), & + (grain1-1_pInt)/(nGDim(1)*nGDim(2))] end function grain1to3 @@ -1397,9 +1379,9 @@ pure function grain3to1(grain3,instance) implicit none integer(pInt), dimension (3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z) - integer(pInt), intent(in) :: instance ! homogenization ID - integer(pInt) :: grain3to1 - integer(pInt), dimension (3) :: nGDim + integer(pInt), intent(in) :: instance ! homogenization ID + integer(pInt) :: grain3to1 + integer(pInt), dimension (3) :: nGDim nGDim = param(instance)%Nconstituents grain3to1 = grain3(1) + nGDim(1)*(grain3(2)-1_pInt) + nGDim(1)*nGDim(2)*(grain3(3)-1_pInt) @@ -1414,8 +1396,8 @@ integer(pInt) pure function interface4to1(iFace4D, instance) implicit none integer(pInt), dimension (4), intent(in) :: iFace4D !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z) + integer(pInt), intent(in) :: instance integer(pInt), dimension (3) :: nGDim,nIntFace - integer(pInt), intent(in) :: instance nGDim = param(instance)%Nconstituents @@ -1452,10 +1434,10 @@ end function interface4to1 pure function interface1to4(iFace1D, instance) implicit none - integer(pInt), dimension (4) :: interface1to4 - integer(pInt), intent(in) :: iFace1D !< interface ID in 1D array - integer(pInt), dimension (3) :: nGDim,nIntFace - integer(pInt), intent(in) :: instance + integer(pInt), dimension (4) :: interface1to4 + integer(pInt), intent(in) :: iFace1D !< interface ID in 1D array + integer(pInt), intent(in) :: instance + integer(pInt), dimension (3) :: nGDim,nIntFace nGDim = param(instance)%Nconstituents @@ -1542,7 +1524,7 @@ subroutine grainDeformation(F, avgF, ip, el) ! compute the deformation gradient of individual grains due to relaxations instance = homogenization_typeInstance(mesh_element(3,el)) F = 0.0_pReal - do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) + do iGrain = 1_pInt,sum(param(instance)%Nconstituents) iGrain3 = grain1to3(iGrain,instance) do iFace = 1_pInt,nFace intFace = getInterface(iFace,iGrain3) From 91a3b4ed6927fc5eec642548cfaee316ac2b76b9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 31 Aug 2018 01:24:28 +0200 Subject: [PATCH 016/107] almost done --- src/homogenization_RGC.f90 | 175 ++++++++++++++----------------------- 1 file changed, 66 insertions(+), 109 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index cddd0524b..21b8ea096 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -23,27 +23,6 @@ module homogenization_RGC integer(pInt), dimension(:), allocatable,target, public :: & homogenization_RGC_Noutput !< number of outputs per homog instance - type, private :: tParameters !< container type for internal constitutive parameters - integer(pInt), dimension(:), allocatable :: & - Nconstituents - real(pReal) :: & - xiAlpha, & - ciAlpha - real(pReal), dimension(:), allocatable :: & - dAlpha, & - angles - end type - -! BEGIN DEPRECATED - integer(pInt), dimension(:,:), allocatable, private :: & - homogenization_RGC_Ngrains - real(pReal), dimension(:,:), allocatable, private :: & - homogenization_RGC_angles -! END DEPRECATED - - real(pReal), dimension(:,:,:,:), allocatable, private :: & - homogenization_RGC_orientation - enum, bind(c) enumerator :: undefined_ID, & constitutivework_ID, & @@ -56,7 +35,29 @@ module homogenization_RGC avgdefgrad_ID,& avgfirstpiola_ID end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + + type, private :: tParameters !< container type for internal constitutive parameters + integer(pInt), dimension(:), allocatable :: & + Nconstituents + real(pReal) :: & + xiAlpha, & + ciAlpha + real(pReal), dimension(:), allocatable :: & + dAlpha, & + angles + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID !< ID of each post result output + end type + +! BEGIN DEPRECATED + integer(pInt), dimension(:,:), allocatable, private :: & + homogenization_RGC_Ngrains +! END DEPRECATED + + real(pReal), dimension(:,:,:,:), allocatable, private :: & + homogenization_RGC_orientation + +integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & homogenization_RGC_outputID !< ID of each post result output type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) @@ -119,24 +120,25 @@ subroutine homogenization_RGC_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration - integer(pInt), allocatable, dimension(:) :: chunkPos integer :: & homog, & NofMyHomog, & o, h, & + outputSize, & instance, & sizeHState integer(pInt) :: section=0_pInt, maxNinstance, i,j,e, mySize - character(len=65536) :: & - tag = '', & - line = '' + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID !< ID of each post result output + character(len=65536), dimension(:), allocatable :: outputs type(tParameters) :: prm write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming, 2(1):939–942, 2009' - write(6,'(/,a)') ' https://doi.org/10.1007/s12289-009-0619-1' + write(6,'(a)') ' https://doi.org/10.1007/s12289-009-0619-1' write(6,'(/,a)') ' Tjahjanto et al., Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010' - write(6,'(/,a)') ' https://doi.org/10.1088/0965-0393/18/1/015006' + write(6,'(a)') ' https://doi.org/10.1088/0965-0393/18/1/015006' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -162,15 +164,50 @@ subroutine homogenization_RGC_init(fileUnit) if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle instance = homogenization_typeInstance(h) associate(prm => param(instance)) + prm%Nconstituents = config_homogenization(h)%getInts('clustersize',requiredShape=[3]) + homogenization_RGC_Ngrains(:,instance) = prm%Nconstituents if (homogenization_Ngrains(h) /= product(prm%Nconstituents)) & - call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_RGC_label//')') + call IO_error(211_pInt,ext_msg='clustersize ('//HOMOGENIZATION_RGC_label//')') prm%xiAlpha = config_homogenization(h)%getFloat('scalingparameter') prm%ciAlpha = config_homogenization(h)%getFloat('overproportionality') prm%dAlpha = config_homogenization(h)%getFloats('grainsize',requiredShape=[3]) prm%angles = config_homogenization(h)%getFloats('clusterorientation',requiredShape=[3],& defaultVal=[400.0_pReal,400.0_pReal,400.0_pReal]) + outputs = config_homogenization(h)%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + case('constitutivework') + outputID = constitutivework_ID + outputSize = 1_pInt + case('penaltyenergy') + outputID = penaltyenergy_ID + outputSize = 1_pInt + case('volumediscrepancy') + outputID = volumediscrepancy_ID + outputSize = 1_pInt + case('averagerelaxrate') + outputID = averagerelaxrate_ID + outputSize = 1_pInt + case('maximumrelaxrate') + outputID = maximumrelaxrate_ID + outputSize = 1_pInt + case('magnitudemismatch') + outputID = magnitudemismatch_ID + outputSize = 3_pInt + case default + if (outputID /= undefined_ID) then + homogenization_RGC_output(i,instance) = outputs(i) + homogenization_RGC_sizePostResult(i,instance) = outputSize + prm%outputID = [prm%outputID , outputID] + endif + end select + enddo + !-------------------------------------------------------------------------------------------------- ! * assigning cluster orientations elementLooping: do e = 1_pInt,mesh_NcpElems @@ -199,93 +236,15 @@ subroutine homogenization_RGC_init(fileUnit) write(6,'(a25,3(1x,e10.3))') 'cluster orientation: ',(prm%angles(j),j=1_pInt,3_pInt) endif - homogenization_RGC_Ngrains(:,instance) = prm%nConstituents end associate enddo - rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>'))/=material_partHomogenization) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homogenization 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 - cycle - endif - if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if-statement). It's not safe in Fortran - if (homogenization_type(section) == HOMOGENIZATION_RGC_ID) then ! one of my sections - i = homogenization_typeInstance(section) ! which instance of my type is present homogenization - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt - homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case('constitutivework') - homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = constitutivework_ID - case('penaltyenergy') - homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = penaltyenergy_ID - case('volumediscrepancy') - homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = volumediscrepancy_ID - case('averagerelaxrate') - homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = averagerelaxrate_ID - case('maximumrelaxrate') - homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = maximumrelaxrate_ID - case('magnitudemismatch') - homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = magnitudemismatch_ID - - case default - homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) -1_pInt ! correct for invalid - - end select - case ('clustersize') - homogenization_RGC_Ngrains(1,i) = IO_intValue(line,chunkPos,2_pInt) - homogenization_RGC_Ngrains(2,i) = IO_intValue(line,chunkPos,3_pInt) - homogenization_RGC_Ngrains(3,i) = IO_intValue(line,chunkPos,4_pInt) - if (homogenization_Ngrains(section) /= product(homogenization_RGC_Ngrains(1:3,i))) & - call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_RGC_label//')') - - end select - endif - endif - enddo parsingFile - !-------------------------------------------------------------------------------------------------- initializeInstances: do homog = 1_pInt, material_Nhomogenization myHomog: if (homogenization_type(homog) == HOMOGENIZATION_RGC_ID) then NofMyHomog = count(material_homog == homog) instance = homogenization_typeInstance(homog) -! * Determine size of postResults array - outputsLoop: do o = 1_pInt, homogenization_RGC_Noutput(instance) - select case(homogenization_RGC_outputID(o,instance)) - case(constitutivework_ID,penaltyenergy_ID,volumediscrepancy_ID, & - averagerelaxrate_ID,maximumrelaxrate_ID) - mySize = 1_pInt - case(ipcoords_ID,magnitudemismatch_ID) - mySize = 3_pInt - case(avgdefgrad_ID,avgfirstpiola_ID) - mySize = 9_pInt - case default - mySize = 0_pInt - end select - - outputFound: if (mySize > 0_pInt) then - homogenization_RGC_sizePostResult(o,instance) = mySize - homogenization_RGC_sizePostResults(instance) = & - homogenization_RGC_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop - sizeHState = & 3_pInt*(homogenization_RGC_Ngrains(1,instance)-1_pInt)* & homogenization_RGC_Ngrains(2,instance)*homogenization_RGC_Ngrains(3,instance) & @@ -306,8 +265,6 @@ subroutine homogenization_RGC_init(fileUnit) endif myHomog enddo initializeInstances - - end subroutine homogenization_RGC_init From 26d18257d2a7e457ca409b4de34fe324010922ee Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 31 Aug 2018 06:35:30 +0200 Subject: [PATCH 017/107] requested output is stored in prm%outputID --- src/homogenization_RGC.f90 | 61 +++++++++++++------------------------- 1 file changed, 21 insertions(+), 40 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 21b8ea096..caf6c88a8 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -14,7 +14,6 @@ module homogenization_RGC implicit none private integer(pInt), dimension(:), allocatable, public :: & - homogenization_RGC_sizeState, & homogenization_RGC_sizePostResults integer(pInt), dimension(:,:), allocatable,target, public :: & homogenization_RGC_sizePostResult @@ -49,16 +48,12 @@ module homogenization_RGC outputID !< ID of each post result output end type -! BEGIN DEPRECATED +! START: Could be improved integer(pInt), dimension(:,:), allocatable, private :: & homogenization_RGC_Ngrains -! END DEPRECATED - real(pReal), dimension(:,:,:,:), allocatable, private :: & homogenization_RGC_orientation - -integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - homogenization_RGC_outputID !< ID of each post result output +! END: Could be improved type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) @@ -121,7 +116,6 @@ subroutine homogenization_RGC_init(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration integer :: & - homog, & NofMyHomog, & o, h, & outputSize, & @@ -146,18 +140,16 @@ subroutine homogenization_RGC_init(fileUnit) if (maxNinstance == 0_pInt) return if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(homogenization_RGC_sizeState(maxNinstance), source=0_pInt) allocate(homogenization_RGC_sizePostResults(maxNinstance), source=0_pInt) allocate(param(maxNinstance)) ! one container of parameters per instance allocate(homogenization_RGC_Noutput(maxNinstance), source=0_pInt) - allocate(homogenization_RGC_Ngrains(3,maxNinstance), source=0_pInt) allocate(homogenization_RGC_output(maxval(homogenization_Noutput),maxNinstance)) homogenization_RGC_output='' - allocate(homogenization_RGC_outputID(maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),maxNinstance),& source=0_pInt) + allocate(homogenization_RGC_Ngrains(3,maxNinstance), source=0_pInt) allocate(homogenization_RGC_orientation(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) do h = 1_pInt, size(homogenization_type) @@ -236,34 +228,23 @@ subroutine homogenization_RGC_init(fileUnit) write(6,'(a25,3(1x,e10.3))') 'cluster orientation: ',(prm%angles(j),j=1_pInt,3_pInt) endif + NofMyHomog = count(material_homog == h) + + sizeHState = & + 3_pInt*(prm%Nconstituents(1)-1_pInt)*prm%Nconstituents(2)*prm%Nconstituents(3) & + + 3_pInt*prm%Nconstituents(1)*(prm%Nconstituents(2)-1_pInt)* prm%Nconstituents(3) & + + 3_pInt*prm%Nconstituents(1)*prm%Nconstituents(2)*(prm%Nconstituents(3)-1_pInt) & + + 8_pInt ! (1) Average constitutive work, (2-4) Overall mismatch, (5) Average penalty energy, + ! (6) Volume discrepancy, (7) Avg relaxation rate component, (8) Max relaxation rate component + + homogState(h)%sizeState = sizeHState + homogState(h)%sizePostResults = homogenization_RGC_sizePostResults(instance) + allocate(homogState(h)%state0 (sizeHState,NofMyHomog), source=0.0_pReal) + allocate(homogState(h)%subState0(sizeHState,NofMyHomog), source=0.0_pReal) + allocate(homogState(h)%state (sizeHState,NofMyHomog), source=0.0_pReal) + end associate enddo - -!-------------------------------------------------------------------------------------------------- - initializeInstances: do homog = 1_pInt, material_Nhomogenization - myHomog: if (homogenization_type(homog) == HOMOGENIZATION_RGC_ID) then - NofMyHomog = count(material_homog == homog) - instance = homogenization_typeInstance(homog) - - sizeHState = & - 3_pInt*(homogenization_RGC_Ngrains(1,instance)-1_pInt)* & - homogenization_RGC_Ngrains(2,instance)*homogenization_RGC_Ngrains(3,instance) & - + 3_pInt*homogenization_RGC_Ngrains(1,instance)*(homogenization_RGC_Ngrains(2,instance)-1_pInt)* & - homogenization_RGC_Ngrains(3,instance) & - + 3_pInt*homogenization_RGC_Ngrains(1,instance)*homogenization_RGC_Ngrains(2,instance)* & - (homogenization_RGC_Ngrains(3,instance)-1_pInt) & - + 8_pInt ! (1) Average constitutive work, (2-4) Overall mismatch, (5) Average penalty energy, - ! (6) Volume discrepancy, (7) Avg relaxation rate component, (8) Max relaxation rate component - -! allocate state arrays - homogState(homog)%sizeState = sizeHState - homogState(homog)%sizePostResults = homogenization_RGC_sizePostResults(instance) - allocate(homogState(homog)%state0 (sizeHState,NofMyHomog), source=0.0_pReal) - allocate(homogState(homog)%subState0(sizeHState,NofMyHomog), source=0.0_pReal) - allocate(homogState(homog)%state (sizeHState,NofMyHomog), source=0.0_pReal) - - endif myHomog - enddo initializeInstances end subroutine homogenization_RGC_init @@ -906,8 +887,8 @@ pure function homogenization_RGC_postResults(ip,el,avgP,avgF) result(postResults c = 0_pInt postResults = 0.0_pReal - do o = 1_pInt,homogenization_Noutput(mesh_element(3,el)) - select case(homogenization_RGC_outputID(o,instance)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) case (constitutivework_ID) postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & state(3*nIntFaceTot+1,mappingHomogenization(1,ip,el)) @@ -937,7 +918,7 @@ pure function homogenization_RGC_postResults(ip,el,avgP,avgF) result(postResults state(3*nIntFaceTot+8,mappingHomogenization(1,ip,el)) c = c + 1_pInt end select - enddo + enddo outputsLoop end associate end function homogenization_RGC_postResults From 17c21dfc92e6c777a75cfb5ca6c34773bf5ccd78 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 13 Oct 2018 18:21:13 +0200 Subject: [PATCH 018/107] mesh_element should not be used anymore --- src/homogenization.f90 | 6 +-- src/homogenization_RGC.f90 | 102 +++++++++++++++++-------------------- 2 files changed, 49 insertions(+), 59 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index eec8d2fba..538a8a19e 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -1163,11 +1163,7 @@ function homogenization_postResults(ip,el) case (HOMOGENIZATION_RGC_ID) chosenHomogenization homogenization_postResults(startPos:endPos) = & - homogenization_RGC_postResults(& - ip, & - el, & - materialpoint_P(1:3,1:3,ip,el), & - materialpoint_F(1:3,1:3,ip,el)) + homogenization_RGC_postResults(ip,el) end select chosenHomogenization startPos = endPos + 1_pInt diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index caf6c88a8..edba1687b 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -20,7 +20,7 @@ module homogenization_RGC character(len=64), dimension(:,:), allocatable,target, public :: & homogenization_RGC_output ! name of each post result output integer(pInt), dimension(:), allocatable,target, public :: & - homogenization_RGC_Noutput !< number of outputs per homog instance + homogenization_RGC_Noutput !< number of outputs per homog instance enum, bind(c) enumerator :: undefined_ID, & @@ -48,9 +48,17 @@ module homogenization_RGC outputID !< ID of each post result output end type + type, private :: tRGCState + real(pReal), pointer, dimension(:,:) :: & + work, & + mismatch, & + penaltyEnergy, & + volumeDiscrepancy, & + relaxationRate_avg, & + relaxationRage_max + end type + ! START: Could be improved - integer(pInt), dimension(:,:), allocatable, private :: & - homogenization_RGC_Ngrains real(pReal), dimension(:,:,:,:), allocatable, private :: & homogenization_RGC_orientation ! END: Could be improved @@ -104,11 +112,10 @@ subroutine homogenization_RGC_init(fileUnit) math_EulerToR,& INRAD use mesh, only: & - mesh_maxNips, & - mesh_NcpElems,& - mesh_element, & - FE_Nips, & - FE_geomtype + mesh_NcpElems,& + mesh_NipsPerElem, & + mesh_homogenizationAt, & + mesh_microstructureAt use IO use material use config @@ -149,8 +156,7 @@ subroutine homogenization_RGC_init(fileUnit) homogenization_RGC_output='' allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),maxNinstance),& source=0_pInt) - allocate(homogenization_RGC_Ngrains(3,maxNinstance), source=0_pInt) - allocate(homogenization_RGC_orientation(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(homogenization_RGC_orientation(3,3,mesh_NipsPerElem,mesh_NcpElems), source=0.0_pReal) do h = 1_pInt, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle @@ -158,7 +164,6 @@ subroutine homogenization_RGC_init(fileUnit) associate(prm => param(instance)) prm%Nconstituents = config_homogenization(h)%getInts('clustersize',requiredShape=[3]) - homogenization_RGC_Ngrains(:,instance) = prm%Nconstituents if (homogenization_Ngrains(h) /= product(prm%Nconstituents)) & call IO_error(211_pInt,ext_msg='clustersize ('//HOMOGENIZATION_RGC_label//')') prm%xiAlpha = config_homogenization(h)%getFloat('scalingparameter') @@ -203,16 +208,16 @@ subroutine homogenization_RGC_init(fileUnit) !-------------------------------------------------------------------------------------------------- ! * assigning cluster orientations elementLooping: do e = 1_pInt,mesh_NcpElems - if (homogenization_typeInstance(mesh_element(3,e)) == instance) then + if (homogenization_typeInstance(mesh_homogenizationAt(e)) == instance) then noOrientationGiven: if (all (prm%angles >= 399.9_pReal)) then homogenization_RGC_orientation(1:3,1:3,1,e) = math_EulerToR(math_sampleRandomOri()) - do i = 2_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + do i = 2_pInt,mesh_NipsPerElem homogenization_RGC_orientation(1:3,1:3,i,e) = merge(homogenization_RGC_orientation(1:3,1:3,1,e), & math_EulerToR(math_sampleRandomOri()), & - microstructure_elemhomo(mesh_element(4,e))) + microstructure_elemhomo(mesh_microstructureAt(e))) enddo else noOrientationGiven - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + do i = 1_pInt,mesh_NipsPerElem homogenization_RGC_orientation(1:3,1:3,i,e) = math_EulerToR(prm%angles*inRad) enddo endif noOrientationGiven @@ -258,7 +263,7 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,ip,el) debug_homogenization, & debug_levelExtensive use mesh, only: & - mesh_element + mesh_homogenizationAt use material, only: & homogenization_maxNgrains, & homogenization_Ngrains,& @@ -278,18 +283,16 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,ip,el) !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations - instance = homogenization_typeInstance(mesh_element(3,el)) + instance = homogenization_typeInstance(mesh_homogenizationAt(el)) F = 0.0_pReal - do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) + do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) iGrain3 = grain1to3(iGrain,instance) do iFace = 1_pInt,nFace intFace = getInterface(iFace,iGrain3) ! identifying 6 interfaces of each grain - aVect = relaxationVector(intFace,instance, ip, el) ! get the relaxation vectors for each interface from global relaxation vector array - nVect = interfaceNormal(intFace,ip,el) ! get the normal of each interface forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & - F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! calculating deformation relaxations due to interface relaxation + F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! calculating deformation relaxations due to interface relaxation enddo F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient @@ -327,7 +330,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) use math, only: & math_invert use mesh, only: & - mesh_element + mesh_homogenizationAt use material, only: & homogenization_maxNgrains, & homogenization_typeInstance, & @@ -380,9 +383,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! get the dimension of the cluster (grains and interfaces) - instance = homogenization_typeInstance(mesh_element(3,el)) + instance = homogenization_typeInstance(mesh_homogenizationAt(el)) nGDim = param(instance)%Nconstituents - nGrain = homogenization_Ngrains(mesh_element(3,el)) + nGrain = homogenization_Ngrains(mesh_homogenizationAt(el)) nIntFaceTot = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) & + nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) @@ -426,8 +429,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) write(6,'(/,1x,a30,1x,i3)')'Stress and penalties of grain: ',iGrain do i = 1_pInt,3_pInt write(6,'(1x,3(e15.8,1x),1x,3(e15.8,1x),1x,3(e15.8,1x))')(P(i,j,iGrain), j = 1_pInt,3_pInt), & - (R(i,j,iGrain), j = 1_pInt,3_pInt), & - (D(i,j,iGrain), j = 1_pInt,3_pInt) + (R(i,j,iGrain), j = 1_pInt,3_pInt), & + (D(i,j,iGrain), j = 1_pInt,3_pInt) enddo write(6,*)' ' enddo @@ -518,7 +521,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! compute/update the state for postResult, i.e., all energy densities computed by time-integration constitutiveWork = homogState(mappingHomogenization(2,ip,el))%state(3*nIntFaceTot+1,mappingHomogenization(1,ip,el)) penaltyEnergy = homogState(mappingHomogenization(2,ip,el))%state(3*nIntFaceTot+5,mappingHomogenization(1,ip,el)) - do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) ! time-integration loop for the calculating the work and energy + do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) ! time-integration loop for the calculating the work and energy do i = 1_pInt,3_pInt do j = 1_pInt,3_pInt constitutiveWork = constitutiveWork + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) @@ -559,7 +562,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !$OMP END CRITICAL (write2out) endif - deallocate(tract,resid,relax,drelax) return !-------------------------------------------------------------------------------------------------- @@ -575,7 +577,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !$OMP END CRITICAL (write2out) endif - deallocate(tract,resid,relax,drelax) return else ! proceed with computing the Jacobian and state update if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & @@ -796,8 +797,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) flush(6) !$OMP END CRITICAL (write2out) endif - - deallocate(tract,resid,jmatrix,jnverse,relax,drelax,pmatrix,smatrix,p_relax,p_resid) end function homogenization_RGC_updateState @@ -810,7 +809,8 @@ subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF, debug_level, & debug_homogenization,& debug_levelExtensive - use mesh, only: mesh_element + use mesh, only: & + mesh_homogenizationAt use material, only: & homogenization_maxNgrains, & homogenization_typeInstance @@ -826,7 +826,7 @@ subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF, integer(pInt) :: instance, i, j, Nconstituents, iGrain - instance = homogenization_typeInstance(mesh_element(3,el)) + instance = homogenization_typeInstance(mesh_homogenizationAt(el)) Nconstituents = sum(param(instance)%Nconstituents) !-------------------------------------------------------------------------------------------------- @@ -856,10 +856,9 @@ end subroutine homogenization_RGC_averageStressAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief return array of homogenization results for post file inclusion !-------------------------------------------------------------------------------------------------- -pure function homogenization_RGC_postResults(ip,el,avgP,avgF) result(postResults) +pure function homogenization_RGC_postResults(ip,el) result(postResults) use mesh, only: & - mesh_element, & - mesh_ipCoordinates + mesh_homogenizationAt use material, only: & homogenization_typeInstance,& homogState, & @@ -870,16 +869,13 @@ pure function homogenization_RGC_postResults(ip,el,avgP,avgF) result(postResults integer(pInt), intent(in) :: & ip, & !< integration point number el !< element number - real(pReal), dimension(3,3), intent(in) :: & - avgP, & !< average stress at material point - avgF !< average deformation gradient at material point integer(pInt) instance,o,c,nIntFaceTot type(tParameters) :: prm - real(pReal), dimension(homogenization_RGC_sizePostResults(homogenization_typeInstance(mesh_element(3,el)))) :: & + real(pReal), dimension(homogenization_RGC_sizePostResults(homogenization_typeInstance(mesh_homogenizationAt(el)))) :: & postResults - instance = homogenization_typeInstance(mesh_element(3,el)) + instance = homogenization_typeInstance(mesh_homogenizationAt(el)) associate(prm => param(instance)) nIntFaceTot=(prm%Nconstituents(1)-1_pInt)*prm%Nconstituents(2)* prm%Nconstituents(3)& + prm%Nconstituents(1)* (prm%Nconstituents(2)-1_pInt)*prm%Nconstituents(3)& @@ -934,7 +930,7 @@ subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) debug_e, & debug_i use mesh, only: & - mesh_element + mesh_homogenizationAt use constitutive, only: & constitutive_homogenizedC use math, only: & @@ -985,7 +981,7 @@ subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) !-------------------------------------------------------------------------------------------------- ! computing the mismatch and penalty stress tensor of all grains - do iGrain = 1_pInt,homogenization_Ngrains(mesh_element(3,el)) + do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) Gmoduli = equivalentModuli(iGrain,ip,el) muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector @@ -1077,7 +1073,7 @@ subroutine volumePenalty(vPen,vDiscrep,fDef,fAvg,ip,el) debug_e, & debug_i use mesh, only: & - mesh_element + mesh_homogenizationAt use math, only: & math_det33, & math_inv33 @@ -1099,7 +1095,7 @@ subroutine volumePenalty(vPen,vDiscrep,fDef,fAvg,ip,el) real(pReal), dimension (homogenization_maxNgrains) :: gVol integer(pInt) :: iGrain,nGrain,i,j - nGrain = homogenization_Ngrains(mesh_element(3,el)) + nGrain = homogenization_Ngrains(mesh_homogenizationAt(el)) !-------------------------------------------------------------------------------------------------- ! compute the volumes of grains and of cluster @@ -1228,7 +1224,7 @@ function relaxationVector(intFace,instance, ip, el) !-------------------------------------------------------------------------------------------------- ! collect the interface relaxation vector from the global state array relaxationVector = 0.0_pReal - nGDim = homogenization_RGC_Ngrains(1:3,instance) + nGDim = param(instance)%Nconstituents iNum = interface4to1(intFace,instance) ! identify the position of the interface in global state array if (iNum > 0_pInt) relaxationVector = homogState(mappingHomogenization(2,ip,el))% & state((3*iNum-2):(3*iNum),mappingHomogenization(1,ip,el)) ! get the corresponding entries @@ -1351,15 +1347,15 @@ integer(pInt) pure function interface4to1(iFace4D, instance) ! get the corresponding interface ID in 1D global array if (abs(iFace4D(1)) == 1_pInt) then ! interface with normal //e1 interface4to1 = iFace4D(3) + nGDim(2)*(iFace4D(4)-1_pInt) & - + nGDim(2)*nGDim(3)*(iFace4D(2)-1_pInt) + + nGDim(2)*nGDim(3)*(iFace4D(2)-1_pInt) if ((iFace4D(2) == 0_pInt) .or. (iFace4D(2) == nGDim(1))) interface4to1 = 0_pInt elseif (abs(iFace4D(1)) == 2_pInt) then ! interface with normal //e2 interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1_pInt) & - + nGDim(3)*nGDim(1)*(iFace4D(3)-1_pInt) + nIntFace(1) + + nGDim(3)*nGDim(1)*(iFace4D(3)-1_pInt) + nIntFace(1) if ((iFace4D(3) == 0_pInt) .or. (iFace4D(3) == nGDim(2))) interface4to1 = 0_pInt elseif (abs(iFace4D(1)) == 3_pInt) then ! interface with normal //e3 interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1_pInt) & - + nGDim(1)*nGDim(2)*(iFace4D(4)-1_pInt) + nIntFace(1) + nIntFace(2) + + nGDim(1)*nGDim(2)*(iFace4D(4)-1_pInt) + nIntFace(1) + nIntFace(2) if ((iFace4D(4) == 0_pInt) .or. (iFace4D(4) == nGDim(3))) interface4to1 = 0_pInt endif @@ -1440,10 +1436,9 @@ end function interface1to4 !-------------------------------------------------------------------------------------------------- subroutine grainDeformation(F, avgF, ip, el) use mesh, only: & - mesh_element + mesh_homogenizationAt use material, only: & homogenization_maxNgrains,& - homogenization_Ngrains, & homogenization_typeInstance implicit none @@ -1456,15 +1451,14 @@ subroutine grainDeformation(F, avgF, ip, el) integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3 integer(pInt) :: instance, iGrain,iFace,i,j - integer(pInt), parameter :: nFace = 6_pInt !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations - instance = homogenization_typeInstance(mesh_element(3,el)) + instance = homogenization_typeInstance(mesh_homogenizationAt(el)) F = 0.0_pReal do iGrain = 1_pInt,sum(param(instance)%Nconstituents) iGrain3 = grain1to3(iGrain,instance) - do iFace = 1_pInt,nFace + do iFace = 1_pInt,6_pInt intFace = getInterface(iFace,iGrain3) aVect = relaxationVector(intFace,instance, ip, el) nVect = interfaceNormal(intFace,ip,el) From a678e9b94f25d5081aa1df10effaea581826e6a7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 15:13:11 +0100 Subject: [PATCH 019/107] bugfixes flaws introduced in 42-xx branch and detected by new test - outputsize was wrong - nconstituents is product along the 3 directions, not the sum --- src/homogenization_RGC.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index edba1687b..5c9937e4c 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -197,14 +197,13 @@ subroutine homogenization_RGC_init(fileUnit) outputID = magnitudemismatch_ID outputSize = 3_pInt case default - if (outputID /= undefined_ID) then - homogenization_RGC_output(i,instance) = outputs(i) - homogenization_RGC_sizePostResult(i,instance) = outputSize - prm%outputID = [prm%outputID , outputID] - endif end select + if (outputID /= undefined_ID) then + homogenization_RGC_output(i,instance) = outputs(i) + homogenization_RGC_sizePostResult(i,instance) = outputSize + prm%outputID = [prm%outputID , outputID] + endif enddo - !-------------------------------------------------------------------------------------------------- ! * assigning cluster orientations elementLooping: do e = 1_pInt,mesh_NcpElems @@ -243,6 +242,7 @@ subroutine homogenization_RGC_init(fileUnit) ! (6) Volume discrepancy, (7) Avg relaxation rate component, (8) Max relaxation rate component homogState(h)%sizeState = sizeHState + homogenization_RGC_sizePostResults(instance) = sum(homogenization_RGC_sizePostResult(:,instance)) homogState(h)%sizePostResults = homogenization_RGC_sizePostResults(instance) allocate(homogState(h)%state0 (sizeHState,NofMyHomog), source=0.0_pReal) allocate(homogState(h)%subState0(sizeHState,NofMyHomog), source=0.0_pReal) @@ -1456,7 +1456,7 @@ subroutine grainDeformation(F, avgF, ip, el) ! compute the deformation gradient of individual grains due to relaxations instance = homogenization_typeInstance(mesh_homogenizationAt(el)) F = 0.0_pReal - do iGrain = 1_pInt,sum(param(instance)%Nconstituents) + do iGrain = 1_pInt,product(param(instance)%Nconstituents) iGrain3 = grain1to3(iGrain,instance) do iFace = 1_pInt,6_pInt intFace = getInterface(iFace,iGrain3) From a0c3a65b395955b84e06fe3d9c1f117313aa43b9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 15:41:54 +0100 Subject: [PATCH 020/107] Noutput not needed anymore --- src/homogenization.f90 | 5 +---- src/homogenization_RGC.f90 | 1 + 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 538a8a19e..1d07944b8 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -193,17 +193,14 @@ subroutine homogenization_init select case(homogenization_type(p)) ! split per homogenization type case (HOMOGENIZATION_NONE_ID) outputName = HOMOGENIZATION_NONE_label - thisNoutput => null() thisOutput => null() thisSize => null() case (HOMOGENIZATION_ISOSTRAIN_ID) outputName = HOMOGENIZATION_ISOSTRAIN_label - thisNoutput => null() thisOutput => null() thisSize => null() case (HOMOGENIZATION_RGC_ID) outputName = HOMOGENIZATION_RGC_label - thisNoutput => homogenization_RGC_Noutput thisOutput => homogenization_RGC_output thisSize => homogenization_RGC_sizePostResult case default @@ -215,7 +212,7 @@ subroutine homogenization_init write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID .and. & homogenization_type(p) /= HOMOGENIZATION_ISOSTRAIN_ID) then - do e = 1,thisNoutput(i) + do e = 1,size(thisOutput(:,i)) write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) enddo endif diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 5c9937e4c..c5c680e2c 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -200,6 +200,7 @@ subroutine homogenization_RGC_init(fileUnit) end select if (outputID /= undefined_ID) then homogenization_RGC_output(i,instance) = outputs(i) + print*, homogenization_RGC_output(i,instance) homogenization_RGC_sizePostResult(i,instance) = outputSize prm%outputID = [prm%outputID , outputID] endif From 08c692bfc1cdd73d6cefc40eae45540fd78b6b82 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 16:40:17 +0100 Subject: [PATCH 021/107] passing in instance simplifies things a lot --- src/homogenization.f90 | 14 ++++++++++++-- src/homogenization_isostrain.f90 | 25 +++++++------------------ 2 files changed, 19 insertions(+), 20 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 1d07944b8..f8b6dce89 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -913,6 +913,7 @@ subroutine homogenization_partitionDeformation(ip,el) use material, only: & homogenization_type, & homogenization_maxNgrains, & + homogenization_typeInstance, & HOMOGENIZATION_NONE_ID, & HOMOGENIZATION_ISOSTRAIN_ID, & HOMOGENIZATION_RGC_ID @@ -927,6 +928,8 @@ subroutine homogenization_partitionDeformation(ip,el) integer(pInt), intent(in) :: & ip, & !< integration point el !< element number + integer(pInt) :: & + instance chosenHomogenization: select case(homogenization_type(mesh_element(3,el))) @@ -936,10 +939,12 @@ subroutine homogenization_partitionDeformation(ip,el) spread(materialpoint_subF(1:3,1:3,ip,el),3,1) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization + instance = homogenization_typeInstance(mesh_element(3,el)) call homogenization_isostrain_partitionDeformation(& crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), & materialpoint_subF(1:3,1:3,ip,el),& - el) + instance) + case (HOMOGENIZATION_RGC_ID) chosenHomogenization call homogenization_RGC_partitionDeformation(& crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), & @@ -1041,6 +1046,7 @@ subroutine homogenization_averageStressAndItsTangent(ip,el) mesh_element use material, only: & homogenization_type, & + homogenization_typeInstance, & homogenization_maxNgrains, & HOMOGENIZATION_NONE_ID, & HOMOGENIZATION_ISOSTRAIN_ID, & @@ -1056,6 +1062,8 @@ subroutine homogenization_averageStressAndItsTangent(ip,el) integer(pInt), intent(in) :: & ip, & !< integration point el !< element number + integer(pInt) :: & + instance chosenHomogenization: select case(homogenization_type(mesh_element(3,el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization @@ -1064,12 +1072,14 @@ subroutine homogenization_averageStressAndItsTangent(ip,el) = sum(crystallite_dPdF(1:3,1:3,1:3,1:3,1:1,ip,el),5) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization + instance = homogenization_typeInstance(mesh_element(3,el)) call homogenization_isostrain_averageStressAndItsTangent(& materialpoint_P(1:3,1:3,ip,el), & materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),& crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), & crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), & - el) + instance) + case (HOMOGENIZATION_RGC_ID) chosenHomogenization call homogenization_RGC_averageStressAndItsTangent(& materialpoint_P(1:3,1:3,ip,el), & diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index 3ac64e6da..cdff607bf 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -1,4 +1,5 @@ !-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @brief Isostrain (full constraint Taylor assuption) homogenization scheme @@ -117,25 +118,19 @@ end subroutine homogenization_isostrain_init !-------------------------------------------------------------------------------------------------- !> @brief partitions the deformation gradient onto the constituents !-------------------------------------------------------------------------------------------------- -subroutine homogenization_isostrain_partitionDeformation(F,avgF,el) +subroutine homogenization_isostrain_partitionDeformation(F,avgF,instance) use prec, only: & pReal - use mesh, only: & - mesh_element use material, only: & - homogenization_maxNgrains, & - homogenization_typeInstance + homogenization_maxNgrains implicit none real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned def grad per grain real(pReal), dimension (3,3), intent(in) :: avgF !< my average def grad + integer(pInt), intent(in) :: instance type(tParameters) :: & prm - integer(pInt) :: & - el, & - instance - instance = homogenization_typeInstance(mesh_element(3,el)) associate(prm => param(instance)) F(1:3,1:3,1:prm%Nconstituents) = spread(avgF,3,prm%Nconstituents) if (homogenization_maxNgrains > prm%Nconstituents) & @@ -148,27 +143,21 @@ end subroutine homogenization_isostrain_partitionDeformation !-------------------------------------------------------------------------------------------------- !> @brief derive average stress and stiffness from constituent quantities !-------------------------------------------------------------------------------------------------- -subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,el) +subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) use prec, only: & pReal - use mesh, only: & - mesh_element use material, only: & - homogenization_maxNgrains, & - homogenization_typeInstance + homogenization_maxNgrains implicit none real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: P !< array of current grain stresses real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< array of current grain stiffnesses + integer(pInt), intent(in) :: instance type(tParameters) :: & prm - integer(pInt) :: & - el, & - instance - instance = homogenization_typeInstance(mesh_element(3,el)) associate(prm => param(instance)) select case (prm%mapping) case (parallel_ID) From fdbc20b7390eee43b37e8df4ed3347c9368c322c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 16:50:43 +0100 Subject: [PATCH 022/107] cleaned and unified --- src/homogenization.f90 | 6 ++-- src/homogenization_RGC.f90 | 56 ++++++++++++++------------------ src/homogenization_isostrain.f90 | 14 ++++---- 3 files changed, 34 insertions(+), 42 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index f8b6dce89..e664db0cc 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -129,11 +129,11 @@ subroutine homogenization_init !-------------------------------------------------------------------------------------------------- ! parse homogenization from config file if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) & - call homogenization_none_init() + call homogenization_none_init if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) & - call homogenization_isostrain_init() + call homogenization_isostrain_init if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) & - call homogenization_RGC_init(FILEUNIT) + call homogenization_RGC_init !-------------------------------------------------------------------------------------------------- ! parse thermal from config file diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index c5c680e2c..d520d092a 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -49,21 +49,23 @@ module homogenization_RGC end type type, private :: tRGCState - real(pReal), pointer, dimension(:,:) :: & + real(pReal), pointer, dimension(:) :: & work, & - mismatch, & penaltyEnergy, & volumeDiscrepancy, & relaxationRate_avg, & relaxationRage_max - end type + real(pReal), pointer, dimension(:,:) :: & + mismatch + end type tRGCState ! START: Could be improved real(pReal), dimension(:,:,:,:), allocatable, private :: & homogenization_RGC_orientation ! END: Could be improved - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable, private :: param !< containers of parameters (len Ninstance) + type(tRGCState), dimension(:), allocatable, private :: state public :: & homogenization_RGC_init, & @@ -90,7 +92,7 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -subroutine homogenization_RGC_init(fileUnit) +subroutine homogenization_RGC_init() #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -121,13 +123,12 @@ subroutine homogenization_RGC_init(fileUnit) use config implicit none - integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration - integer :: & + integer(pInt) :: & NofMyHomog, & o, h, & outputSize, & instance, & - sizeHState + sizeHState, nIntFaceTot integer(pInt) :: section=0_pInt, maxNinstance, i,j,e, mySize character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & @@ -150,6 +151,7 @@ subroutine homogenization_RGC_init(fileUnit) allocate(homogenization_RGC_sizePostResults(maxNinstance), source=0_pInt) allocate(param(maxNinstance)) ! one container of parameters per instance + allocate(state(maxNinstance)) ! one container per instance allocate(homogenization_RGC_Noutput(maxNinstance), source=0_pInt) allocate(homogenization_RGC_output(maxval(homogenization_Noutput),maxNinstance)) @@ -200,7 +202,6 @@ subroutine homogenization_RGC_init(fileUnit) end select if (outputID /= undefined_ID) then homogenization_RGC_output(i,instance) = outputs(i) - print*, homogenization_RGC_output(i,instance) homogenization_RGC_sizePostResult(i,instance) = outputSize prm%outputID = [prm%outputID , outputID] endif @@ -234,11 +235,10 @@ subroutine homogenization_RGC_init(fileUnit) endif NofMyHomog = count(material_homog == h) - - sizeHState = & - 3_pInt*(prm%Nconstituents(1)-1_pInt)*prm%Nconstituents(2)*prm%Nconstituents(3) & - + 3_pInt*prm%Nconstituents(1)*(prm%Nconstituents(2)-1_pInt)* prm%Nconstituents(3) & - + 3_pInt*prm%Nconstituents(1)*prm%Nconstituents(2)*(prm%Nconstituents(3)-1_pInt) & + nIntFaceTot = 3_pInt*( (prm%Nconstituents(1)-1_pInt)*prm%Nconstituents(2)*prm%Nconstituents(3) & + + prm%Nconstituents(1)*(prm%Nconstituents(2)-1_pInt)*prm%Nconstituents(3) & + + prm%Nconstituents(1)*prm%Nconstituents(2)*(prm%Nconstituents(3)-1_pInt)) + sizeHState = nIntFaceTot & + 8_pInt ! (1) Average constitutive work, (2-4) Overall mismatch, (5) Average penalty energy, ! (6) Volume discrepancy, (7) Avg relaxation rate component, (8) Max relaxation rate component @@ -361,6 +361,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) integer(pInt), intent(in) :: & ip, & !< integration point number el !< element number + logical, dimension(2) :: homogenization_RGC_updateState integer(pInt), dimension (4) :: intFaceN,intFaceP,faceID integer(pInt), dimension (3) :: nGDim,iGr3N,iGr3P,stresLoc @@ -394,12 +395,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster allocate(resid(3_pInt*nIntFaceTot), source=0.0_pReal) allocate(tract(nIntFaceTot,3), source=0.0_pReal) - allocate(relax(3_pInt*nIntFaceTot)); relax= homogState(mappingHomogenization(2,ip,el))% & - state(1:3_pInt*nIntFaceTot,mappingHomogenization(1,ip,el)) - allocate(drelax(3_pInt*nIntFaceTot)); drelax= homogState(mappingHomogenization(2,ip,el))% & - state(1:3_pInt*nIntFaceTot,mappingHomogenization(1,ip,el)) - & - homogState(mappingHomogenization(2,ip,el))% & - state0(1:3_pInt*nIntFaceTot,mappingHomogenization(1,ip,el)) + relax = homogState(mappingHomogenization(2,ip,el))%state (1:3_pInt*nIntFaceTot,mappingHomogenization(1,ip,el)) + drelax = relax & + - homogState(mappingHomogenization(2,ip,el))%state0(1:3_pInt*nIntFaceTot,mappingHomogenization(1,ip,el)) !-------------------------------------------------------------------------------------------------- ! debugging the obtained state if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then @@ -1145,25 +1143,21 @@ function surfaceCorrection(avgF,ip,el) real(pReal), dimension(3,3), intent(in) :: avgF !< average F integer(pInt), intent(in) :: ip,& !< integration point number el !< element number - real(pReal), dimension(3,3) :: invC,avgC + real(pReal), dimension(3,3) :: invC real(pReal), dimension(3) :: nVect real(pReal) :: detF - integer(pInt), dimension(4) :: intFace integer(pInt) :: i,j,iBase logical :: error - avgC = math_mul33x33(transpose(avgF),avgF) - call math_invert33(avgC,invC,detF,error) + call math_invert33(math_mul33x33(transpose(avgF),avgF),invC,detF,error) + surfaceCorrection = 0.0_pReal do iBase = 1_pInt,3_pInt - intFace = [iBase,1_pInt,1_pInt,1_pInt] - nVect = interfaceNormal(intFace,ip,el) ! get the normal of the interface + nVect = interfaceNormal([iBase,1_pInt,1_pInt,1_pInt],ip,el) ! get the normal of the interface do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt - surfaceCorrection(iBase) = & ! compute the component of (the inverse of) the stretch in the direction of the normal - surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j) + surfaceCorrection(iBase) = surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j) ! compute the component of (the inverse of) the stretch in the direction of the normal enddo; enddo - surfaceCorrection(iBase) = & ! get the surface correction factor (area contraction/enlargement) - sqrt(surfaceCorrection(iBase))*detF + surfaceCorrection(iBase) = sqrt(surfaceCorrection(iBase))*detF ! get the surface correction factor (area contraction/enlargement) enddo end function surfaceCorrection @@ -1314,7 +1308,7 @@ pure function grain3to1(grain3,instance) implicit none integer(pInt), dimension (3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z) - integer(pInt), intent(in) :: instance ! homogenization ID + integer(pInt), intent(in) :: instance ! homogenization ID integer(pInt) :: grain3to1 integer(pInt), dimension (3) :: nGDim diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index cdff607bf..9c7f6752d 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -64,8 +64,7 @@ subroutine homogenization_isostrain_init() integer(pInt) :: & h integer :: & - maxNinstance, & - instance + Ninstance integer :: & NofMyHomog ! no pInt (stores a system dependen value from 'count' character(len=65536) :: & @@ -76,18 +75,17 @@ subroutine homogenization_isostrain_init() write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) - if (maxNinstance == 0) return + Ninstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) + if (Ninstance == 0) return if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(param(maxNinstance)) ! one container of parameters per instance + allocate(param(Ninstance)) ! one container of parameters per instance do h = 1_pInt, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_ISOSTRAIN_ID) cycle - instance = homogenization_typeInstance(h) - associate(prm => param(instance)) + associate(prm => param(homogenization_typeInstance(h))) prm%Nconstituents = config_homogenization(h)%getInt('nconstituents') tag = 'sum' From 0447ea9d740240861ae07401a31a134a87ebf5a6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 20:00:02 +0100 Subject: [PATCH 023/107] starting to introduce state pointers --- src/homogenization_RGC.f90 | 49 +++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index d520d092a..8fe2d5a03 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -249,6 +249,9 @@ subroutine homogenization_RGC_init() allocate(homogState(h)%subState0(sizeHState,NofMyHomog), source=0.0_pReal) allocate(homogState(h)%state (sizeHState,NofMyHomog), source=0.0_pReal) + state(instance)%work =>homogState(h)%state(nIntFaceTot+1,:) + state(instance)%penaltyEnergy =>homogState(h)%state(nIntFaceTot+5,:) + end associate enddo @@ -366,11 +369,11 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) integer(pInt), dimension (4) :: intFaceN,intFaceP,faceID integer(pInt), dimension (3) :: nGDim,iGr3N,iGr3P,stresLoc integer(pInt), dimension (2) :: residLoc - integer(pInt) instance,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain + integer(pInt) instance,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain, of real(pReal), dimension (3,3,homogenization_maxNgrains) :: R,pF,pR,D,pD real(pReal), dimension (3,homogenization_maxNgrains) :: NN,pNN real(pReal), dimension (3) :: normP,normN,mornP,mornN - real(pReal) :: residMax,stresMax,constitutiveWork,penaltyEnergy,volDiscrep + real(pReal) :: residMax,stresMax,volDiscrep logical error integer(pInt), parameter :: nFace = 6_pInt @@ -386,6 +389,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! get the dimension of the cluster (grains and interfaces) instance = homogenization_typeInstance(mesh_homogenizationAt(el)) + of = mappingHomogenization(1,ip,el) nGDim = param(instance)%Nconstituents nGrain = homogenization_Ngrains(mesh_homogenizationAt(el)) nIntFaceTot = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) & @@ -395,16 +399,16 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster allocate(resid(3_pInt*nIntFaceTot), source=0.0_pReal) allocate(tract(nIntFaceTot,3), source=0.0_pReal) - relax = homogState(mappingHomogenization(2,ip,el))%state (1:3_pInt*nIntFaceTot,mappingHomogenization(1,ip,el)) + relax = homogState(mappingHomogenization(2,ip,el))%state (1:3_pInt*nIntFaceTot,of) drelax = relax & - - homogState(mappingHomogenization(2,ip,el))%state0(1:3_pInt*nIntFaceTot,mappingHomogenization(1,ip,el)) + - homogState(mappingHomogenization(2,ip,el))%state0(1:3_pInt*nIntFaceTot,of) !-------------------------------------------------------------------------------------------------- ! debugging the obtained state if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then !$OMP CRITICAL (write2out) write(6,'(1x,a30)')'Obtained state: ' do i = 1_pInt,3_pInt*nIntFaceTot - write(6,'(1x,2(e15.8,1x))')homogState(mappingHomogenization(2,ip,el))%state(i,mappingHomogenization(1,ip,el)) + write(6,'(1x,2(e15.8,1x))')homogState(mappingHomogenization(2,ip,el))%state(i,of) enddo write(6,*)' ' !$OMP END CRITICAL (write2out) @@ -518,42 +522,39 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! compute/update the state for postResult, i.e., all energy densities computed by time-integration - constitutiveWork = homogState(mappingHomogenization(2,ip,el))%state(3*nIntFaceTot+1,mappingHomogenization(1,ip,el)) - penaltyEnergy = homogState(mappingHomogenization(2,ip,el))%state(3*nIntFaceTot+5,mappingHomogenization(1,ip,el)) do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) ! time-integration loop for the calculating the work and energy do i = 1_pInt,3_pInt do j = 1_pInt,3_pInt - constitutiveWork = constitutiveWork + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) - penaltyEnergy = penaltyEnergy + R(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) + state(instance)%work(of) = state(instance)%work(of) & + + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) + state(instance)%penaltyEnergy(of) = state(instance)%penaltyEnergy(of) & + + R(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) enddo enddo enddo homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+1,mappingHomogenization(1,ip,el)) = constitutiveWork ! the bulk mechanical/constitutive work + state(3*nIntFaceTot+2,of) = sum(NN(1,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e1-direction homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+2,mappingHomogenization(1,ip,el)) = sum(NN(1,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e1-direction + state(3*nIntFaceTot+3,of) = sum(NN(2,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e2-direction homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+3,mappingHomogenization(1,ip,el)) = sum(NN(2,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e2-direction + state(3*nIntFaceTot+4,of) = sum(NN(3,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e3-direction + homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+4,mappingHomogenization(1,ip,el)) = sum(NN(3,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e3-direction + state(3*nIntFaceTot+6,of) = volDiscrep ! the overall volume discrepancy homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+5,mappingHomogenization(1,ip,el)) = penaltyEnergy ! the overall penalty energy - homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+6,mappingHomogenization(1,ip,el)) = volDiscrep ! the overall volume discrepancy - homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+7,mappingHomogenization(1,ip,el)) = & + state(3*nIntFaceTot+7,of) = & sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) ! the average rate of relaxation vectors homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+8,mappingHomogenization(1,ip,el)) = maxval(abs(drelax))/dt ! the maximum rate of relaxation vectors + state(3*nIntFaceTot+8,of) = maxval(abs(drelax))/dt ! the maximum rate of relaxation vectors if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip) then !$OMP CRITICAL (write2out) - write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',constitutiveWork + write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',state(instance)%work(of) write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',sum(NN(1,:))/real(nGrain,pReal), & sum(NN(2,:))/real(nGrain,pReal), & sum(NN(3,:))/real(nGrain,pReal) - write(6,'(1x,a30,1x,e15.8)') 'Penalty energy: ',penaltyEnergy + write(6,'(1x,a30,1x,e15.8)') 'Penalty energy: ',state(instance)%penaltyEnergy(of) write(6,'(1x,a30,1x,e15.8,/)') 'Volume discrepancy: ',volDiscrep write(6,'(1x,a30,1x,e15.8)') 'Maximum relaxation rate: ',maxval(abs(drelax))/dt write(6,'(1x,a30,1x,e15.8,/)') 'Average relaxation rate: ',sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) @@ -658,7 +659,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) do ipert = 1_pInt,3_pInt*nIntFaceTot p_relax = relax p_relax(ipert) = relax(ipert) + pPert_RGC ! perturb the relaxation vector - homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,mappingHomogenization(1,ip,el)) = p_relax + homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,of) = p_relax call grainDeformation(pF,avgF,ip,el) ! compute the grains deformation from perturbed state call stressPenalty(pR,pNN,avgF,pF,ip,el,instance) ! compute stress penalty due to interface mismatch from perturbed state call volumePenalty(pD,volDiscrep,pF,avgF,ip,el) ! compute stress penalty due to volume discrepancy from perturbed state @@ -774,7 +775,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) enddo enddo relax = relax + drelax ! Updateing the state variable for the next iteration - homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,mappingHomogenization(1,ip,el)) = relax + homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,of) = relax if (any(abs(drelax) > maxdRelax_RGC)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large homogenization_RGC_updateState = [.true.,.false.] !$OMP CRITICAL (write2out) @@ -790,7 +791,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !$OMP CRITICAL (write2out) write(6,'(1x,a30)')'Returned state: ' do i = 1_pInt,3_pInt*nIntFaceTot - write(6,'(1x,2(e15.8,1x))')homogState(mappingHomogenization(2,ip,el))%state(i,mappingHomogenization(1,ip,el)) + write(6,'(1x,2(e15.8,1x))')homogState(mappingHomogenization(2,ip,el))%state(i,of) enddo write(6,*)' ' flush(6) From 85a2f19b1823de02501b762afa71f620f37019f6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 20:03:23 +0100 Subject: [PATCH 024/107] wrong averaging --- src/homogenization_RGC.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 8fe2d5a03..e26b98b26 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -827,7 +827,7 @@ subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF, integer(pInt) :: instance, i, j, Nconstituents, iGrain instance = homogenization_typeInstance(mesh_homogenizationAt(el)) - Nconstituents = sum(param(instance)%Nconstituents) + Nconstituents = product(param(instance)%Nconstituents) !-------------------------------------------------------------------------------------------------- ! debugging the grain tangent From c16fdec749a262ddb0335063edd11e88ee0105b6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 20:08:18 +0100 Subject: [PATCH 025/107] misplaced debug statement debugging the individual constituents should be done by the constitutive laws --- src/homogenization.f90 | 3 ++- src/homogenization_RGC.f90 | 48 +++++++------------------------------- 2 files changed, 10 insertions(+), 41 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index e664db0cc..708e72fa8 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -1081,12 +1081,13 @@ subroutine homogenization_averageStressAndItsTangent(ip,el) instance) case (HOMOGENIZATION_RGC_ID) chosenHomogenization + instance = homogenization_typeInstance(mesh_element(3,el)) call homogenization_RGC_averageStressAndItsTangent(& materialpoint_P(1:3,1:3,ip,el), & materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),& crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), & crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), & - el) + instance) end select chosenHomogenization end subroutine homogenization_averageStressAndItsTangent diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index e26b98b26..1b1b5ba66 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -125,11 +125,11 @@ subroutine homogenization_RGC_init() implicit none integer(pInt) :: & NofMyHomog, & - o, h, & + h, & outputSize, & instance, & sizeHState, nIntFaceTot - integer(pInt) :: section=0_pInt, maxNinstance, i,j,e, mySize + integer(pInt) :: maxNinstance, i,j,e, mySize character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID !< ID of each post result output @@ -804,51 +804,19 @@ end function homogenization_RGC_updateState !-------------------------------------------------------------------------------------------------- !> @brief derive average stress and stiffness from constituent quantities !-------------------------------------------------------------------------------------------------- -subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,el) - use debug, only: & - debug_level, & - debug_homogenization,& - debug_levelExtensive - use mesh, only: & - mesh_homogenizationAt +subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) use material, only: & - homogenization_maxNgrains, & - homogenization_typeInstance - use math, only: math_Plain3333to99 - + homogenization_maxNgrains + implicit none real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: P !< array of current grain stresses real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< array of current grain stiffnesses - integer(pInt), intent(in) :: el !< element number - real(pReal), dimension (9,9) :: dPdF99 + integer(pInt), intent(in) :: instance - integer(pInt) :: instance, i, j, Nconstituents, iGrain - - instance = homogenization_typeInstance(mesh_homogenizationAt(el)) - Nconstituents = product(param(instance)%Nconstituents) - -!-------------------------------------------------------------------------------------------------- -! debugging the grain tangent - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then - !$OMP CRITICAL (write2out) - do iGrain = 1_pInt,Nconstituents - dPdF99 = math_Plain3333to99(dPdF(1:3,1:3,1:3,1:3,iGrain)) - write(6,'(1x,a30,1x,i3)')'Stress tangent of grain: ',iGrain - do i = 1_pInt,9_pInt - write(6,'(1x,(e15.8,1x))') (dPdF99(i,j), j = 1_pInt,9_pInt) - enddo - write(6,*)' ' - enddo - flush(6) - !$OMP END CRITICAL (write2out) - endif - -!-------------------------------------------------------------------------------------------------- -! computing the average first Piola-Kirchhoff stress P and the average tangent dPdF - avgP = sum(P,3)/real(Nconstituents,pReal) - dAvgPdAvgF = sum(dPdF,5)/real(Nconstituents,pReal) + avgP = sum(P,3) /real(product(param(instance)%Nconstituents),pReal) + dAvgPdAvgF = sum(dPdF,5)/real(product(param(instance)%Nconstituents),pReal) end subroutine homogenization_RGC_averageStressAndItsTangent From 0aa21e507a9d585d23ec178855fa9073da8f0621 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 21:11:43 +0100 Subject: [PATCH 026/107] functions only used within updatestate --- src/homogenization_RGC.f90 | 645 ++++++++++++++++++------------------- 1 file changed, 322 insertions(+), 323 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 1b1b5ba66..72d838c71 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -74,11 +74,6 @@ module homogenization_RGC homogenization_RGC_updateState, & homogenization_RGC_postResults private :: & - stressPenalty, & - volumePenalty, & - grainDeformation, & - surfaceCorrection, & - equivalentModuli, & relaxationVector, & interfaceNormal, & getInterface, & @@ -797,6 +792,328 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) flush(6) !$OMP END CRITICAL (write2out) endif + + contains + !-------------------------------------------------------------------------------------------------- + !> @brief calculate stress-like penalty due to deformation mismatch + !-------------------------------------------------------------------------------------------------- + subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) + use debug, only: & + debug_level, & + debug_homogenization,& + debug_levelExtensive, & + debug_e, & + debug_i + use mesh, only: & + mesh_homogenizationAt + use constitutive, only: & + constitutive_homogenizedC + use math, only: & + math_civita + use material, only: & + homogenization_maxNgrains,& + homogenization_Ngrains + use numerics, only: & + xSmoo_RGC + + implicit none + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: rPen !< stress-like penalty + real(pReal), dimension (3,homogenization_maxNgrains), intent(out) :: nMis !< total amount of mismatch + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef !< deformation gradients + real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor + integer(pInt), intent(in) :: ip,el,instance + integer(pInt), dimension (4) :: intFace + integer(pInt), dimension (3) :: iGrain3,iGNghb3,nGDim + real(pReal), dimension (3,3) :: gDef,nDef + real(pReal), dimension (3) :: nVect,surfCorr + real(pReal), dimension (2) :: Gmoduli + integer(pInt) :: iGrain,iGNghb,iFace,i,j,k,l + real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb + + type(tParameters) :: prm + integer(pInt), parameter :: nFace = 6_pInt + real(pReal), parameter :: nDefToler = 1.0e-10_pReal + + nGDim = param(instance)%Nconstituents + rPen = 0.0_pReal + nMis = 0.0_pReal + + !-------------------------------------------------------------------------------------------------- + ! get the correction factor the modulus of penalty stress representing the evolution of area of + ! the interfaces due to deformations + surfCorr = surfaceCorrection(avgF,ip,el) + + associate(prm => param(instance)) + !-------------------------------------------------------------------------------------------------- + ! debugging the surface correction factor + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el + write(6,'(1x,3(e11.4,1x))')(surfCorr(i), i = 1,3) + !$OMP END CRITICAL (write2out) + endif + + !-------------------------------------------------------------------------------------------------- + ! computing the mismatch and penalty stress tensor of all grains + do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) + Gmoduli = equivalentModuli(iGrain,ip,el) + muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain + bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector + iGrain3 = grain1to3(iGrain,instance) ! get the grain ID in local 3-dimensional index (x,y,z)-position + + !* Looping over all six interfaces of each grain + do iFace = 1_pInt,nFace + intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain + nVect = interfaceNormal(intFace,ip,el) ! get the interface normal + iGNghb3 = iGrain3 ! identify the neighboring grain across the interface + iGNghb3(abs(intFace(1))) = iGNghb3(abs(intFace(1))) + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal),pInt) + if (iGNghb3(1) < 1) iGNghb3(1) = nGDim(1) ! with periodicity along e1 direction + if (iGNghb3(1) > nGDim(1)) iGNghb3(1) = 1_pInt + if (iGNghb3(2) < 1) iGNghb3(2) = nGDim(2) ! with periodicity along e2 direction + if (iGNghb3(2) > nGDim(2)) iGNghb3(2) = 1_pInt + if (iGNghb3(3) < 1) iGNghb3(3) = nGDim(3) ! with periodicity along e3 direction + if (iGNghb3(3) > nGDim(3)) iGNghb3(3) = 1_pInt + iGNghb = grain3to1(iGNghb3,instance) ! get the ID of the neighboring grain + Gmoduli = equivalentModuli(iGNghb,ip,el) ! collecting the shear modulus and Burgers vector of the neighbor + muGNghb = Gmoduli(1) + bgGNghb = Gmoduli(2) + gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! compute the difference/jump in deformation gradeint across the neighbor + + !-------------------------------------------------------------------------------------------------- + ! compute the mismatch tensor of all interfaces + nDefNorm = 0.0_pReal + nDef = 0.0_pReal + do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt + do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt + nDef(i,j) = nDef(i,j) - nVect(k)*gDef(i,l)*math_civita(j,k,l) ! compute the interface mismatch tensor from the jump of deformation gradient + enddo; enddo + nDefNorm = nDefNorm + nDef(i,j)*nDef(i,j) ! compute the norm of the mismatch tensor + enddo; enddo + nDefNorm = max(nDefToler,sqrt(nDefNorm)) ! approximation to zero mismatch if mismatch is zero (singularity) + nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm ! total amount of mismatch experienced by the grain (at all six interfaces) + + !-------------------------------------------------------------------------------------------------- + ! debuggin the mismatch tensor + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a20,i2,1x,a20,1x,i3)')'Mismatch to face: ',intFace(1),'neighbor grain: ',iGNghb + do i = 1,3 + write(6,'(1x,3(e11.4,1x))')(nDef(i,j), j = 1,3) + enddo + write(6,'(1x,a20,e11.4)')'with magnitude: ',nDefNorm + !$OMP END CRITICAL (write2out) + endif + + !-------------------------------------------------------------------------------------------------- + ! compute the stress penalty of all interfaces + do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt + do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt + rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xiAlpha & + *surfCorr(abs(intFace(1)))/prm%dAlpha(abs(intFace(1))) & + *cosh(prm%ciAlpha*nDefNorm) & + *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_civita(k,l,j) & + *tanh(nDefNorm/xSmoo_RGC) + enddo; enddo + enddo; enddo + enddo + + !-------------------------------------------------------------------------------------------------- + ! debugging the stress-like penalty + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a20,i2)')'Penalty of grain: ',iGrain + do i = 1,3 + write(6,'(1x,3(e11.4,1x))')(rPen(i,j,iGrain), j = 1,3) + enddo + !$OMP END CRITICAL (write2out) + endif + + enddo + end associate + + end subroutine stressPenalty + + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate stress-like penalty due to volume discrepancy + !-------------------------------------------------------------------------------------------------- + subroutine volumePenalty(vPen,vDiscrep,fDef,fAvg,ip,el) + use debug, only: & + debug_level, & + debug_homogenization,& + debug_levelExtensive, & + debug_e, & + debug_i + use mesh, only: & + mesh_homogenizationAt + use math, only: & + math_det33, & + math_inv33 + use material, only: & + homogenization_maxNgrains,& + homogenization_Ngrains + use numerics, only: & + maxVolDiscr_RGC,& + volDiscrMod_RGC,& + volDiscrPow_RGC + + implicit none + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: vPen ! stress-like penalty due to volume + real(pReal), intent(out) :: vDiscrep ! total volume discrepancy + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef ! deformation gradients + real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient + integer(pInt), intent(in) :: ip,& ! integration point + el + real(pReal), dimension (homogenization_maxNgrains) :: gVol + integer(pInt) :: iGrain,nGrain,i,j + + nGrain = homogenization_Ngrains(mesh_homogenizationAt(el)) + + !-------------------------------------------------------------------------------------------------- + ! compute the volumes of grains and of cluster + vDiscrep = math_det33(fAvg) ! compute the volume of the cluster + do iGrain = 1_pInt,nGrain + gVol(iGrain) = math_det33(fDef(1:3,1:3,iGrain)) ! compute the volume of individual grains + vDiscrep = vDiscrep - gVol(iGrain)/real(nGrain,pReal) ! calculate the difference/dicrepancy between + ! the volume of the cluster and the the total volume of grains + enddo + + !-------------------------------------------------------------------------------------------------- + ! calculate the stress and penalty due to volume discrepancy + vPen = 0.0_pReal + do iGrain = 1_pInt,nGrain + vPen(:,:,iGrain) = -1.0_pReal/real(nGrain,pReal)*volDiscrMod_RGC*volDiscrPow_RGC/maxVolDiscr_RGC* & + sign((abs(vDiscrep)/maxVolDiscr_RGC)**(volDiscrPow_RGC - 1.0),vDiscrep)* & + gVol(iGrain)*transpose(math_inv33(fDef(:,:,iGrain))) + + !-------------------------------------------------------------------------------------------------- + ! debugging the stress-like penalty + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip) then + !$OMP CRITICAL (write2out) + write(6,'(1x,a30,i2)')'Volume penalty of grain: ',iGrain + do i = 1,3 + write(6,'(1x,3(e11.4,1x))')(vPen(i,j,iGrain), j = 1,3) + enddo + !$OMP END CRITICAL (write2out) + endif + enddo + + end subroutine volumePenalty + + + !-------------------------------------------------------------------------------------------------- + !> @brief compute the correction factor accouted for surface evolution (area change) due to + ! deformation + !-------------------------------------------------------------------------------------------------- + function surfaceCorrection(avgF,ip,el) + use math, only: & + math_invert33, & + math_mul33x33 + + implicit none + real(pReal), dimension(3) :: surfaceCorrection + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + integer(pInt), intent(in) :: ip,& !< integration point number + el !< element number + real(pReal), dimension(3,3) :: invC + real(pReal), dimension(3) :: nVect + real(pReal) :: detF + integer(pInt) :: i,j,iBase + logical :: error + + call math_invert33(math_mul33x33(transpose(avgF),avgF),invC,detF,error) + + surfaceCorrection = 0.0_pReal + do iBase = 1_pInt,3_pInt + nVect = interfaceNormal([iBase,1_pInt,1_pInt,1_pInt],ip,el) ! get the normal of the interface + do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt + surfaceCorrection(iBase) = surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j) ! compute the component of (the inverse of) the stretch in the direction of the normal + enddo; enddo + surfaceCorrection(iBase) = sqrt(surfaceCorrection(iBase))*detF ! get the surface correction factor (area contraction/enlargement) + enddo + + end function surfaceCorrection + + + !-------------------------------------------------------------------------------------------------- + !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor + !-------------------------------------------------------------------------------------------------- + function equivalentModuli(grainID,ip,el) + use constitutive, only: & + constitutive_homogenizedC + + implicit none + integer(pInt), intent(in) :: & + grainID,& + ip, & !< integration point number + el !< element number + real(pReal), dimension (6,6) :: elasTens + real(pReal), dimension(2) :: equivalentModuli + real(pReal) :: & + cEquiv_11, & + cEquiv_12, & + cEquiv_44 + + elasTens = constitutive_homogenizedC(grainID,ip,el) + + !-------------------------------------------------------------------------------------------------- + ! compute the equivalent shear modulus after Turterltaub and Suiker, JMPS (2005) + cEquiv_11 = (elasTens(1,1) + elasTens(2,2) + elasTens(3,3))/3.0_pReal + cEquiv_12 = (elasTens(1,2) + elasTens(2,3) + elasTens(3,1) + & + elasTens(1,3) + elasTens(2,1) + elasTens(3,2))/6.0_pReal + cEquiv_44 = (elasTens(4,4) + elasTens(5,5) + elasTens(6,6))/3.0_pReal + equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44 + + !-------------------------------------------------------------------------------------------------- + ! obtain the length of Burgers vector (could be model dependend) + equivalentModuli(2) = 2.5e-10_pReal + + end function equivalentModuli + + + !-------------------------------------------------------------------------------------------------- + !> @brief calculating the grain deformation gradient (the same with + ! homogenization_RGC_partionDeformation, but used only for perturbation scheme) + !-------------------------------------------------------------------------------------------------- + subroutine grainDeformation(F, avgF, ip, el) + use mesh, only: & + mesh_homogenizationAt + use material, only: & + homogenization_maxNgrains,& + homogenization_typeInstance + + implicit none + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned F per grain + real(pReal), dimension (3,3), intent(in) :: avgF !< + integer(pInt), intent(in) :: & + el, & !< element number + ip !< integration point number + real(pReal), dimension (3) :: aVect,nVect + integer(pInt), dimension (4) :: intFace + integer(pInt), dimension (3) :: iGrain3 + integer(pInt) :: instance, iGrain,iFace,i,j + + !-------------------------------------------------------------------------------------------------- + ! compute the deformation gradient of individual grains due to relaxations + instance = homogenization_typeInstance(mesh_homogenizationAt(el)) + F = 0.0_pReal + do iGrain = 1_pInt,product(param(instance)%Nconstituents) + iGrain3 = grain1to3(iGrain,instance) + do iFace = 1_pInt,6_pInt + intFace = getInterface(iFace,iGrain3) + aVect = relaxationVector(intFace,instance, ip, el) + nVect = interfaceNormal(intFace,ip,el) + forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & + F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! effective relaxations + enddo + F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! relaxed deformation gradient + enddo + + end subroutine grainDeformation end function homogenization_RGC_updateState @@ -887,285 +1204,7 @@ pure function homogenization_RGC_postResults(ip,el) result(postResults) end function homogenization_RGC_postResults -!-------------------------------------------------------------------------------------------------- -!> @brief calculate stress-like penalty due to deformation mismatch -!-------------------------------------------------------------------------------------------------- -subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) - use debug, only: & - debug_level, & - debug_homogenization,& - debug_levelExtensive, & - debug_e, & - debug_i - use mesh, only: & - mesh_homogenizationAt - use constitutive, only: & - constitutive_homogenizedC - use math, only: & - math_civita - use material, only: & - homogenization_maxNgrains,& - homogenization_Ngrains - use numerics, only: & - xSmoo_RGC - - implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: rPen !< stress-like penalty - real(pReal), dimension (3,homogenization_maxNgrains), intent(out) :: nMis !< total amount of mismatch - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef !< deformation gradients - real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor - integer(pInt), intent(in) :: ip,el,instance - integer(pInt), dimension (4) :: intFace - integer(pInt), dimension (3) :: iGrain3,iGNghb3,nGDim - real(pReal), dimension (3,3) :: gDef,nDef - real(pReal), dimension (3) :: nVect,surfCorr - real(pReal), dimension (2) :: Gmoduli - integer(pInt) :: iGrain,iGNghb,iFace,i,j,k,l - real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb - - type(tParameters) :: prm - integer(pInt), parameter :: nFace = 6_pInt - real(pReal), parameter :: nDefToler = 1.0e-10_pReal - nGDim = param(instance)%Nconstituents - rPen = 0.0_pReal - nMis = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! get the correction factor the modulus of penalty stress representing the evolution of area of -! the interfaces due to deformations - surfCorr = surfaceCorrection(avgF,ip,el) - - associate(prm => param(instance)) -!-------------------------------------------------------------------------------------------------- -! debugging the surface correction factor - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) - write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el - write(6,'(1x,3(e11.4,1x))')(surfCorr(i), i = 1,3) - !$OMP END CRITICAL (write2out) - endif - -!-------------------------------------------------------------------------------------------------- -! computing the mismatch and penalty stress tensor of all grains - do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) - Gmoduli = equivalentModuli(iGrain,ip,el) - muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain - bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector - iGrain3 = grain1to3(iGrain,instance) ! get the grain ID in local 3-dimensional index (x,y,z)-position - -!* Looping over all six interfaces of each grain - do iFace = 1_pInt,nFace - intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain - nVect = interfaceNormal(intFace,ip,el) ! get the interface normal - iGNghb3 = iGrain3 ! identify the neighboring grain across the interface - iGNghb3(abs(intFace(1))) = iGNghb3(abs(intFace(1))) + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal),pInt) - if (iGNghb3(1) < 1) iGNghb3(1) = nGDim(1) ! with periodicity along e1 direction - if (iGNghb3(1) > nGDim(1)) iGNghb3(1) = 1_pInt - if (iGNghb3(2) < 1) iGNghb3(2) = nGDim(2) ! with periodicity along e2 direction - if (iGNghb3(2) > nGDim(2)) iGNghb3(2) = 1_pInt - if (iGNghb3(3) < 1) iGNghb3(3) = nGDim(3) ! with periodicity along e3 direction - if (iGNghb3(3) > nGDim(3)) iGNghb3(3) = 1_pInt - iGNghb = grain3to1(iGNghb3,instance) ! get the ID of the neighboring grain - Gmoduli = equivalentModuli(iGNghb,ip,el) ! collecting the shear modulus and Burgers vector of the neighbor - muGNghb = Gmoduli(1) - bgGNghb = Gmoduli(2) - gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! compute the difference/jump in deformation gradeint across the neighbor - -!-------------------------------------------------------------------------------------------------- -! compute the mismatch tensor of all interfaces - nDefNorm = 0.0_pReal - nDef = 0.0_pReal - do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt - do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt - nDef(i,j) = nDef(i,j) - nVect(k)*gDef(i,l)*math_civita(j,k,l) ! compute the interface mismatch tensor from the jump of deformation gradient - enddo; enddo - nDefNorm = nDefNorm + nDef(i,j)*nDef(i,j) ! compute the norm of the mismatch tensor - enddo; enddo - nDefNorm = max(nDefToler,sqrt(nDefNorm)) ! approximation to zero mismatch if mismatch is zero (singularity) - nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm ! total amount of mismatch experienced by the grain (at all six interfaces) - -!-------------------------------------------------------------------------------------------------- -! debuggin the mismatch tensor - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) - write(6,'(1x,a20,i2,1x,a20,1x,i3)')'Mismatch to face: ',intFace(1),'neighbor grain: ',iGNghb - do i = 1,3 - write(6,'(1x,3(e11.4,1x))')(nDef(i,j), j = 1,3) - enddo - write(6,'(1x,a20,e11.4)')'with magnitude: ',nDefNorm - !$OMP END CRITICAL (write2out) - endif - -!-------------------------------------------------------------------------------------------------- -! compute the stress penalty of all interfaces - do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt - do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt - rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xiAlpha & - *surfCorr(abs(intFace(1)))/prm%dAlpha(abs(intFace(1))) & - *cosh(prm%ciAlpha*nDefNorm) & - *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_civita(k,l,j) & - *tanh(nDefNorm/xSmoo_RGC) - enddo; enddo - enddo; enddo - enddo - -!-------------------------------------------------------------------------------------------------- -! debugging the stress-like penalty - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) - write(6,'(1x,a20,i2)')'Penalty of grain: ',iGrain - do i = 1,3 - write(6,'(1x,3(e11.4,1x))')(rPen(i,j,iGrain), j = 1,3) - enddo - !$OMP END CRITICAL (write2out) - endif - - enddo - end associate - -end subroutine stressPenalty - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate stress-like penalty due to volume discrepancy -!-------------------------------------------------------------------------------------------------- -subroutine volumePenalty(vPen,vDiscrep,fDef,fAvg,ip,el) - use debug, only: & - debug_level, & - debug_homogenization,& - debug_levelExtensive, & - debug_e, & - debug_i - use mesh, only: & - mesh_homogenizationAt - use math, only: & - math_det33, & - math_inv33 - use material, only: & - homogenization_maxNgrains,& - homogenization_Ngrains - use numerics, only: & - maxVolDiscr_RGC,& - volDiscrMod_RGC,& - volDiscrPow_RGC - - implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: vPen ! stress-like penalty due to volume - real(pReal), intent(out) :: vDiscrep ! total volume discrepancy - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef ! deformation gradients - real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient - integer(pInt), intent(in) :: ip,& ! integration point - el - real(pReal), dimension (homogenization_maxNgrains) :: gVol - integer(pInt) :: iGrain,nGrain,i,j - - nGrain = homogenization_Ngrains(mesh_homogenizationAt(el)) - -!-------------------------------------------------------------------------------------------------- -! compute the volumes of grains and of cluster - vDiscrep = math_det33(fAvg) ! compute the volume of the cluster - do iGrain = 1_pInt,nGrain - gVol(iGrain) = math_det33(fDef(1:3,1:3,iGrain)) ! compute the volume of individual grains - vDiscrep = vDiscrep - gVol(iGrain)/real(nGrain,pReal) ! calculate the difference/dicrepancy between - ! the volume of the cluster and the the total volume of grains - enddo - -!-------------------------------------------------------------------------------------------------- -! calculate the stress and penalty due to volume discrepancy - vPen = 0.0_pReal - do iGrain = 1_pInt,nGrain - vPen(:,:,iGrain) = -1.0_pReal/real(nGrain,pReal)*volDiscrMod_RGC*volDiscrPow_RGC/maxVolDiscr_RGC* & - sign((abs(vDiscrep)/maxVolDiscr_RGC)**(volDiscrPow_RGC - 1.0),vDiscrep)* & - gVol(iGrain)*transpose(math_inv33(fDef(:,:,iGrain))) - -!-------------------------------------------------------------------------------------------------- -! debugging the stress-like penalty - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) - write(6,'(1x,a30,i2)')'Volume penalty of grain: ',iGrain - do i = 1,3 - write(6,'(1x,3(e11.4,1x))')(vPen(i,j,iGrain), j = 1,3) - enddo - !$OMP END CRITICAL (write2out) - endif - enddo - -end subroutine volumePenalty - - -!-------------------------------------------------------------------------------------------------- -!> @brief compute the correction factor accouted for surface evolution (area change) due to -! deformation -!-------------------------------------------------------------------------------------------------- -function surfaceCorrection(avgF,ip,el) - use math, only: & - math_invert33, & - math_mul33x33 - - implicit none - real(pReal), dimension(3) :: surfaceCorrection - real(pReal), dimension(3,3), intent(in) :: avgF !< average F - integer(pInt), intent(in) :: ip,& !< integration point number - el !< element number - real(pReal), dimension(3,3) :: invC - real(pReal), dimension(3) :: nVect - real(pReal) :: detF - integer(pInt) :: i,j,iBase - logical :: error - - call math_invert33(math_mul33x33(transpose(avgF),avgF),invC,detF,error) - - surfaceCorrection = 0.0_pReal - do iBase = 1_pInt,3_pInt - nVect = interfaceNormal([iBase,1_pInt,1_pInt,1_pInt],ip,el) ! get the normal of the interface - do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt - surfaceCorrection(iBase) = surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j) ! compute the component of (the inverse of) the stretch in the direction of the normal - enddo; enddo - surfaceCorrection(iBase) = sqrt(surfaceCorrection(iBase))*detF ! get the surface correction factor (area contraction/enlargement) - enddo - -end function surfaceCorrection - - -!-------------------------------------------------------------------------------------------------- -!> @brief compute the equivalent shear and bulk moduli from the elasticity tensor -!-------------------------------------------------------------------------------------------------- -function equivalentModuli(grainID,ip,el) - use constitutive, only: & - constitutive_homogenizedC - - implicit none - integer(pInt), intent(in) :: & - grainID,& - ip, & !< integration point number - el !< element number - real(pReal), dimension (6,6) :: elasTens - real(pReal), dimension(2) :: equivalentModuli - real(pReal) :: & - cEquiv_11, & - cEquiv_12, & - cEquiv_44 - - elasTens = constitutive_homogenizedC(grainID,ip,el) - -!-------------------------------------------------------------------------------------------------- -! compute the equivalent shear modulus after Turterltaub and Suiker, JMPS (2005) - cEquiv_11 = (elasTens(1,1) + elasTens(2,2) + elasTens(3,3))/3.0_pReal - cEquiv_12 = (elasTens(1,2) + elasTens(2,3) + elasTens(3,1) + & - elasTens(1,3) + elasTens(2,1) + elasTens(3,2))/6.0_pReal - cEquiv_44 = (elasTens(4,4) + elasTens(5,5) + elasTens(6,6))/3.0_pReal - equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44 - -!-------------------------------------------------------------------------------------------------- -! obtain the length of Burgers vector (could be model dependend) - equivalentModuli(2) = 2.5e-10_pReal - -end function equivalentModuli !-------------------------------------------------------------------------------------------------- @@ -1394,44 +1433,4 @@ pure function interface1to4(iFace1D, instance) end function interface1to4 -!-------------------------------------------------------------------------------------------------- -!> @brief calculating the grain deformation gradient (the same with -! homogenization_RGC_partionDeformation, but used only for perturbation scheme) -!-------------------------------------------------------------------------------------------------- -subroutine grainDeformation(F, avgF, ip, el) - use mesh, only: & - mesh_homogenizationAt - use material, only: & - homogenization_maxNgrains,& - homogenization_typeInstance - - implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned F per grain - real(pReal), dimension (3,3), intent(in) :: avgF !< - integer(pInt), intent(in) :: & - el, & !< element number - ip !< integration point number - real(pReal), dimension (3) :: aVect,nVect - integer(pInt), dimension (4) :: intFace - integer(pInt), dimension (3) :: iGrain3 - integer(pInt) :: instance, iGrain,iFace,i,j - -!-------------------------------------------------------------------------------------------------- -! compute the deformation gradient of individual grains due to relaxations - instance = homogenization_typeInstance(mesh_homogenizationAt(el)) - F = 0.0_pReal - do iGrain = 1_pInt,product(param(instance)%Nconstituents) - iGrain3 = grain1to3(iGrain,instance) - do iFace = 1_pInt,6_pInt - intFace = getInterface(iFace,iGrain3) - aVect = relaxationVector(intFace,instance, ip, el) - nVect = interfaceNormal(intFace,ip,el) - forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & - F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! effective relaxations - enddo - F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! relaxed deformation gradient - enddo - -end subroutine grainDeformation - end module homogenization_RGC From 69079b65584052700e0a1edba7fcf8b25be9cd71 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 21:16:36 +0100 Subject: [PATCH 027/107] was not used at all --- src/homogenization_RGC.f90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 72d838c71..43bf9cea0 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -1105,8 +1105,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iGrain3 = grain1to3(iGrain,instance) do iFace = 1_pInt,6_pInt intFace = getInterface(iFace,iGrain3) - aVect = relaxationVector(intFace,instance, ip, el) - nVect = interfaceNormal(intFace,ip,el) + aVect = relaxationVector(intFace,instance, ip, el) + nVect = interfaceNormal(intFace,ip,el) forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! effective relaxations enddo @@ -1219,7 +1219,6 @@ function relaxationVector(intFace,instance, ip, el) integer(pInt), intent(in) :: ip, el real(pReal), dimension (3) :: relaxationVector integer(pInt), dimension (4), intent(in) :: intFace !< set of interface ID in 4D array (normal and position) - integer(pInt), dimension (3) :: nGDim integer(pInt) :: & iNum, & instance !< homogenization ID @@ -1227,7 +1226,6 @@ function relaxationVector(intFace,instance, ip, el) !-------------------------------------------------------------------------------------------------- ! collect the interface relaxation vector from the global state array relaxationVector = 0.0_pReal - nGDim = param(instance)%Nconstituents iNum = interface4to1(intFace,instance) ! identify the position of the interface in global state array if (iNum > 0_pInt) relaxationVector = homogState(mappingHomogenization(2,ip,el))% & state((3*iNum-2):(3*iNum),mappingHomogenization(1,ip,el)) ! get the corresponding entries From 70998f7f9a2f5730c0ee0cce22b3d3535195f9c2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 21:36:49 +0100 Subject: [PATCH 028/107] cleaning --- src/homogenization_RGC.f90 | 139 ++++++++++++++++++------------------- 1 file changed, 67 insertions(+), 72 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 43bf9cea0..1fb26b1e8 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -48,25 +48,32 @@ module homogenization_RGC outputID !< ID of each post result output end type - type, private :: tRGCState + type, private :: tRGCstate real(pReal), pointer, dimension(:) :: & work, & penaltyEnergy, & volumeDiscrepancy, & relaxationRate_avg, & - relaxationRage_max + relaxationRate_max real(pReal), pointer, dimension(:,:) :: & mismatch - end type tRGCState + end type tRGCstate + + type, private :: tRGCdependentState + real(pReal), allocatable, dimension(:,:,:) :: & + orientation + end type tRGCdependentState + + type(tparameters), dimension(:), allocatable, private :: param !< containers of parameters (len Ninstance) + type(tRGCstate), dimension(:), allocatable, private :: state + type(tRGCdependentState), dimension(:), allocatable, private :: dependentState + ! START: Could be improved real(pReal), dimension(:,:,:,:), allocatable, private :: & homogenization_RGC_orientation ! END: Could be improved - type(tParameters), dimension(:), allocatable, private :: param !< containers of parameters (len Ninstance) - type(tRGCState), dimension(:), allocatable, private :: state - public :: & homogenization_RGC_init, & homogenization_RGC_partitionDeformation, & @@ -147,6 +154,7 @@ subroutine homogenization_RGC_init() allocate(param(maxNinstance)) ! one container of parameters per instance allocate(state(maxNinstance)) ! one container per instance + allocate(dependentState(maxNinstance)) ! one container per instance allocate(homogenization_RGC_Noutput(maxNinstance), source=0_pInt) allocate(homogenization_RGC_output(maxval(homogenization_Noutput),maxNinstance)) @@ -201,24 +209,6 @@ subroutine homogenization_RGC_init() prm%outputID = [prm%outputID , outputID] endif enddo -!-------------------------------------------------------------------------------------------------- -! * assigning cluster orientations - elementLooping: do e = 1_pInt,mesh_NcpElems - if (homogenization_typeInstance(mesh_homogenizationAt(e)) == instance) then - noOrientationGiven: if (all (prm%angles >= 399.9_pReal)) then - homogenization_RGC_orientation(1:3,1:3,1,e) = math_EulerToR(math_sampleRandomOri()) - do i = 2_pInt,mesh_NipsPerElem - homogenization_RGC_orientation(1:3,1:3,i,e) = merge(homogenization_RGC_orientation(1:3,1:3,1,e), & - math_EulerToR(math_sampleRandomOri()), & - microstructure_elemhomo(mesh_microstructureAt(e))) - enddo - else noOrientationGiven - do i = 1_pInt,mesh_NipsPerElem - homogenization_RGC_orientation(1:3,1:3,i,e) = math_EulerToR(prm%angles*inRad) - enddo - endif noOrientationGiven - endif - enddo elementLooping if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then write(6,'(a15,1x,i4,/)') 'instance: ', instance @@ -244,9 +234,34 @@ subroutine homogenization_RGC_init() allocate(homogState(h)%subState0(sizeHState,NofMyHomog), source=0.0_pReal) allocate(homogState(h)%state (sizeHState,NofMyHomog), source=0.0_pReal) - state(instance)%work =>homogState(h)%state(nIntFaceTot+1,:) - state(instance)%penaltyEnergy =>homogState(h)%state(nIntFaceTot+5,:) + state(instance)%work =>homogState(h)%state(nIntFaceTot+1,:) + state(instance)%mismatch =>homogState(h)%state(nIntFaceTot+2:nIntFaceTot+4,:) + state(instance)%penaltyEnergy =>homogState(h)%state(nIntFaceTot+5,:) + state(instance)%volumeDiscrepancy =>homogState(h)%state(nIntFaceTot+6,:) + state(instance)%relaxationRate_avg =>homogState(h)%state(nIntFaceTot+7,:) + state(instance)%relaxationRate_max =>homogState(h)%state(nIntFaceTot+8,:) + allocate(dependentState(instance)%orientation(3,3,NofMyHomog)) + + +!-------------------------------------------------------------------------------------------------- +! * assigning cluster orientations + elementLooping: do e = 1_pInt,mesh_NcpElems + if (homogenization_typeInstance(mesh_homogenizationAt(e)) == instance) then + noOrientationGiven: if (all (prm%angles >= 399.9_pReal)) then + homogenization_RGC_orientation(1:3,1:3,1,e) = math_EulerToR(math_sampleRandomOri()) + do i = 2_pInt,mesh_NipsPerElem + homogenization_RGC_orientation(1:3,1:3,i,e) = merge(homogenization_RGC_orientation(1:3,1:3,1,e), & + math_EulerToR(math_sampleRandomOri()), & + microstructure_elemhomo(mesh_microstructureAt(e))) + enddo + else noOrientationGiven + do i = 1_pInt,mesh_NipsPerElem + homogenization_RGC_orientation(1:3,1:3,i,e) = math_EulerToR(prm%angles*inRad) + enddo + endif noOrientationGiven + endif + enddo elementLooping end associate enddo @@ -278,7 +293,6 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,ip,el) integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3 integer(pInt) :: instance, iGrain,iFace,i,j - integer(pInt), parameter :: nFace = 6_pInt !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations @@ -286,7 +300,7 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,ip,el) F = 0.0_pReal do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) iGrain3 = grain1to3(iGrain,instance) - do iFace = 1_pInt,nFace + do iFace = 1_pInt,6_pInt intFace = getInterface(iFace,iGrain3) ! identifying 6 interfaces of each grain aVect = relaxationVector(intFace,instance, ip, el) ! get the relaxation vectors for each interface from global relaxation vector array nVect = interfaceNormal(intFace,ip,el) ! get the normal of each interface @@ -371,8 +385,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) real(pReal) :: residMax,stresMax,volDiscrep logical error - integer(pInt), parameter :: nFace = 6_pInt - real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix real(pReal), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax @@ -527,32 +539,25 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) enddo enddo enddo - homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+2,of) = sum(NN(1,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e1-direction - homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+3,of) = sum(NN(2,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e2-direction - homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+4,of) = sum(NN(3,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e3-direction + state(instance)%mismatch(1,of) = sum(NN(1,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e1-direction + state(instance)%mismatch(2,of) = sum(NN(2,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e2-direction + state(instance)%mismatch(3,of) = sum(NN(3,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e3-direction - homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+6,of) = volDiscrep ! the overall volume discrepancy - homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+7,of) = & - sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) ! the average rate of relaxation vectors - homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+8,of) = maxval(abs(drelax))/dt ! the maximum rate of relaxation vectors + state(instance)%volumeDiscrepancy(of) = volDiscrep + state(instance)%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) + state(instance)%relaxationRate_max(of) = maxval(abs(drelax))/dt if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip) then !$OMP CRITICAL (write2out) write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',state(instance)%work(of) - write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',sum(NN(1,:))/real(nGrain,pReal), & - sum(NN(2,:))/real(nGrain,pReal), & - sum(NN(3,:))/real(nGrain,pReal) - write(6,'(1x,a30,1x,e15.8)') 'Penalty energy: ',state(instance)%penaltyEnergy(of) - write(6,'(1x,a30,1x,e15.8,/)') 'Volume discrepancy: ',volDiscrep - write(6,'(1x,a30,1x,e15.8)') 'Maximum relaxation rate: ',maxval(abs(drelax))/dt - write(6,'(1x,a30,1x,e15.8,/)') 'Average relaxation rate: ',sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) + write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',state(instance)%mismatch(1,of), & + state(instance)%mismatch(2,of), & + state(instance)%mismatch(3,of) + write(6,'(1x,a30,1x,e15.8)') 'Penalty energy: ', state(instance)%penaltyEnergy(of) + write(6,'(1x,a30,1x,e15.8,/)') 'Volume discrepancy: ', state(instance)%volumeDiscrepancy(of) + write(6,'(1x,a30,1x,e15.8)') 'Maximum relaxation rate: ', state(instance)%relaxationRate_max(of) + write(6,'(1x,a30,1x,e15.8,/)') 'Average relaxation rate: ', state(instance)%relaxationRate_avg(of) flush(6) !$OMP END CRITICAL (write2out) endif @@ -600,7 +605,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iGrN = grain3to1(iGr3N,instance) ! translate into global grain ID intFaceN = getInterface(2_pInt*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system normN = interfaceNormal(intFaceN,ip,el) ! get the interface normal - do iFace = 1_pInt,nFace + do iFace = 1_pInt,6_pInt intFaceN = getInterface(iFace,iGr3N) ! identifying all interfaces that influence relaxation of the above interface mornN = interfaceNormal(intFaceN,ip,el) ! get normal of the interfaces iMun = interface4to1(intFaceN,instance) ! translate the interfaces ID into local 4-dimensional index @@ -620,7 +625,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iGrP = grain3to1(iGr3P,instance) ! translate into global grain ID intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the connecting interface in local coordinate system normP = interfaceNormal(intFaceP,ip,el) ! get the interface normal - do iFace = 1_pInt,nFace + do iFace = 1_pInt,6_pInt intFaceP = getInterface(iFace,iGr3P) ! identifying all interfaces that influence relaxation of the above interface mornP = interfaceNormal(intFaceP,ip,el) ! get normal of the interfaces iMun = interface4to1(intFaceP,instance) ! translate the interfaces ID into local 4-dimensional index @@ -831,7 +836,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb type(tParameters) :: prm - integer(pInt), parameter :: nFace = 6_pInt real(pReal), parameter :: nDefToler = 1.0e-10_pReal nGDim = param(instance)%Nconstituents @@ -863,17 +867,14 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iGrain3 = grain1to3(iGrain,instance) ! get the grain ID in local 3-dimensional index (x,y,z)-position !* Looping over all six interfaces of each grain - do iFace = 1_pInt,nFace + do iFace = 1_pInt,6_pInt intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain nVect = interfaceNormal(intFace,ip,el) ! get the interface normal iGNghb3 = iGrain3 ! identify the neighboring grain across the interface - iGNghb3(abs(intFace(1))) = iGNghb3(abs(intFace(1))) + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal),pInt) - if (iGNghb3(1) < 1) iGNghb3(1) = nGDim(1) ! with periodicity along e1 direction - if (iGNghb3(1) > nGDim(1)) iGNghb3(1) = 1_pInt - if (iGNghb3(2) < 1) iGNghb3(2) = nGDim(2) ! with periodicity along e2 direction - if (iGNghb3(2) > nGDim(2)) iGNghb3(2) = 1_pInt - if (iGNghb3(3) < 1) iGNghb3(3) = nGDim(3) ! with periodicity along e3 direction - if (iGNghb3(3) > nGDim(3)) iGNghb3(3) = 1_pInt + iGNghb3(abs(intFace(1))) = iGNghb3(abs(intFace(1))) & + + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal),pInt) + where(iGNghb3 < 1) iGNghb3 = nGDim + where(iGNghb3 >nGDim) iGNghb3 = 1_pInt iGNghb = grain3to1(iGNghb3,instance) ! get the ID of the neighboring grain Gmoduli = equivalentModuli(iGNghb,ip,el) ! collecting the shear modulus and Burgers vector of the neighbor muGNghb = Gmoduli(1) @@ -1001,10 +1002,10 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !$OMP END CRITICAL (write2out) endif enddo - + end subroutine volumePenalty - - + + !-------------------------------------------------------------------------------------------------- !> @brief compute the correction factor accouted for surface evolution (area change) due to ! deformation @@ -1037,8 +1038,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) enddo end function surfaceCorrection - - + + !-------------------------------------------------------------------------------------------------- !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor !-------------------------------------------------------------------------------------------------- @@ -1204,9 +1205,6 @@ pure function homogenization_RGC_postResults(ip,el) result(postResults) end function homogenization_RGC_postResults - - - !-------------------------------------------------------------------------------------------------- !> @brief collect relaxation vectors of an interface !-------------------------------------------------------------------------------------------------- @@ -1237,9 +1235,6 @@ end function relaxationVector !> @brief identify the normal of an interface !-------------------------------------------------------------------------------------------------- function interfaceNormal(intFace,ip,el) - use debug, only: & - debug_homogenization,& - debug_levelExtensive use math, only: & math_mul33x3 From 078729bfa31084cb73c891c468e940cdb6bff067 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 22:43:52 +0100 Subject: [PATCH 029/107] using dependent state --- src/homogenization_RGC.f90 | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 1fb26b1e8..cdb0ed1bc 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -68,12 +68,6 @@ module homogenization_RGC type(tRGCstate), dimension(:), allocatable, private :: state type(tRGCdependentState), dimension(:), allocatable, private :: dependentState - -! START: Could be improved - real(pReal), dimension(:,:,:,:), allocatable, private :: & - homogenization_RGC_orientation -! END: Could be improved - public :: & homogenization_RGC_init, & homogenization_RGC_partitionDeformation, & @@ -131,7 +125,7 @@ subroutine homogenization_RGC_init() outputSize, & instance, & sizeHState, nIntFaceTot - integer(pInt) :: maxNinstance, i,j,e, mySize + integer(pInt) :: maxNinstance, i,j,e, mySize, of character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID !< ID of each post result output @@ -161,7 +155,6 @@ subroutine homogenization_RGC_init() homogenization_RGC_output='' allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),maxNinstance),& source=0_pInt) - allocate(homogenization_RGC_orientation(3,3,mesh_NipsPerElem,mesh_NcpElems), source=0.0_pReal) do h = 1_pInt, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle @@ -248,16 +241,17 @@ subroutine homogenization_RGC_init() ! * assigning cluster orientations elementLooping: do e = 1_pInt,mesh_NcpElems if (homogenization_typeInstance(mesh_homogenizationAt(e)) == instance) then + of = mappingHomogenization(1,1,e) noOrientationGiven: if (all (prm%angles >= 399.9_pReal)) then - homogenization_RGC_orientation(1:3,1:3,1,e) = math_EulerToR(math_sampleRandomOri()) + dependentState(instance)%orientation(1:3,1:3,of) = math_EulerToR(math_sampleRandomOri()) do i = 2_pInt,mesh_NipsPerElem - homogenization_RGC_orientation(1:3,1:3,i,e) = merge(homogenization_RGC_orientation(1:3,1:3,1,e), & + dependentState(instance)%orientation(1:3,1:3,of) = merge(dependentState(instance)%orientation(1:3,1:3,of), & math_EulerToR(math_sampleRandomOri()), & microstructure_elemhomo(mesh_microstructureAt(e))) enddo else noOrientationGiven do i = 1_pInt,mesh_NipsPerElem - homogenization_RGC_orientation(1:3,1:3,i,e) = math_EulerToR(prm%angles*inRad) + dependentState(instance)%orientation(1:3,1:3,of) = math_EulerToR(prm%angles*inRad) enddo endif noOrientationGiven endif @@ -1237,6 +1231,8 @@ end function relaxationVector function interfaceNormal(intFace,ip,el) use math, only: & math_mul33x3 + use material, only: & + mappingHomogenization implicit none real(pReal), dimension (3) :: interfaceNormal @@ -1244,7 +1240,7 @@ function interfaceNormal(intFace,ip,el) integer(pInt), intent(in) :: & ip, & !< integration point number el !< element number - integer(pInt) :: nPos + integer(pInt) :: nPos,instance,of !-------------------------------------------------------------------------------------------------- ! get the normal of the interface, identified from the value of intFace(1) @@ -1252,8 +1248,10 @@ function interfaceNormal(intFace,ip,el) nPos = abs(intFace(1)) ! identify the position of the interface in global state array interfaceNormal(nPos) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis + of = mappingHomogenization(1,ip,el) + instance = mappingHomogenization(2,ip,el) interfaceNormal = & - math_mul33x3(homogenization_RGC_orientation(1:3,1:3,ip,el),interfaceNormal) + math_mul33x3(dependentState(instance)%orientation(1:3,1:3,of),interfaceNormal) ! map the normal vector into sample coordinate system (basis) end function interfaceNormal From 8127d85be182a58368a2ec4a08a5b23c74480c14 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 23:13:20 +0100 Subject: [PATCH 030/107] simplifying --- src/homogenization_RGC.f90 | 128 +++++++++++++++++++------------------ 1 file changed, 65 insertions(+), 63 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index cdb0ed1bc..78285d33a 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -56,6 +56,7 @@ module homogenization_RGC relaxationRate_avg, & relaxationRate_max real(pReal), pointer, dimension(:,:) :: & + relaxationVector, & mismatch end type tRGCstate @@ -227,12 +228,13 @@ subroutine homogenization_RGC_init() allocate(homogState(h)%subState0(sizeHState,NofMyHomog), source=0.0_pReal) allocate(homogState(h)%state (sizeHState,NofMyHomog), source=0.0_pReal) - state(instance)%work =>homogState(h)%state(nIntFaceTot+1,:) - state(instance)%mismatch =>homogState(h)%state(nIntFaceTot+2:nIntFaceTot+4,:) - state(instance)%penaltyEnergy =>homogState(h)%state(nIntFaceTot+5,:) - state(instance)%volumeDiscrepancy =>homogState(h)%state(nIntFaceTot+6,:) - state(instance)%relaxationRate_avg =>homogState(h)%state(nIntFaceTot+7,:) - state(instance)%relaxationRate_max =>homogState(h)%state(nIntFaceTot+8,:) + state(instance)%relaxationVector => homogState(h)%state(1:nIntFaceTot,:) + state(instance)%work => homogState(h)%state(nIntFaceTot+1,:) + state(instance)%mismatch => homogState(h)%state(nIntFaceTot+2:nIntFaceTot+4,:) + state(instance)%penaltyEnergy => homogState(h)%state(nIntFaceTot+5,:) + state(instance)%volumeDiscrepancy => homogState(h)%state(nIntFaceTot+6,:) + state(instance)%relaxationRate_avg => homogState(h)%state(nIntFaceTot+7,:) + state(instance)%relaxationRate_max => homogState(h)%state(nIntFaceTot+8,:) allocate(dependentState(instance)%orientation(3,3,NofMyHomog)) @@ -241,16 +243,18 @@ subroutine homogenization_RGC_init() ! * assigning cluster orientations elementLooping: do e = 1_pInt,mesh_NcpElems if (homogenization_typeInstance(mesh_homogenizationAt(e)) == instance) then - of = mappingHomogenization(1,1,e) noOrientationGiven: if (all (prm%angles >= 399.9_pReal)) then + of = mappingHomogenization(1,1,e) dependentState(instance)%orientation(1:3,1:3,of) = math_EulerToR(math_sampleRandomOri()) do i = 2_pInt,mesh_NipsPerElem + of = mappingHomogenization(1,i,e) dependentState(instance)%orientation(1:3,1:3,of) = merge(dependentState(instance)%orientation(1:3,1:3,of), & math_EulerToR(math_sampleRandomOri()), & microstructure_elemhomo(mesh_microstructureAt(e))) enddo else noOrientationGiven do i = 1_pInt,mesh_NipsPerElem + of = mappingHomogenization(1,i,e) dependentState(instance)%orientation(1:3,1:3,of) = math_EulerToR(prm%angles*inRad) enddo endif noOrientationGiven @@ -273,6 +277,7 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,ip,el) use mesh, only: & mesh_homogenizationAt use material, only: & + mappingHomogenization, & homogenization_maxNgrains, & homogenization_Ngrains,& homogenization_typeInstance @@ -286,18 +291,21 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,ip,el) real(pReal), dimension (3) :: aVect,nVect integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3 - integer(pInt) :: instance, iGrain,iFace,i,j + integer(pInt) :: instance, iGrain,iFace,i,j,of + type(tParameters) :: prm !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations instance = homogenization_typeInstance(mesh_homogenizationAt(el)) + of = mappingHomogenization(1,ip,el) + associate(prm => param(instance)) F = 0.0_pReal do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) iGrain3 = grain1to3(iGrain,instance) do iFace = 1_pInt,6_pInt - intFace = getInterface(iFace,iGrain3) ! identifying 6 interfaces of each grain - aVect = relaxationVector(intFace,instance, ip, el) ! get the relaxation vectors for each interface from global relaxation vector array - nVect = interfaceNormal(intFace,ip,el) ! get the normal of each interface + intFace = getInterface(iFace,iGrain3) ! identifying 6 interfaces of each grain + aVect = relaxationVector(intFace,instance,of) ! get the relaxation vectors for each interface from global relaxation vector array + nVect = interfaceNormal(intFace,instance,of) forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! calculating deformation relaxations due to interface relaxation enddo @@ -317,6 +325,7 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,ip,el) endif enddo + end associate end subroutine homogenization_RGC_partitionDeformation @@ -451,7 +460,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) iGrN = grain3to1(iGr3N,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceN = getInterface(2_pInt*faceID(1),iGr3N) - normN = interfaceNormal(intFaceN,ip,el) ! get the interface normal + normN = interfaceNormal(intFaceN,instance,of) !-------------------------------------------------------------------------------------------------- ! identify the right/up/front grain (+|P) @@ -459,7 +468,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate system (3-dimensional index) iGrP = grain3to1(iGr3P,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) - normP = interfaceNormal(intFaceP,ip,el) ! get the interface normal + normP = interfaceNormal(intFaceP,instance,of) !-------------------------------------------------------------------------------------------------- ! compute the residual of traction at the interface (in local system, 4-dimensional index) @@ -598,10 +607,10 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate sytem iGrN = grain3to1(iGr3N,instance) ! translate into global grain ID intFaceN = getInterface(2_pInt*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system - normN = interfaceNormal(intFaceN,ip,el) ! get the interface normal + normN = interfaceNormal(intFaceN,instance,of) do iFace = 1_pInt,6_pInt intFaceN = getInterface(iFace,iGr3N) ! identifying all interfaces that influence relaxation of the above interface - mornN = interfaceNormal(intFaceN,ip,el) ! get normal of the interfaces + mornN = interfaceNormal(intFaceN,instance,of) iMun = interface4to1(intFaceN,instance) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0) then ! get the corresponding tangent do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt @@ -618,10 +627,10 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate sytem iGrP = grain3to1(iGr3P,instance) ! translate into global grain ID intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the connecting interface in local coordinate system - normP = interfaceNormal(intFaceP,ip,el) ! get the interface normal + normP = interfaceNormal(intFaceP,instance,of) do iFace = 1_pInt,6_pInt intFaceP = getInterface(iFace,iGr3P) ! identifying all interfaces that influence relaxation of the above interface - mornP = interfaceNormal(intFaceP,ip,el) ! get normal of the interfaces + mornP = interfaceNormal(intFaceP,instance,of) iMun = interface4to1(intFaceP,instance) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0_pInt) then ! get the corresponding tangent do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt @@ -669,7 +678,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) iGrN = grain3to1(iGr3N,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceN = getInterface(2_pInt*faceID(1),iGr3N) ! identifying the interface ID of the grain - normN = interfaceNormal(intFaceN,ip,el) ! get the corresponding interface normal + normN = interfaceNormal(intFaceN,instance,of) !-------------------------------------------------------------------------------------------------- ! identify the right/up/front grain (+|P) @@ -677,7 +686,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate system (3-dimensional index) iGrP = grain3to1(iGr3P,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the interface ID of the grain - normP = interfaceNormal(intFaceP,ip,el) ! get the corresponding normal + normP = interfaceNormal(intFaceP,instance,of) !-------------------------------------------------------------------------------------------------- ! compute the residual stress (contribution of mismatch and volume penalties) from perturbed state @@ -810,8 +819,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) use math, only: & math_civita use material, only: & - homogenization_maxNgrains,& - homogenization_Ngrains + homogenization_maxNgrains use numerics, only: & xSmoo_RGC @@ -826,7 +834,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) real(pReal), dimension (3,3) :: gDef,nDef real(pReal), dimension (3) :: nVect,surfCorr real(pReal), dimension (2) :: Gmoduli - integer(pInt) :: iGrain,iGNghb,iFace,i,j,k,l + integer(pInt) :: iGrain,iGNghb,iFace,i,j,k,l,of real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb type(tParameters) :: prm @@ -839,8 +847,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! get the correction factor the modulus of penalty stress representing the evolution of area of ! the interfaces due to deformations - surfCorr = surfaceCorrection(avgF,ip,el) - + + of = mappingHomogenization(1,ip,el) + surfCorr = surfaceCorrection(avgF,instance,of) associate(prm => param(instance)) !-------------------------------------------------------------------------------------------------- ! debugging the surface correction factor @@ -854,7 +863,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! computing the mismatch and penalty stress tensor of all grains - do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) + do iGrain = 1_pInt,product(param(instance)%Nconstituents) Gmoduli = equivalentModuli(iGrain,ip,el) muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector @@ -863,7 +872,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !* Looping over all six interfaces of each grain do iFace = 1_pInt,6_pInt intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain - nVect = interfaceNormal(intFace,ip,el) ! get the interface normal + nVect = interfaceNormal(intFace,instance,of) iGNghb3 = iGrain3 ! identify the neighboring grain across the interface iGNghb3(abs(intFace(1))) = iGNghb3(abs(intFace(1))) & + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal),pInt) @@ -1004,7 +1013,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !> @brief compute the correction factor accouted for surface evolution (area change) due to ! deformation !-------------------------------------------------------------------------------------------------- - function surfaceCorrection(avgF,ip,el) + function surfaceCorrection(avgF,instance,of) use math, only: & math_invert33, & math_mul33x33 @@ -1012,8 +1021,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) implicit none real(pReal), dimension(3) :: surfaceCorrection real(pReal), dimension(3,3), intent(in) :: avgF !< average F - integer(pInt), intent(in) :: ip,& !< integration point number - el !< element number + integer(pInt), intent(in) :: & + instance, & + of real(pReal), dimension(3,3) :: invC real(pReal), dimension(3) :: nVect real(pReal) :: detF @@ -1024,7 +1034,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) surfaceCorrection = 0.0_pReal do iBase = 1_pInt,3_pInt - nVect = interfaceNormal([iBase,1_pInt,1_pInt,1_pInt],ip,el) ! get the normal of the interface + nVect = interfaceNormal([iBase,1_pInt,1_pInt,1_pInt],instance,of) do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt surfaceCorrection(iBase) = surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j) ! compute the component of (the inverse of) the stretch in the direction of the normal enddo; enddo @@ -1090,24 +1100,25 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) real(pReal), dimension (3) :: aVect,nVect integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3 - integer(pInt) :: instance, iGrain,iFace,i,j + integer(pInt) :: instance, iGrain,iFace,i,j,of - !-------------------------------------------------------------------------------------------------- - ! compute the deformation gradient of individual grains due to relaxations + !-------------------------------------------------------------------------------------------------- + ! compute the deformation gradient of individual grains due to relaxations instance = homogenization_typeInstance(mesh_homogenizationAt(el)) - F = 0.0_pReal - do iGrain = 1_pInt,product(param(instance)%Nconstituents) - iGrain3 = grain1to3(iGrain,instance) - do iFace = 1_pInt,6_pInt - intFace = getInterface(iFace,iGrain3) - aVect = relaxationVector(intFace,instance, ip, el) - nVect = interfaceNormal(intFace,ip,el) - forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & - F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! effective relaxations - enddo - F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! relaxed deformation gradient - enddo - + of = mappingHomogenization(1,ip,el) + F = 0.0_pReal + do iGrain = 1_pInt,product(param(instance)%Nconstituents) + iGrain3 = grain1to3(iGrain,instance) + do iFace = 1_pInt,6_pInt + intFace = getInterface(iFace,iGrain3) + aVect = relaxationVector(intFace,instance,of) + nVect = interfaceNormal(intFace,ip,el) + forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & + F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! effective relaxations + enddo + F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! relaxed deformation gradient + enddo + end subroutine grainDeformation end function homogenization_RGC_updateState @@ -1202,25 +1213,20 @@ end function homogenization_RGC_postResults !-------------------------------------------------------------------------------------------------- !> @brief collect relaxation vectors of an interface !-------------------------------------------------------------------------------------------------- -function relaxationVector(intFace,instance, ip, el) - use material, only: & - homogState, & - mappingHomogenization +function relaxationVector(intFace,instance,of) implicit none - integer(pInt), intent(in) :: ip, el + integer(pInt), intent(in) :: instance,of real(pReal), dimension (3) :: relaxationVector integer(pInt), dimension (4), intent(in) :: intFace !< set of interface ID in 4D array (normal and position) integer(pInt) :: & - iNum, & - instance !< homogenization ID + iNum !-------------------------------------------------------------------------------------------------- ! collect the interface relaxation vector from the global state array relaxationVector = 0.0_pReal iNum = interface4to1(intFace,instance) ! identify the position of the interface in global state array - if (iNum > 0_pInt) relaxationVector = homogState(mappingHomogenization(2,ip,el))% & - state((3*iNum-2):(3*iNum),mappingHomogenization(1,ip,el)) ! get the corresponding entries + if (iNum > 0_pInt) relaxationVector = state(instance)%relaxationVector((3*iNum-2):(3*iNum),of) end function relaxationVector @@ -1228,19 +1234,17 @@ end function relaxationVector !-------------------------------------------------------------------------------------------------- !> @brief identify the normal of an interface !-------------------------------------------------------------------------------------------------- -function interfaceNormal(intFace,ip,el) +function interfaceNormal(intFace,instance,of) use math, only: & math_mul33x3 - use material, only: & - mappingHomogenization implicit none real(pReal), dimension (3) :: interfaceNormal integer(pInt), dimension (4), intent(in) :: intFace !< interface ID in 4D array (normal and position) integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - integer(pInt) :: nPos,instance,of + instance, & + of + integer(pInt) :: nPos !-------------------------------------------------------------------------------------------------- ! get the normal of the interface, identified from the value of intFace(1) @@ -1248,8 +1252,6 @@ function interfaceNormal(intFace,ip,el) nPos = abs(intFace(1)) ! identify the position of the interface in global state array interfaceNormal(nPos) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis - of = mappingHomogenization(1,ip,el) - instance = mappingHomogenization(2,ip,el) interfaceNormal = & math_mul33x3(dependentState(instance)%orientation(1:3,1:3,of),interfaceNormal) ! map the normal vector into sample coordinate system (basis) From 3c11905f635118bb25ee8d9a6e2aa30bdac5685d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Nov 2018 23:23:52 +0100 Subject: [PATCH 031/107] cleaning --- src/homogenization.f90 | 5 +- src/homogenization_RGC.f90 | 103 +++++++++++++------------------------ 2 files changed, 41 insertions(+), 67 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 708e72fa8..9e40150d9 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -911,6 +911,7 @@ subroutine homogenization_partitionDeformation(ip,el) use mesh, only: & mesh_element use material, only: & + mappingHomogenization, & homogenization_type, & homogenization_maxNgrains, & homogenization_typeInstance, & @@ -929,7 +930,7 @@ subroutine homogenization_partitionDeformation(ip,el) ip, & !< integration point el !< element number integer(pInt) :: & - instance + instance, of chosenHomogenization: select case(homogenization_type(mesh_element(3,el))) @@ -946,6 +947,8 @@ subroutine homogenization_partitionDeformation(ip,el) instance) case (HOMOGENIZATION_RGC_ID) chosenHomogenization + instance = homogenization_typeInstance(mesh_element(3,el)) + of = mappingHomogenization(1,ip,el) call homogenization_RGC_partitionDeformation(& crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), & materialpoint_subF(1:3,1:3,ip,el),& diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 78285d33a..bf136d36e 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -269,38 +269,31 @@ end subroutine homogenization_RGC_init !-------------------------------------------------------------------------------------------------- !> @brief partitions the deformation gradient onto the constituents !-------------------------------------------------------------------------------------------------- -subroutine homogenization_RGC_partitionDeformation(F,avgF,ip,el) +subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) use debug, only: & debug_level, & debug_homogenization, & debug_levelExtensive - use mesh, only: & - mesh_homogenizationAt use material, only: & - mappingHomogenization, & - homogenization_maxNgrains, & - homogenization_Ngrains,& - homogenization_typeInstance + homogenization_maxNgrains implicit none real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned F per grain real(pReal), dimension (3,3), intent(in) :: avgF !< averaged F integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number + instance, & + of !< element number real(pReal), dimension (3) :: aVect,nVect integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3 - integer(pInt) :: instance, iGrain,iFace,i,j,of + integer(pInt) :: iGrain,iFace,i,j type(tParameters) :: prm !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations - instance = homogenization_typeInstance(mesh_homogenizationAt(el)) - of = mappingHomogenization(1,ip,el) associate(prm => param(instance)) F = 0.0_pReal - do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) + do iGrain = 1_pInt,product(prm%Nconstituents) iGrain3 = grain1to3(iGrain,instance) do iFace = 1_pInt,6_pInt intFace = getInterface(iFace,iGrain3) ! identifying 6 interfaces of each grain @@ -532,20 +525,16 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! compute/update the state for postResult, i.e., all energy densities computed by time-integration - do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) ! time-integration loop for the calculating the work and energy - do i = 1_pInt,3_pInt - do j = 1_pInt,3_pInt + do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) ! time-integration loop for work and energy + do i = 1_pInt,3_pInt;do j = 1_pInt,3_pInt state(instance)%work(of) = state(instance)%work(of) & + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) state(instance)%penaltyEnergy(of) = state(instance)%penaltyEnergy(of) & + R(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) - enddo - enddo + enddo; enddo enddo - state(instance)%mismatch(1,of) = sum(NN(1,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e1-direction - state(instance)%mismatch(2,of) = sum(NN(2,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e2-direction - state(instance)%mismatch(3,of) = sum(NN(3,:))/real(nGrain,pReal) ! the overall mismatch of all interface normal to e3-direction + state(instance)%mismatch(1:3,of) = sum(NN,2)/real(nGrain,pReal) ! the overall mismatch of all interface normals state(instance)%volumeDiscrepancy(of) = volDiscrep state(instance)%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) state(instance)%relaxationRate_max(of) = maxval(abs(drelax))/dt @@ -614,7 +603,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iMun = interface4to1(intFaceN,instance) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0) then ! get the corresponding tangent do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt - smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) + dPdF(i,k,j,l,iGrN)*normN(k)*mornN(l) + smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) & + + dPdF(i,k,j,l,iGrN)*normN(k)*mornN(l) enddo;enddo;enddo;enddo ! projecting the material tangent dPdF into the interface ! to obtain the Jacobian matrix contribution of dPdF @@ -839,6 +829,10 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) type(tParameters) :: prm real(pReal), parameter :: nDefToler = 1.0e-10_pReal + logical :: debugActive + + debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip nGDim = param(instance)%Nconstituents rPen = 0.0_pReal @@ -851,14 +845,10 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) of = mappingHomogenization(1,ip,el) surfCorr = surfaceCorrection(avgF,instance,of) associate(prm => param(instance)) - !-------------------------------------------------------------------------------------------------- - ! debugging the surface correction factor - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) - write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el - write(6,'(1x,3(e11.4,1x))')(surfCorr(i), i = 1,3) - !$OMP END CRITICAL (write2out) + + if (debugActive) then + write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el + write(6,*) surfCorr endif !-------------------------------------------------------------------------------------------------- @@ -892,22 +882,15 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt nDef(i,j) = nDef(i,j) - nVect(k)*gDef(i,l)*math_civita(j,k,l) ! compute the interface mismatch tensor from the jump of deformation gradient enddo; enddo - nDefNorm = nDefNorm + nDef(i,j)*nDef(i,j) ! compute the norm of the mismatch tensor + nDefNorm = nDefNorm + nDef(i,j)**2.0_pReal ! compute the norm of the mismatch tensor enddo; enddo nDefNorm = max(nDefToler,sqrt(nDefNorm)) ! approximation to zero mismatch if mismatch is zero (singularity) nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm ! total amount of mismatch experienced by the grain (at all six interfaces) - !-------------------------------------------------------------------------------------------------- - ! debuggin the mismatch tensor - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) + if (debugActive) then write(6,'(1x,a20,i2,1x,a20,1x,i3)')'Mismatch to face: ',intFace(1),'neighbor grain: ',iGNghb - do i = 1,3 - write(6,'(1x,3(e11.4,1x))')(nDef(i,j), j = 1,3) - enddo - write(6,'(1x,a20,e11.4)')'with magnitude: ',nDefNorm - !$OMP END CRITICAL (write2out) + write(6,*) transpose(nDef) + write(6,'(1x,a20,e11.4)')'with magnitude: ',nDefNorm endif !-------------------------------------------------------------------------------------------------- @@ -923,16 +906,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) enddo; enddo enddo - !-------------------------------------------------------------------------------------------------- - ! debugging the stress-like penalty - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) - write(6,'(1x,a20,i2)')'Penalty of grain: ',iGrain - do i = 1,3 - write(6,'(1x,3(e11.4,1x))')(rPen(i,j,iGrain), j = 1,3) - enddo - !$OMP END CRITICAL (write2out) + if (debugActive) then + write(6,'(1x,a20,i2)')'Penalty of grain: ',iGrain + write(6,*) transpose(rPen(1:3,1:3,iGrain)) endif enddo @@ -972,10 +948,14 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) integer(pInt), intent(in) :: ip,& ! integration point el real(pReal), dimension (homogenization_maxNgrains) :: gVol - integer(pInt) :: iGrain,nGrain,i,j - + integer(pInt) :: iGrain,nGrain + logical :: debugActive + + debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. debug_e == el .and. debug_i == ip + nGrain = homogenization_Ngrains(mesh_homogenizationAt(el)) - + !-------------------------------------------------------------------------------------------------- ! compute the volumes of grains and of cluster vDiscrep = math_det33(fAvg) ! compute the volume of the cluster @@ -993,16 +973,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) sign((abs(vDiscrep)/maxVolDiscr_RGC)**(volDiscrPow_RGC - 1.0),vDiscrep)* & gVol(iGrain)*transpose(math_inv33(fDef(:,:,iGrain))) - !-------------------------------------------------------------------------------------------------- - ! debugging the stress-like penalty - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) + if (debugActive) then write(6,'(1x,a30,i2)')'Volume penalty of grain: ',iGrain - do i = 1,3 - write(6,'(1x,3(e11.4,1x))')(vPen(i,j,iGrain), j = 1,3) - enddo - !$OMP END CRITICAL (write2out) + write(6,*) transpose(vPen(:,:,iGrain)) endif enddo @@ -1252,9 +1225,7 @@ function interfaceNormal(intFace,instance,of) nPos = abs(intFace(1)) ! identify the position of the interface in global state array interfaceNormal(nPos) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis - interfaceNormal = & - math_mul33x3(dependentState(instance)%orientation(1:3,1:3,of),interfaceNormal) - ! map the normal vector into sample coordinate system (basis) + interfaceNormal = math_mul33x3(dependentState(instance)%orientation(1:3,1:3,of),interfaceNormal) ! map the normal vector into sample coordinate system (basis) end function interfaceNormal From f471911e018de0443121e4b6589e5eab88b55c97 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 4 Nov 2018 07:27:25 +0100 Subject: [PATCH 032/107] fixed array out of bounds during initialization happened for inactive homogenization --- src/homogenization_RGC.f90 | 43 +++++++++++++++++--------------------- 1 file changed, 19 insertions(+), 24 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index bf136d36e..ad217bed2 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -242,7 +242,7 @@ subroutine homogenization_RGC_init() !-------------------------------------------------------------------------------------------------- ! * assigning cluster orientations elementLooping: do e = 1_pInt,mesh_NcpElems - if (homogenization_typeInstance(mesh_homogenizationAt(e)) == instance) then + if (homogenization_typeInstance(mesh_homogenizationAt(e)) == instance .and. NofMyHomog > 0_pInt) then noOrientationGiven: if (all (prm%angles >= 399.9_pReal)) then of = mappingHomogenization(1,1,e) dependentState(instance)%orientation(1:3,1:3,of) = math_EulerToR(math_sampleRandomOri()) @@ -653,7 +653,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) p_relax = relax p_relax(ipert) = relax(ipert) + pPert_RGC ! perturb the relaxation vector homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,of) = p_relax - call grainDeformation(pF,avgF,ip,el) ! compute the grains deformation from perturbed state + call grainDeformation(pF,avgF,instance,of) ! compute the grains deformation from perturbed state call stressPenalty(pR,pNN,avgF,pF,ip,el,instance) ! compute stress penalty due to interface mismatch from perturbed state call volumePenalty(pD,volDiscrep,pF,avgF,ip,el) ! compute stress penalty due to volume discrepancy from perturbed state @@ -1057,40 +1057,35 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !> @brief calculating the grain deformation gradient (the same with ! homogenization_RGC_partionDeformation, but used only for perturbation scheme) !-------------------------------------------------------------------------------------------------- - subroutine grainDeformation(F, avgF, ip, el) - use mesh, only: & - mesh_homogenizationAt + subroutine grainDeformation(F, avgF, instance, of) use material, only: & - homogenization_maxNgrains,& - homogenization_typeInstance + homogenization_maxNgrains implicit none real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned F per grain real(pReal), dimension (3,3), intent(in) :: avgF !< integer(pInt), intent(in) :: & - el, & !< element number - ip !< integration point number + instance, & + of real(pReal), dimension (3) :: aVect,nVect integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3 - integer(pInt) :: instance, iGrain,iFace,i,j,of + integer(pInt) :: iGrain,iFace,i,j !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations - instance = homogenization_typeInstance(mesh_homogenizationAt(el)) - of = mappingHomogenization(1,ip,el) - F = 0.0_pReal - do iGrain = 1_pInt,product(param(instance)%Nconstituents) - iGrain3 = grain1to3(iGrain,instance) - do iFace = 1_pInt,6_pInt - intFace = getInterface(iFace,iGrain3) - aVect = relaxationVector(intFace,instance,of) - nVect = interfaceNormal(intFace,ip,el) - forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & - F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! effective relaxations - enddo - F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! relaxed deformation gradient - enddo + F = 0.0_pReal + do iGrain = 1_pInt,product(param(instance)%Nconstituents) + iGrain3 = grain1to3(iGrain,instance) + do iFace = 1_pInt,6_pInt + intFace = getInterface(iFace,iGrain3) + aVect = relaxationVector(intFace,instance,of) + nVect = interfaceNormal(intFace,instance,of) + forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) & + F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! effective relaxations + enddo + F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! relaxed deformation gradient + enddo end subroutine grainDeformation From 4dc3761feadf82ac4511765b7de44620830c4878 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 4 Nov 2018 07:29:39 +0100 Subject: [PATCH 033/107] setting of (random) cluster orientations remove can be easily done in a pre processing step --- src/homogenization_RGC.f90 | 20 ++++---------------- 1 file changed, 4 insertions(+), 16 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index ad217bed2..502baf380 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -168,8 +168,7 @@ subroutine homogenization_RGC_init() prm%xiAlpha = config_homogenization(h)%getFloat('scalingparameter') prm%ciAlpha = config_homogenization(h)%getFloat('overproportionality') prm%dAlpha = config_homogenization(h)%getFloats('grainsize',requiredShape=[3]) - prm%angles = config_homogenization(h)%getFloats('clusterorientation',requiredShape=[3],& - defaultVal=[400.0_pReal,400.0_pReal,400.0_pReal]) + prm%angles = config_homogenization(h)%getFloats('clusterorientation',requiredShape=[3]) outputs = config_homogenization(h)%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) @@ -243,21 +242,10 @@ subroutine homogenization_RGC_init() ! * assigning cluster orientations elementLooping: do e = 1_pInt,mesh_NcpElems if (homogenization_typeInstance(mesh_homogenizationAt(e)) == instance .and. NofMyHomog > 0_pInt) then - noOrientationGiven: if (all (prm%angles >= 399.9_pReal)) then - of = mappingHomogenization(1,1,e) - dependentState(instance)%orientation(1:3,1:3,of) = math_EulerToR(math_sampleRandomOri()) - do i = 2_pInt,mesh_NipsPerElem + do i = 1_pInt,mesh_NipsPerElem of = mappingHomogenization(1,i,e) - dependentState(instance)%orientation(1:3,1:3,of) = merge(dependentState(instance)%orientation(1:3,1:3,of), & - math_EulerToR(math_sampleRandomOri()), & - microstructure_elemhomo(mesh_microstructureAt(e))) - enddo - else noOrientationGiven - do i = 1_pInt,mesh_NipsPerElem - of = mappingHomogenization(1,i,e) - dependentState(instance)%orientation(1:3,1:3,of) = math_EulerToR(prm%angles*inRad) - enddo - endif noOrientationGiven + dependentState(instance)%orientation(1:3,1:3,of) = math_EulerToR(prm%angles*inRad) + enddo endif enddo elementLooping end associate From 572576cf88cfcc90c5d730b5e732b0a73030dcd1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 4 Nov 2018 07:33:57 +0100 Subject: [PATCH 034/107] these functions have no side effects --- src/homogenization_RGC.f90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 502baf380..2495750a4 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -1169,7 +1169,7 @@ end function homogenization_RGC_postResults !-------------------------------------------------------------------------------------------------- !> @brief collect relaxation vectors of an interface !-------------------------------------------------------------------------------------------------- -function relaxationVector(intFace,instance,of) +pure function relaxationVector(intFace,instance,of) implicit none integer(pInt), intent(in) :: instance,of @@ -1190,7 +1190,7 @@ end function relaxationVector !-------------------------------------------------------------------------------------------------- !> @brief identify the normal of an interface !-------------------------------------------------------------------------------------------------- -function interfaceNormal(intFace,instance,of) +pure function interfaceNormal(intFace,instance,of) use math, only: & math_mul33x3 @@ -1216,7 +1216,7 @@ end function interfaceNormal !-------------------------------------------------------------------------------------------------- !> @brief collect six faces of a grain in 4D (normal and position) !-------------------------------------------------------------------------------------------------- -function getInterface(iFace,iGrain3) +pure function getInterface(iFace,iGrain3) implicit none integer(pInt), dimension (4) :: getInterface @@ -1231,15 +1231,14 @@ function getInterface(iFace,iGrain3) !-------------------------------------------------------------------------------------------------- ! identify the interface position by the direction of its normal getInterface(2:4) = iGrain3 - if (iDir < 0_pInt) & ! to have a correlation with coordinate/position in real space - getInterface(1_pInt-iDir) = getInterface(1_pInt-iDir)-1_pInt + if (iDir < 0_pInt) getInterface(1_pInt-iDir) = getInterface(1_pInt-iDir)-1_pInt ! to have a correlation with coordinate/position in real space end function getInterface !-------------------------------------------------------------------------------------------------- !> @brief map grain ID from in 1D (global array) to in 3D (local position) !-------------------------------------------------------------------------------------------------- -function grain1to3(grain1,instance) +pure function grain1to3(grain1,instance) implicit none integer(pInt), dimension (3) :: grain1to3 From ff2b693f1eb841be7f978e7e7adb8ed5befae5b3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 4 Nov 2018 07:56:27 +0100 Subject: [PATCH 035/107] simplified --- src/homogenization_RGC.f90 | 59 +++++++++++++------------------------- 1 file changed, 20 insertions(+), 39 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 2495750a4..de36df323 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -588,7 +588,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) do iFace = 1_pInt,6_pInt intFaceN = getInterface(iFace,iGr3N) ! identifying all interfaces that influence relaxation of the above interface mornN = interfaceNormal(intFaceN,instance,of) - iMun = interface4to1(intFaceN,instance) ! translate the interfaces ID into local 4-dimensional index + iMun = interface4to1(intFaceN,param(instance)%Nconstituents) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0) then ! get the corresponding tangent do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) & @@ -609,7 +609,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) do iFace = 1_pInt,6_pInt intFaceP = getInterface(iFace,iGr3P) ! identifying all interfaces that influence relaxation of the above interface mornP = interfaceNormal(intFaceP,instance,of) - iMun = interface4to1(intFaceP,instance) ! translate the interfaces ID into local 4-dimensional index + iMun = interface4to1(intFaceP,param(instance)%Nconstituents) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0_pInt) then ! get the corresponding tangent do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) + dPdF(i,k,j,l,iGrP)*normP(k)*mornP(l) @@ -1109,56 +1109,43 @@ pure function homogenization_RGC_postResults(ip,el) result(postResults) use material, only: & homogenization_typeInstance,& homogState, & - mappingHomogenization, & - homogenization_Noutput + mappingHomogenization implicit none integer(pInt), intent(in) :: & ip, & !< integration point number el !< element number - integer(pInt) instance,o,c,nIntFaceTot + integer(pInt) instance,o,c,of type(tParameters) :: prm real(pReal), dimension(homogenization_RGC_sizePostResults(homogenization_typeInstance(mesh_homogenizationAt(el)))) :: & postResults instance = homogenization_typeInstance(mesh_homogenizationAt(el)) associate(prm => param(instance)) - nIntFaceTot=(prm%Nconstituents(1)-1_pInt)*prm%Nconstituents(2)* prm%Nconstituents(3)& - + prm%Nconstituents(1)* (prm%Nconstituents(2)-1_pInt)*prm%Nconstituents(3)& - + prm%Nconstituents(1)* prm%Nconstituents(2)* (prm%Nconstituents(3)-1_pInt) + of = mappingHomogenization(1,ip,el) c = 0_pInt postResults = 0.0_pReal outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) case (constitutivework_ID) - postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+1,mappingHomogenization(1,ip,el)) + postResults(c+1) = state(instance)%work(of) c = c + 1_pInt case (magnitudemismatch_ID) - postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+2,mappingHomogenization(1,ip,el)) - postResults(c+2) = homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+3,mappingHomogenization(1,ip,el)) - postResults(c+3) = homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+4,mappingHomogenization(1,ip,el)) + postResults(c+1:c+3) = state(instance)%mismatch(1:3,of) c = c + 3_pInt case (penaltyenergy_ID) - postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+5,mappingHomogenization(1,ip,el)) + postResults(c+1) = state(instance)%penaltyEnergy(of) c = c + 1_pInt case (volumediscrepancy_ID) - postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+6,mappingHomogenization(1,ip,el)) + postResults(c+1) = state(instance)%volumeDiscrepancy(of) c = c + 1_pInt case (averagerelaxrate_ID) - postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+7,mappingHomogenization(1,ip,el)) + postResults(c+1) = state(instance)%relaxationrate_avg(of) c = c + 1_pInt case (maximumrelaxrate_ID) - postResults(c+1) = homogState(mappingHomogenization(2,ip,el))% & - state(3*nIntFaceTot+8,mappingHomogenization(1,ip,el)) + postResults(c+1) = state(instance)%relaxationrate_max(of) c = c + 1_pInt end select enddo outputsLoop @@ -1181,7 +1168,7 @@ pure function relaxationVector(intFace,instance,of) !-------------------------------------------------------------------------------------------------- ! collect the interface relaxation vector from the global state array relaxationVector = 0.0_pReal - iNum = interface4to1(intFace,instance) ! identify the position of the interface in global state array + iNum = interface4to1(intFace,param(instance)%Nconstituents) ! identify the position of the interface in global state array if (iNum > 0_pInt) relaxationVector = state(instance)%relaxationVector((3*iNum-2):(3*iNum),of) end function relaxationVector @@ -1275,20 +1262,11 @@ end function grain3to1 !-------------------------------------------------------------------------------------------------- !> @brief maps interface ID from 4D (normal and local position) into 1D (global array) !-------------------------------------------------------------------------------------------------- -integer(pInt) pure function interface4to1(iFace4D, instance) +integer(pInt) pure function interface4to1(iFace4D, nGDim) implicit none - integer(pInt), dimension (4), intent(in) :: iFace4D !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z) - integer(pInt), intent(in) :: instance - integer(pInt), dimension (3) :: nGDim,nIntFace - - nGDim = param(instance)%Nconstituents - -!-------------------------------------------------------------------------------------------------- -! compute the total number of interfaces, which ... - nIntFace(1) = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) ! ... normal //e1 - nIntFace(2) = nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) ! ... normal //e2 - nIntFace(3) = nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) ! ... normal //e3 + integer(pInt), dimension(4), intent(in) :: iFace4D !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z) + integer(pInt), dimension(3), intent(in) :: nGDim interface4to1 = -1_pInt @@ -1300,11 +1278,14 @@ integer(pInt) pure function interface4to1(iFace4D, instance) if ((iFace4D(2) == 0_pInt) .or. (iFace4D(2) == nGDim(1))) interface4to1 = 0_pInt elseif (abs(iFace4D(1)) == 2_pInt) then ! interface with normal //e2 interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1_pInt) & - + nGDim(3)*nGDim(1)*(iFace4D(3)-1_pInt) + nIntFace(1) + + nGDim(3)*nGDim(1)*(iFace4D(3)-1_pInt) & + + (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) ! total number of interfaces normal //e1 if ((iFace4D(3) == 0_pInt) .or. (iFace4D(3) == nGDim(2))) interface4to1 = 0_pInt elseif (abs(iFace4D(1)) == 3_pInt) then ! interface with normal //e3 interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1_pInt) & - + nGDim(1)*nGDim(2)*(iFace4D(4)-1_pInt) + nIntFace(1) + nIntFace(2) + + nGDim(1)*nGDim(2)*(iFace4D(4)-1_pInt) & + + (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) & ! total number of interfaces normal //e1 + + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) ! total number of interfaces normal //e2 if ((iFace4D(4) == 0_pInt) .or. (iFace4D(4) == nGDim(3))) interface4to1 = 0_pInt endif From 78f4d4c5ee12891922dbe542da967865208a6020 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 4 Nov 2018 08:11:35 +0100 Subject: [PATCH 036/107] simplified --- src/homogenization_RGC.f90 | 66 ++++++++++++++++++-------------------- 1 file changed, 31 insertions(+), 35 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index de36df323..f1652f79b 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -282,7 +282,7 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) associate(prm => param(instance)) F = 0.0_pReal do iGrain = 1_pInt,product(prm%Nconstituents) - iGrain3 = grain1to3(iGrain,instance) + iGrain3 = grain1to3(iGrain,prm%Nconstituents) do iFace = 1_pInt,6_pInt intFace = getInterface(iFace,iGrain3) ! identifying 6 interfaces of each grain aVect = relaxationVector(intFace,instance,of) ! get the relaxation vectors for each interface from global relaxation vector array @@ -434,12 +434,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !------------------------------------------------------------------------------------------------ ! computing the residual stress from the balance of traction at all (interior) interfaces do iNum = 1_pInt,nIntFaceTot - faceID = interface1to4(iNum,instance) ! identifying the interface ID in local coordinate system (4-dimensional index) + faceID = interface1to4(iNum,param(instance)%Nconstituents) ! identifying the interface ID in local coordinate system (4-dimensional index) !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrN = grain3to1(iGr3N,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrN = grain3to1(iGr3N,param(instance)%Nconstituents) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceN = getInterface(2_pInt*faceID(1),iGr3N) normN = interfaceNormal(intFaceN,instance,of) @@ -447,7 +447,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrP = grain3to1(iGr3P,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrP = grain3to1(iGr3P,param(instance)%Nconstituents) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) normP = interfaceNormal(intFaceP,instance,of) @@ -577,12 +577,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! ... of the constitutive stress tangent, assembled from dPdF or material constitutive model "smatrix" allocate(smatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal) do iNum = 1_pInt,nIntFaceTot - faceID = interface1to4(iNum,instance) ! assembling of local dPdF into global Jacobian matrix + faceID = interface1to4(iNum,param(instance)%Nconstituents) ! assembling of local dPdF into global Jacobian matrix !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate sytem - iGrN = grain3to1(iGr3N,instance) ! translate into global grain ID + iGrN = grain3to1(iGr3N,param(instance)%Nconstituents) ! translate into global grain ID intFaceN = getInterface(2_pInt*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system normN = interfaceNormal(intFaceN,instance,of) do iFace = 1_pInt,6_pInt @@ -603,7 +603,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate sytem - iGrP = grain3to1(iGr3P,instance) ! translate into global grain ID + iGrP = grain3to1(iGr3P,param(instance)%Nconstituents) ! translate into global grain ID intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the connecting interface in local coordinate system normP = interfaceNormal(intFaceP,instance,of) do iFace = 1_pInt,6_pInt @@ -649,12 +649,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! computing the global stress residual array from the perturbed state p_resid = 0.0_pReal do iNum = 1_pInt,nIntFaceTot - faceID = interface1to4(iNum,instance) ! identifying the interface ID in local coordinate system (4-dimensional index) + faceID = interface1to4(iNum,param(instance)%Nconstituents) ! identifying the interface ID in local coordinate system (4-dimensional index) !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrN = grain3to1(iGr3N,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrN = grain3to1(iGr3N,param(instance)%Nconstituents) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceN = getInterface(2_pInt*faceID(1),iGr3N) ! identifying the interface ID of the grain normN = interfaceNormal(intFaceN,instance,of) @@ -662,7 +662,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrP = grain3to1(iGr3P,instance) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrP = grain3to1(iGr3P,param(instance)%Nconstituents) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the interface ID of the grain normP = interfaceNormal(intFaceP,instance,of) @@ -845,7 +845,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) Gmoduli = equivalentModuli(iGrain,ip,el) muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector - iGrain3 = grain1to3(iGrain,instance) ! get the grain ID in local 3-dimensional index (x,y,z)-position + iGrain3 = grain1to3(iGrain,prm%Nconstituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position !* Looping over all six interfaces of each grain do iFace = 1_pInt,6_pInt @@ -856,7 +856,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal),pInt) where(iGNghb3 < 1) iGNghb3 = nGDim where(iGNghb3 >nGDim) iGNghb3 = 1_pInt - iGNghb = grain3to1(iGNghb3,instance) ! get the ID of the neighboring grain + iGNghb = grain3to1(iGNghb3,prm%Nconstituents) ! get the ID of the neighboring grain Gmoduli = equivalentModuli(iGNghb,ip,el) ! collecting the shear modulus and Burgers vector of the neighbor muGNghb = Gmoduli(1) bgGNghb = Gmoduli(2) @@ -1013,12 +1013,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) constitutive_homogenizedC implicit none + real(pReal), dimension(2) :: equivalentModuli integer(pInt), intent(in) :: & grainID,& ip, & !< integration point number el !< element number - real(pReal), dimension (6,6) :: elasTens - real(pReal), dimension(2) :: equivalentModuli + real(pReal), dimension(6,6) :: elasTens real(pReal) :: & cEquiv_11, & cEquiv_12, & @@ -1064,7 +1064,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! compute the deformation gradient of individual grains due to relaxations F = 0.0_pReal do iGrain = 1_pInt,product(param(instance)%Nconstituents) - iGrain3 = grain1to3(iGrain,instance) + iGrain3 = grain1to3(iGrain,param(instance)%Nconstituents) do iFace = 1_pInt,6_pInt intFace = getInterface(iFace,iGrain3) aVect = relaxationVector(intFace,instance,of) @@ -1222,19 +1222,17 @@ pure function getInterface(iFace,iGrain3) end function getInterface + !-------------------------------------------------------------------------------------------------- !> @brief map grain ID from in 1D (global array) to in 3D (local position) !-------------------------------------------------------------------------------------------------- -pure function grain1to3(grain1,instance) +pure function grain1to3(grain1,nGDim) implicit none - integer(pInt), dimension (3) :: grain1to3 - integer(pInt), intent(in) :: & - grain1,& !< grain ID in 1D array - instance - integer(pInt), dimension (3) :: nGDim + integer(pInt), dimension(3) :: grain1to3 + integer(pInt), intent(in) :: grain1 !< grain ID in 1D array + integer(pInt), dimension(3), intent(in) :: nGDim - nGDim = param(instance)%Nconstituents grain1to3 = 1_pInt + [mod((grain1-1_pInt),nGDim(1)), & mod((grain1-1_pInt)/nGDim(1),nGDim(2)), & (grain1-1_pInt)/(nGDim(1)*nGDim(2))] @@ -1245,16 +1243,16 @@ end function grain1to3 !-------------------------------------------------------------------------------------------------- !> @brief map grain ID from in 3D (local position) to in 1D (global array) !-------------------------------------------------------------------------------------------------- -pure function grain3to1(grain3,instance) +pure function grain3to1(grain3,nGDim) implicit none - integer(pInt), dimension (3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z) - integer(pInt), intent(in) :: instance ! homogenization ID - integer(pInt) :: grain3to1 - integer(pInt), dimension (3) :: nGDim + integer(pInt) :: grain3to1 + integer(pInt), dimension(3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z) + integer(pInt), dimension(3), intent(in) :: nGDim - nGDim = param(instance)%Nconstituents - grain3to1 = grain3(1) + nGDim(1)*(grain3(2)-1_pInt) + nGDim(1)*nGDim(2)*(grain3(3)-1_pInt) + grain3to1 = grain3(1) & + + nGDim(1)*(grain3(2)-1_pInt) & + + nGDim(1)*nGDim(2)*(grain3(3)-1_pInt) end function grain3to1 @@ -1295,15 +1293,13 @@ end function interface4to1 !-------------------------------------------------------------------------------------------------- !> @brief maps interface ID from 1D (global array) into 4D (normal and local position) !-------------------------------------------------------------------------------------------------- -pure function interface1to4(iFace1D, instance) +pure function interface1to4(iFace1D, nGDim) implicit none - integer(pInt), dimension (4) :: interface1to4 + integer(pInt), dimension(4) :: interface1to4 integer(pInt), intent(in) :: iFace1D !< interface ID in 1D array - integer(pInt), intent(in) :: instance - integer(pInt), dimension (3) :: nGDim,nIntFace - - nGDim = param(instance)%Nconstituents + integer(pInt), dimension(3), intent(in) :: nGDim + integer(pInt), dimension (3) :: nIntFace !-------------------------------------------------------------------------------------------------- ! compute the total number of interfaces, which ... From 7a37ea25f3f1111c20883bd3488f42d7b5cc2422 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 4 Nov 2018 08:49:40 +0100 Subject: [PATCH 037/107] cleaning --- src/homogenization_RGC.f90 | 54 ++++++++++++++------------------ src/homogenization_isostrain.f90 | 11 +++---- src/homogenization_none.f90 | 7 ++--- 3 files changed, 30 insertions(+), 42 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index f1652f79b..04a0aff72 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -104,17 +104,12 @@ subroutine homogenization_RGC_init() debug_levelBasic, & debug_levelExtensive use math, only: & - math_Mandel3333to66,& - math_Voigt66to3333, & - math_I3, & - math_sampleRandomOri,& math_EulerToR,& INRAD use mesh, only: & mesh_NcpElems,& mesh_NipsPerElem, & - mesh_homogenizationAt, & - mesh_microstructureAt + mesh_homogenizationAt use IO use material use config @@ -383,8 +378,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) of = mappingHomogenization(1,ip,el) nGDim = param(instance)%Nconstituents nGrain = homogenization_Ngrains(mesh_homogenizationAt(el)) - nIntFaceTot = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) & - + nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) + nIntFaceTot = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) & + + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) & + + nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) !-------------------------------------------------------------------------------------------------- ! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster @@ -612,7 +608,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) iMun = interface4to1(intFaceP,param(instance)%Nconstituents) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0_pInt) then ! get the corresponding tangent do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt - smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) + dPdF(i,k,j,l,iGrP)*normP(k)*mornP(l) + smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) & + + dPdF(i,k,j,l,iGrP)*normP(k)*mornP(l) enddo;enddo;enddo;enddo endif enddo @@ -637,6 +634,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) allocate(pmatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal) allocate(p_relax(3*nIntFaceTot), source=0.0_pReal) allocate(p_resid(3*nIntFaceTot), source=0.0_pReal) + do ipert = 1_pInt,3_pInt*nIntFaceTot p_relax = relax p_relax(ipert) = relax(ipert) + pPert_RGC ! perturb the relaxation vector @@ -750,11 +748,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! calculate the state update (global relaxation vectors) for the next Newton-Raphson iteration drelax = 0.0_pReal - do i = 1_pInt,3_pInt*nIntFaceTot - do j = 1_pInt,3_pInt*nIntFaceTot - drelax(i) = drelax(i) - jnverse(i,j)*resid(j) ! Calculate the correction for the state variable - enddo - enddo + do i = 1_pInt,3_pInt*nIntFaceTot;do j = 1_pInt,3_pInt*nIntFaceTot + drelax(i) = drelax(i) - jnverse(i,j)*resid(j) ! Calculate the correction for the state variable + enddo; enddo relax = relax + drelax ! Updateing the state variable for the next iteration homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,of) = relax if (any(abs(drelax) > maxdRelax_RGC)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large @@ -790,8 +786,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) debug_levelExtensive, & debug_e, & debug_i - use mesh, only: & - mesh_homogenizationAt use constitutive, only: & constitutive_homogenizedC use math, only: & @@ -841,7 +835,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! computing the mismatch and penalty stress tensor of all grains - do iGrain = 1_pInt,product(param(instance)%Nconstituents) + do iGrain = 1_pInt,product(prm%Nconstituents) Gmoduli = equivalentModuli(iGrain,ip,el) muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector @@ -875,23 +869,21 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) nDefNorm = max(nDefToler,sqrt(nDefNorm)) ! approximation to zero mismatch if mismatch is zero (singularity) nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm ! total amount of mismatch experienced by the grain (at all six interfaces) - if (debugActive) then - write(6,'(1x,a20,i2,1x,a20,1x,i3)')'Mismatch to face: ',intFace(1),'neighbor grain: ',iGNghb - write(6,*) transpose(nDef) - write(6,'(1x,a20,e11.4)')'with magnitude: ',nDefNorm - endif + if (debugActive) then + write(6,'(1x,a20,i2,1x,a20,1x,i3)')'Mismatch to face: ',intFace(1),'neighbor grain: ',iGNghb + write(6,*) transpose(nDef) + write(6,'(1x,a20,e11.4)')'with magnitude: ',nDefNorm + endif !-------------------------------------------------------------------------------------------------- ! compute the stress penalty of all interfaces - do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt - do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt - rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xiAlpha & - *surfCorr(abs(intFace(1)))/prm%dAlpha(abs(intFace(1))) & - *cosh(prm%ciAlpha*nDefNorm) & - *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_civita(k,l,j) & - *tanh(nDefNorm/xSmoo_RGC) - enddo; enddo - enddo; enddo + do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt; do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt + rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xiAlpha & + *surfCorr(abs(intFace(1)))/prm%dAlpha(abs(intFace(1))) & + *cosh(prm%ciAlpha*nDefNorm) & + *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_civita(k,l,j) & + *tanh(nDefNorm/xSmoo_RGC) + enddo; enddo;enddo; enddo enddo if (debugActive) then diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index 9c7f6752d..66acdd5e5 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -40,16 +40,13 @@ subroutine homogenization_isostrain_init() compiler_version, & compiler_options #endif - use prec, only: & - pReal use debug, only: & debug_HOMOGENIZATION, & debug_level, & debug_levelBasic use IO, only: & IO_timeStamp, & - IO_error, & - IO_warning + IO_error use material, only: & homogenization_type, & material_homog, & @@ -103,9 +100,9 @@ subroutine homogenization_isostrain_init() homogState(h)%sizeState = 0_pInt homogState(h)%sizePostResults = 0_pInt - allocate(homogState(h)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) - allocate(homogState(h)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) - allocate(homogState(h)%state (0_pInt,NofMyHomog), source=0.0_pReal) + allocate(homogState(h)%state0 (0_pInt,NofMyHomog)) + allocate(homogState(h)%subState0(0_pInt,NofMyHomog)) + allocate(homogState(h)%state (0_pInt,NofMyHomog)) end associate enddo diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index 0e23867f2..ebff9cdc9 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -24,7 +24,6 @@ subroutine homogenization_none_init() compiler_options #endif use prec, only: & - pReal, & pInt use IO, only: & IO_timeStamp @@ -50,9 +49,9 @@ subroutine homogenization_none_init() NofMyHomog = count(material_homog == h) homogState(h)%sizeState = 0_pInt homogState(h)%sizePostResults = 0_pInt - allocate(homogState(h)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) - allocate(homogState(h)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) - allocate(homogState(h)%state (0_pInt,NofMyHomog), source=0.0_pReal) + allocate(homogState(h)%state0 (0_pInt,NofMyHomog)) + allocate(homogState(h)%subState0(0_pInt,NofMyHomog)) + allocate(homogState(h)%state (0_pInt,NofMyHomog)) enddo From c863419a0b4dc5c71162211ea0c199411c317f54 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 4 Nov 2018 09:00:35 +0100 Subject: [PATCH 038/107] cleaning --- src/homogenization_RGC.f90 | 29 ++++++++++++----------------- 1 file changed, 12 insertions(+), 17 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 04a0aff72..2bb71be13 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -108,8 +108,7 @@ subroutine homogenization_RGC_init() INRAD use mesh, only: & mesh_NcpElems,& - mesh_NipsPerElem, & - mesh_homogenizationAt + mesh_NipsPerElem use IO use material use config @@ -121,7 +120,7 @@ subroutine homogenization_RGC_init() outputSize, & instance, & sizeHState, nIntFaceTot - integer(pInt) :: maxNinstance, i,j,e, mySize, of + integer(pInt) :: maxNinstance, i,j,e, of character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & outputID !< ID of each post result output @@ -236,7 +235,7 @@ subroutine homogenization_RGC_init() !-------------------------------------------------------------------------------------------------- ! * assigning cluster orientations elementLooping: do e = 1_pInt,mesh_NcpElems - if (homogenization_typeInstance(mesh_homogenizationAt(e)) == instance .and. NofMyHomog > 0_pInt) then + if (homogenization_typeInstance(material_homogenizationAt(e)) == instance .and. NofMyHomog > 0_pInt) then do i = 1_pInt,mesh_NipsPerElem of = mappingHomogenization(1,i,e) dependentState(instance)%orientation(1:3,1:3,of) = math_EulerToR(prm%angles*inRad) @@ -321,9 +320,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) debug_i use math, only: & math_invert - use mesh, only: & - mesh_homogenizationAt use material, only: & + material_homogenizationAt, & homogenization_maxNgrains, & homogenization_typeInstance, & homogState, & @@ -374,10 +372,10 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! get the dimension of the cluster (grains and interfaces) - instance = homogenization_typeInstance(mesh_homogenizationAt(el)) + instance = homogenization_typeInstance(material_homogenizationAt(el)) of = mappingHomogenization(1,ip,el) nGDim = param(instance)%Nconstituents - nGrain = homogenization_Ngrains(mesh_homogenizationAt(el)) + nGrain = homogenization_Ngrains(material_homogenizationAt(el)) nIntFaceTot = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) & + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) & + nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) @@ -509,7 +507,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! compute/update the state for postResult, i.e., all energy densities computed by time-integration - do iGrain = 1_pInt,homogenization_Ngrains(mesh_homogenizationAt(el)) ! time-integration loop for work and energy + do iGrain = 1_pInt,homogenization_Ngrains(material_homogenizationAt(el)) ! time-integration loop for work and energy do i = 1_pInt,3_pInt;do j = 1_pInt,3_pInt state(instance)%work(of) = state(instance)%work(of) & + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) @@ -907,12 +905,11 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) debug_levelExtensive, & debug_e, & debug_i - use mesh, only: & - mesh_homogenizationAt use math, only: & math_det33, & math_inv33 use material, only: & + material_homogenizationAt, & homogenization_maxNgrains,& homogenization_Ngrains use numerics, only: & @@ -934,7 +931,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip - nGrain = homogenization_Ngrains(mesh_homogenizationAt(el)) + nGrain = homogenization_Ngrains(material_homogenizationAt(el)) !-------------------------------------------------------------------------------------------------- ! compute the volumes of grains and of cluster @@ -1096,11 +1093,9 @@ end subroutine homogenization_RGC_averageStressAndItsTangent !> @brief return array of homogenization results for post file inclusion !-------------------------------------------------------------------------------------------------- pure function homogenization_RGC_postResults(ip,el) result(postResults) - use mesh, only: & - mesh_homogenizationAt use material, only: & + material_homogenizationAt, & homogenization_typeInstance,& - homogState, & mappingHomogenization implicit none @@ -1110,10 +1105,10 @@ pure function homogenization_RGC_postResults(ip,el) result(postResults) integer(pInt) instance,o,c,of type(tParameters) :: prm - real(pReal), dimension(homogenization_RGC_sizePostResults(homogenization_typeInstance(mesh_homogenizationAt(el)))) :: & + real(pReal), dimension(homogenization_RGC_sizePostResults(homogenization_typeInstance(material_homogenizationAt(el)))) :: & postResults - instance = homogenization_typeInstance(mesh_homogenizationAt(el)) + instance = homogenization_typeInstance(material_homogenizationAt(el)) associate(prm => param(instance)) of = mappingHomogenization(1,ip,el) From 811a02eb519d1d2e36a1dcf20b306c86df5331cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 4 Nov 2018 09:19:24 +0100 Subject: [PATCH 039/107] better readable --- src/homogenization_RGC.f90 | 61 +++++++++++++++++++++++--------------- 1 file changed, 37 insertions(+), 24 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 2bb71be13..b0978d24f 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -1230,10 +1230,9 @@ end function grain1to3 !-------------------------------------------------------------------------------------------------- !> @brief map grain ID from in 3D (local position) to in 1D (global array) !-------------------------------------------------------------------------------------------------- -pure function grain3to1(grain3,nGDim) +integer(pInt) pure function grain3to1(grain3,nGDim) implicit none - integer(pInt) :: grain3to1 integer(pInt), dimension(3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z) integer(pInt), dimension(3), intent(in) :: nGDim @@ -1253,26 +1252,40 @@ integer(pInt) pure function interface4to1(iFace4D, nGDim) integer(pInt), dimension(4), intent(in) :: iFace4D !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z) integer(pInt), dimension(3), intent(in) :: nGDim - interface4to1 = -1_pInt -!-------------------------------------------------------------------------------------------------- -! get the corresponding interface ID in 1D global array - if (abs(iFace4D(1)) == 1_pInt) then ! interface with normal //e1 - interface4to1 = iFace4D(3) + nGDim(2)*(iFace4D(4)-1_pInt) & - + nGDim(2)*nGDim(3)*(iFace4D(2)-1_pInt) - if ((iFace4D(2) == 0_pInt) .or. (iFace4D(2) == nGDim(1))) interface4to1 = 0_pInt - elseif (abs(iFace4D(1)) == 2_pInt) then ! interface with normal //e2 - interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1_pInt) & - + nGDim(3)*nGDim(1)*(iFace4D(3)-1_pInt) & - + (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) ! total number of interfaces normal //e1 - if ((iFace4D(3) == 0_pInt) .or. (iFace4D(3) == nGDim(2))) interface4to1 = 0_pInt - elseif (abs(iFace4D(1)) == 3_pInt) then ! interface with normal //e3 - interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1_pInt) & - + nGDim(1)*nGDim(2)*(iFace4D(4)-1_pInt) & - + (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) & ! total number of interfaces normal //e1 - + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) ! total number of interfaces normal //e2 - if ((iFace4D(4) == 0_pInt) .or. (iFace4D(4) == nGDim(3))) interface4to1 = 0_pInt - endif + select case(abs(iFace4D(1))) + + case(1_pInt) + if ((iFace4D(2) == 0_pInt) .or. (iFace4D(2) == nGDim(1))) then + interface4to1 = 0_pInt + else + interface4to1 = iFace4D(3) + nGDim(2)*(iFace4D(4)-1_pInt) & + + nGDim(2)*nGDim(3)*(iFace4D(2)-1_pInt) + endif + + case(2_pInt) + if ((iFace4D(3) == 0_pInt) .or. (iFace4D(3) == nGDim(2))) then + interface4to1 = 0_pInt + else + interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1_pInt) & + + nGDim(3)*nGDim(1)*(iFace4D(3)-1_pInt) & + + (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) ! total number of interfaces normal //e1 + endif + + case(3_pInt) + if ((iFace4D(4) == 0_pInt) .or. (iFace4D(4) == nGDim(3))) then + interface4to1 = 0_pInt + else + interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1_pInt) & + + nGDim(1)*nGDim(2)*(iFace4D(4)-1_pInt) & + + (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) & ! total number of interfaces normal //e1 + + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) ! total number of interfaces normal //e2 + endif + + case default + interface4to1 = -1_pInt + + end select end function interface4to1 @@ -1290,9 +1303,9 @@ pure function interface1to4(iFace1D, nGDim) !-------------------------------------------------------------------------------------------------- ! compute the total number of interfaces, which ... - nIntFace(1) = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) ! ... normal //e1 - nIntFace(2) = nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) ! ... normal //e2 - nIntFace(3) = nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) ! ... normal //e3 + nIntFace = [(nGDim(1)-1_pInt)*nGDim(2)*nGDim(3), & ! ... normal //e1 + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3), & ! ... normal //e2 + nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt)] ! ... normal //e3 !-------------------------------------------------------------------------------------------------- ! get the corresponding interface ID in 4D (normal and local position) From 7386c6ff9c58302a97fc844b7a70d3d3e8667f49 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 4 Nov 2018 20:16:12 +0100 Subject: [PATCH 040/107] no need for "use" statements will be inherited from outer function --- src/homogenization_RGC.f90 | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index b0978d24f..f26c38453 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -778,18 +778,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !> @brief calculate stress-like penalty due to deformation mismatch !-------------------------------------------------------------------------------------------------- subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) - use debug, only: & - debug_level, & - debug_homogenization,& - debug_levelExtensive, & - debug_e, & - debug_i - use constitutive, only: & - constitutive_homogenizedC use math, only: & math_civita - use material, only: & - homogenization_maxNgrains use numerics, only: & xSmoo_RGC @@ -899,19 +889,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !> @brief calculate stress-like penalty due to volume discrepancy !-------------------------------------------------------------------------------------------------- subroutine volumePenalty(vPen,vDiscrep,fDef,fAvg,ip,el) - use debug, only: & - debug_level, & - debug_homogenization,& - debug_levelExtensive, & - debug_e, & - debug_i use math, only: & math_det33, & math_inv33 - use material, only: & - material_homogenizationAt, & - homogenization_maxNgrains,& - homogenization_Ngrains use numerics, only: & maxVolDiscr_RGC,& volDiscrMod_RGC,& @@ -1035,8 +1015,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! homogenization_RGC_partionDeformation, but used only for perturbation scheme) !-------------------------------------------------------------------------------------------------- subroutine grainDeformation(F, avgF, instance, of) - use material, only: & - homogenization_maxNgrains implicit none real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned F per grain From f4cd4bbac555bf22602f9a94dbe88c7e2c8e00cc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 18 Dec 2018 18:17:06 +0100 Subject: [PATCH 041/107] cleaning --- src/homogenization_RGC.f90 | 74 ++++++++++++++++---------------------- 1 file changed, 31 insertions(+), 43 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index f26c38453..8e331c185 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -13,14 +13,10 @@ module homogenization_RGC implicit none private - integer(pInt), dimension(:), allocatable, public :: & - homogenization_RGC_sizePostResults integer(pInt), dimension(:,:), allocatable,target, public :: & homogenization_RGC_sizePostResult character(len=64), dimension(:,:), allocatable,target, public :: & homogenization_RGC_output ! name of each post result output - integer(pInt), dimension(:), allocatable,target, public :: & - homogenization_RGC_Noutput !< number of outputs per homog instance enum, bind(c) enumerator :: undefined_ID, & @@ -125,7 +121,6 @@ subroutine homogenization_RGC_init() integer(kind(undefined_ID)) :: & outputID !< ID of each post result output character(len=65536), dimension(:), allocatable :: outputs - type(tParameters) :: prm write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming, 2(1):939–942, 2009' @@ -139,13 +134,11 @@ subroutine homogenization_RGC_init() if (maxNinstance == 0_pInt) return if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - allocate(homogenization_RGC_sizePostResults(maxNinstance), source=0_pInt) allocate(param(maxNinstance)) ! one container of parameters per instance allocate(state(maxNinstance)) ! one container per instance allocate(dependentState(maxNinstance)) ! one container per instance - allocate(homogenization_RGC_Noutput(maxNinstance), source=0_pInt) allocate(homogenization_RGC_output(maxval(homogenization_Noutput),maxNinstance)) homogenization_RGC_output='' allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),maxNinstance),& @@ -215,8 +208,7 @@ subroutine homogenization_RGC_init() ! (6) Volume discrepancy, (7) Avg relaxation rate component, (8) Max relaxation rate component homogState(h)%sizeState = sizeHState - homogenization_RGC_sizePostResults(instance) = sum(homogenization_RGC_sizePostResult(:,instance)) - homogState(h)%sizePostResults = homogenization_RGC_sizePostResults(instance) + homogState(h)%sizePostResults = sum(homogenization_RGC_sizePostResult(:,instance)) allocate(homogState(h)%state0 (sizeHState,NofMyHomog), source=0.0_pReal) allocate(homogState(h)%subState0(sizeHState,NofMyHomog), source=0.0_pReal) allocate(homogState(h)%state (sizeHState,NofMyHomog), source=0.0_pReal) @@ -269,7 +261,6 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3 integer(pInt) :: iGrain,iFace,i,j - type(tParameters) :: prm !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations @@ -571,16 +562,16 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! ... of the constitutive stress tangent, assembled from dPdF or material constitutive model "smatrix" allocate(smatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal) do iNum = 1_pInt,nIntFaceTot - faceID = interface1to4(iNum,param(instance)%Nconstituents) ! assembling of local dPdF into global Jacobian matrix + faceID = interface1to4(iNum,param(instance)%Nconstituents) ! assembling of local dPdF into global Jacobian matrix !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate sytem - iGrN = grain3to1(iGr3N,param(instance)%Nconstituents) ! translate into global grain ID - intFaceN = getInterface(2_pInt*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system + iGrN = grain3to1(iGr3N,param(instance)%Nconstituents) ! translate into global grain ID + intFaceN = getInterface(2_pInt*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system normN = interfaceNormal(intFaceN,instance,of) do iFace = 1_pInt,6_pInt - intFaceN = getInterface(iFace,iGr3N) ! identifying all interfaces that influence relaxation of the above interface + intFaceN = getInterface(iFace,iGr3N) ! identifying all interfaces that influence relaxation of the above interface mornN = interfaceNormal(intFaceN,instance,of) iMun = interface4to1(intFaceN,param(instance)%Nconstituents) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0) then ! get the corresponding tangent @@ -597,13 +588,13 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate sytem - iGrP = grain3to1(iGr3P,param(instance)%Nconstituents) ! translate into global grain ID - intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the connecting interface in local coordinate system + iGrP = grain3to1(iGr3P,param(instance)%Nconstituents) ! translate into global grain ID + intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the connecting interface in local coordinate system normP = interfaceNormal(intFaceP,instance,of) do iFace = 1_pInt,6_pInt - intFaceP = getInterface(iFace,iGr3P) ! identifying all interfaces that influence relaxation of the above interface + intFaceP = getInterface(iFace,iGr3P) ! identifying all interfaces that influence relaxation of the above interface mornP = interfaceNormal(intFaceP,instance,of) - iMun = interface4to1(intFaceP,param(instance)%Nconstituents) ! translate the interfaces ID into local 4-dimensional index + iMun = interface4to1(intFaceP,param(instance)%Nconstituents) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0_pInt) then ! get the corresponding tangent do i=1_pInt,3_pInt; do j=1_pInt,3_pInt; do k=1_pInt,3_pInt; do l=1_pInt,3_pInt smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) & @@ -637,9 +628,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) p_relax = relax p_relax(ipert) = relax(ipert) + pPert_RGC ! perturb the relaxation vector homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,of) = p_relax - call grainDeformation(pF,avgF,instance,of) ! compute the grains deformation from perturbed state - call stressPenalty(pR,pNN,avgF,pF,ip,el,instance) ! compute stress penalty due to interface mismatch from perturbed state - call volumePenalty(pD,volDiscrep,pF,avgF,ip,el) ! compute stress penalty due to volume discrepancy from perturbed state + call grainDeformation(pF,avgF,instance,of) ! rain deformation from perturbed state + call stressPenalty(pR,pNN,avgF,pF,ip,el,instance) ! stress penalty due to interface mismatch from perturbed state + call volumePenalty(pD,volDiscrep,pF,avgF,ip,el) ! stress penalty due to volume discrepancy from perturbed state !-------------------------------------------------------------------------------------------------- ! computing the global stress residual array from the perturbed state @@ -649,17 +640,17 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) - iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrN = grain3to1(iGr3N,param(instance)%Nconstituents) ! translate the local grain ID into global coordinate system (1-dimensional index) - intFaceN = getInterface(2_pInt*faceID(1),iGr3N) ! identifying the interface ID of the grain + iGr3N = faceID(2:4) ! identify the grain ID in local coordinate system (3-dimensional index) + iGrN = grain3to1(iGr3N,param(instance)%Nconstituents) ! translate the local grain ID into global coordinate system (1-dimensional index) + intFaceN = getInterface(2_pInt*faceID(1),iGr3N) ! identify the interface ID of the grain normN = interfaceNormal(intFaceN,instance,of) !-------------------------------------------------------------------------------------------------- ! identify the right/up/front grain (+|P) iGr3P = iGr3N - iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrP = grain3to1(iGr3P,param(instance)%Nconstituents) ! translate the local grain ID into global coordinate system (1-dimensional index) - intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identifying the interface ID of the grain + iGr3P(faceID(1)) = iGr3N(faceID(1))+1_pInt ! identify the grain ID in local coordinate system (3-dimensional index) + iGrP = grain3to1(iGr3P,param(instance)%Nconstituents) ! translate the local grain ID into global coordinate system (1-dimensional index) + intFaceP = getInterface(2_pInt*faceID(1)-1_pInt,iGr3P) ! identify the interface ID of the grain normP = interfaceNormal(intFaceP,instance,of) !-------------------------------------------------------------------------------------------------- @@ -796,8 +787,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) real(pReal), dimension (2) :: Gmoduli integer(pInt) :: iGrain,iGNghb,iFace,i,j,k,l,of real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb - - type(tParameters) :: prm real(pReal), parameter :: nDefToler = 1.0e-10_pReal logical :: debugActive @@ -825,24 +814,24 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! computing the mismatch and penalty stress tensor of all grains do iGrain = 1_pInt,product(prm%Nconstituents) Gmoduli = equivalentModuli(iGrain,ip,el) - muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain - bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector - iGrain3 = grain1to3(iGrain,prm%Nconstituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position + muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain + bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector + iGrain3 = grain1to3(iGrain,prm%Nconstituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position !* Looping over all six interfaces of each grain do iFace = 1_pInt,6_pInt - intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain + intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain nVect = interfaceNormal(intFace,instance,of) - iGNghb3 = iGrain3 ! identify the neighboring grain across the interface + iGNghb3 = iGrain3 ! identify the neighboring grain across the interface iGNghb3(abs(intFace(1))) = iGNghb3(abs(intFace(1))) & + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal),pInt) where(iGNghb3 < 1) iGNghb3 = nGDim where(iGNghb3 >nGDim) iGNghb3 = 1_pInt - iGNghb = grain3to1(iGNghb3,prm%Nconstituents) ! get the ID of the neighboring grain - Gmoduli = equivalentModuli(iGNghb,ip,el) ! collecting the shear modulus and Burgers vector of the neighbor + iGNghb = grain3to1(iGNghb3,prm%Nconstituents) ! get the ID of the neighboring grain + Gmoduli = equivalentModuli(iGNghb,ip,el) ! collect the shear modulus and Burgers vector of the neighbor muGNghb = Gmoduli(1) bgGNghb = Gmoduli(2) - gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! compute the difference/jump in deformation gradeint across the neighbor + gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! difference/jump in deformation gradeint across the neighbor !-------------------------------------------------------------------------------------------------- ! compute the mismatch tensor of all interfaces @@ -850,12 +839,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) nDef = 0.0_pReal do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt - nDef(i,j) = nDef(i,j) - nVect(k)*gDef(i,l)*math_civita(j,k,l) ! compute the interface mismatch tensor from the jump of deformation gradient + nDef(i,j) = nDef(i,j) - nVect(k)*gDef(i,l)*math_civita(j,k,l) ! compute the interface mismatch tensor from the jump of deformation gradient enddo; enddo - nDefNorm = nDefNorm + nDef(i,j)**2.0_pReal ! compute the norm of the mismatch tensor + nDefNorm = nDefNorm + nDef(i,j)**2.0_pReal ! compute the norm of the mismatch tensor enddo; enddo - nDefNorm = max(nDefToler,sqrt(nDefNorm)) ! approximation to zero mismatch if mismatch is zero (singularity) - nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm ! total amount of mismatch experienced by the grain (at all six interfaces) + nDefNorm = max(nDefToler,sqrt(nDefNorm)) ! approximation to zero mismatch if mismatch is zero (singularity) + nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm ! total amount of mismatch experienced by the grain (at all six interfaces) if (debugActive) then write(6,'(1x,a20,i2,1x,a20,1x,i3)')'Mismatch to face: ',intFace(1),'neighbor grain: ',iGNghb @@ -1082,8 +1071,7 @@ pure function homogenization_RGC_postResults(ip,el) result(postResults) el !< element number integer(pInt) instance,o,c,of - type(tParameters) :: prm - real(pReal), dimension(homogenization_RGC_sizePostResults(homogenization_typeInstance(material_homogenizationAt(el)))) :: & + real(pReal), dimension(sum(homogenization_RGC_sizePostResult(:,homogenization_typeInstance(material_homogenizationAt(el))))) :: & postResults instance = homogenization_typeInstance(material_homogenizationAt(el)) From e43057adb389d3ae9204268c043e9c939fe29909 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 12 Jan 2019 22:04:03 +0100 Subject: [PATCH 042/107] cleaning --- src/homogenization_RGC.f90 | 201 ++++++++++++++++--------------- src/homogenization_isostrain.f90 | 50 ++++---- src/homogenization_none.f90 | 14 ++- 3 files changed, 142 insertions(+), 123 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 8e331c185..45fd078fb 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -19,19 +19,17 @@ module homogenization_RGC homogenization_RGC_output ! name of each post result output enum, bind(c) - enumerator :: undefined_ID, & - constitutivework_ID, & - penaltyenergy_ID, & - volumediscrepancy_ID, & - averagerelaxrate_ID,& - maximumrelaxrate_ID,& - ipcoords_ID,& - magnitudemismatch_ID,& - avgdefgrad_ID,& - avgfirstpiola_ID + enumerator :: & + undefined_ID, & + constitutivework_ID, & + penaltyenergy_ID, & + volumediscrepancy_ID, & + averagerelaxrate_ID,& + maximumrelaxrate_ID,& + magnitudemismatch_ID end enum - type, private :: tParameters !< container type for internal constitutive parameters + type, private :: tParameters integer(pInt), dimension(:), allocatable :: & Nconstituents real(pReal) :: & @@ -40,8 +38,10 @@ module homogenization_RGC real(pReal), dimension(:), allocatable :: & dAlpha, & angles + integer(pInt) :: & + of_debug integer(kind(undefined_ID)), dimension(:), allocatable :: & - outputID !< ID of each post result output + outputID end type type, private :: tRGCstate @@ -61,8 +61,8 @@ module homogenization_RGC orientation end type tRGCdependentState - type(tparameters), dimension(:), allocatable, private :: param !< containers of parameters (len Ninstance) - type(tRGCstate), dimension(:), allocatable, private :: state + type(tparameters), dimension(:), allocatable, private :: param !< containers of parameters (len Ninstance) + type(tRGCstate), dimension(:), allocatable, private :: state type(tRGCdependentState), dimension(:), allocatable, private :: dependentState public :: & @@ -102,25 +102,27 @@ subroutine homogenization_RGC_init() use math, only: & math_EulerToR,& INRAD - use mesh, only: & - mesh_NcpElems,& - mesh_NipsPerElem - use IO + use IO, only: & + IO_error, & + IO_timeStamp use material - use config + use config, only: & + config_homogenization implicit none integer(pInt) :: & - NofMyHomog, & - h, & - outputSize, & - instance, & - sizeHState, nIntFaceTot - integer(pInt) :: maxNinstance, i,j,e, of + Ninstance, & + h, i, j, & + NofMyHomog, outputSize, & + sizeState, nIntFaceTot + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - integer(kind(undefined_ID)) :: & - outputID !< ID of each post result output - character(len=65536), dimension(:), allocatable :: outputs + + integer(kind(undefined_ID)) :: & + outputID + + character(len=65536), dimension(:), allocatable :: & + outputs write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming, 2(1):939–942, 2009' @@ -130,39 +132,47 @@ subroutine homogenization_RGC_init() write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt) - if (maxNinstance == 0_pInt) return + Ninstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt) + if (Ninstance == 0_pInt) return if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(param(maxNinstance)) ! one container of parameters per instance - allocate(state(maxNinstance)) ! one container per instance - allocate(dependentState(maxNinstance)) ! one container per instance - - allocate(homogenization_RGC_output(maxval(homogenization_Noutput),maxNinstance)) - homogenization_RGC_output='' - allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),maxNinstance),& - source=0_pInt) + allocate(param(Ninstance)) + allocate(state(Ninstance)) + allocate(dependentState(Ninstance)) + + allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),Ninstance),source=0_pInt) + allocate(homogenization_RGC_output(maxval(homogenization_Noutput),Ninstance)) + homogenization_RGC_output='' do h = 1_pInt, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle - instance = homogenization_typeInstance(h) - associate(prm => param(instance)) + associate(prm => param(homogenization_typeInstance(h)), & + stt => state(homogenization_typeInstance(h)), & + dst => dependentState(homogenization_typeInstance(h)), & + config => config_homogenization(h)) + +#ifdef DEBUG + if (h==material_homogenizationAt(debug_e)) then + prm%of_debug = mappingHomogenization(1,debug_i,debug_e) + endif +#endif - prm%Nconstituents = config_homogenization(h)%getInts('clustersize',requiredShape=[3]) + prm%Nconstituents = config%getInts('clustersize',requiredShape=[3]) if (homogenization_Ngrains(h) /= product(prm%Nconstituents)) & call IO_error(211_pInt,ext_msg='clustersize ('//HOMOGENIZATION_RGC_label//')') - prm%xiAlpha = config_homogenization(h)%getFloat('scalingparameter') - prm%ciAlpha = config_homogenization(h)%getFloat('overproportionality') - prm%dAlpha = config_homogenization(h)%getFloats('grainsize',requiredShape=[3]) - prm%angles = config_homogenization(h)%getFloats('clusterorientation',requiredShape=[3]) + prm%xiAlpha = config%getFloat('scalingparameter') + prm%ciAlpha = config%getFloat('overproportionality') + prm%dAlpha = config%getFloats('grainsize',requiredShape=[3]) + prm%angles = config%getFloats('clusterorientation',requiredShape=[3]) - outputs = config_homogenization(h)%getStrings('(output)',defaultVal=emptyStringArray) + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID select case(outputs(i)) + case('constitutivework') outputID = constitutivework_ID outputSize = 1_pInt @@ -181,17 +191,19 @@ subroutine homogenization_RGC_init() case('magnitudemismatch') outputID = magnitudemismatch_ID outputSize = 3_pInt - case default + end select + if (outputID /= undefined_ID) then - homogenization_RGC_output(i,instance) = outputs(i) - homogenization_RGC_sizePostResult(i,instance) = outputSize + homogenization_RGC_output(i,homogenization_typeInstance(h)) = outputs(i) + homogenization_RGC_sizePostResult(i,homogenization_typeInstance(h)) = outputSize prm%outputID = [prm%outputID , outputID] endif + enddo if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then - write(6,'(a15,1x,i4,/)') 'instance: ', instance + write(6,'(a15,1x,i4,/)') 'instance: ', homogenization_typeInstance(h) write(6,'(a25,3(1x,i8))') 'cluster size: ',(prm%Nconstituents(j),j=1_pInt,3_pInt) write(6,'(a25,1x,e10.3)') 'scaling parameter: ', prm%xiAlpha write(6,'(a25,1x,e10.3)') 'over-proportionality: ', prm%ciAlpha @@ -203,38 +215,36 @@ subroutine homogenization_RGC_init() nIntFaceTot = 3_pInt*( (prm%Nconstituents(1)-1_pInt)*prm%Nconstituents(2)*prm%Nconstituents(3) & + prm%Nconstituents(1)*(prm%Nconstituents(2)-1_pInt)*prm%Nconstituents(3) & + prm%Nconstituents(1)*prm%Nconstituents(2)*(prm%Nconstituents(3)-1_pInt)) - sizeHState = nIntFaceTot & - + 8_pInt ! (1) Average constitutive work, (2-4) Overall mismatch, (5) Average penalty energy, - ! (6) Volume discrepancy, (7) Avg relaxation rate component, (8) Max relaxation rate component - - homogState(h)%sizeState = sizeHState - homogState(h)%sizePostResults = sum(homogenization_RGC_sizePostResult(:,instance)) - allocate(homogState(h)%state0 (sizeHState,NofMyHomog), source=0.0_pReal) - allocate(homogState(h)%subState0(sizeHState,NofMyHomog), source=0.0_pReal) - allocate(homogState(h)%state (sizeHState,NofMyHomog), source=0.0_pReal) + sizeState = nIntFaceTot & + + size(['avg constitutive work']) + size(['overall mismatch']) * 3_pInt & + + size(['average penalty energy ','volume discrepancy ',& + 'avg relaxation rate component ','max relaxation rate componenty']) - state(instance)%relaxationVector => homogState(h)%state(1:nIntFaceTot,:) - state(instance)%work => homogState(h)%state(nIntFaceTot+1,:) - state(instance)%mismatch => homogState(h)%state(nIntFaceTot+2:nIntFaceTot+4,:) - state(instance)%penaltyEnergy => homogState(h)%state(nIntFaceTot+5,:) - state(instance)%volumeDiscrepancy => homogState(h)%state(nIntFaceTot+6,:) - state(instance)%relaxationRate_avg => homogState(h)%state(nIntFaceTot+7,:) - state(instance)%relaxationRate_max => homogState(h)%state(nIntFaceTot+8,:) + homogState(h)%sizeState = sizeState + homogState(h)%sizePostResults = sum(homogenization_RGC_sizePostResult(:,homogenization_typeInstance(h))) + allocate(homogState(h)%state0 (sizeState,NofMyHomog), source=0.0_pReal) + allocate(homogState(h)%subState0(sizeState,NofMyHomog), source=0.0_pReal) + allocate(homogState(h)%state (sizeState,NofMyHomog), source=0.0_pReal) - allocate(dependentState(instance)%orientation(3,3,NofMyHomog)) + stt%relaxationVector => homogState(h)%state(1:nIntFaceTot,:) + stt%work => homogState(h)%state(nIntFaceTot+1,:) + stt%mismatch => homogState(h)%state(nIntFaceTot+2:nIntFaceTot+4,:) + stt%penaltyEnergy => homogState(h)%state(nIntFaceTot+5,:) + stt%volumeDiscrepancy => homogState(h)%state(nIntFaceTot+6,:) + stt%relaxationRate_avg => homogState(h)%state(nIntFaceTot+7,:) + stt%relaxationRate_max => homogState(h)%state(nIntFaceTot+8,:) + + allocate(dst%orientation(3,3,NofMyHomog)) !-------------------------------------------------------------------------------------------------- -! * assigning cluster orientations - elementLooping: do e = 1_pInt,mesh_NcpElems - if (homogenization_typeInstance(material_homogenizationAt(e)) == instance .and. NofMyHomog > 0_pInt) then - do i = 1_pInt,mesh_NipsPerElem - of = mappingHomogenization(1,i,e) - dependentState(instance)%orientation(1:3,1:3,of) = math_EulerToR(prm%angles*inRad) - enddo - endif - enddo elementLooping +! assigning cluster orientations + do j=1, NofMyHomog + dst%orientation(1:3,1:3,j) = math_EulerToR(prm%angles*inRad) !ToDo: use spread + enddo + end associate + enddo end subroutine homogenization_RGC_init @@ -244,19 +254,23 @@ end subroutine homogenization_RGC_init !> @brief partitions the deformation gradient onto the constituents !-------------------------------------------------------------------------------------------------- subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) +#ifdef DEBUG use debug, only: & debug_level, & debug_homogenization, & debug_levelExtensive +#endif use material, only: & homogenization_maxNgrains implicit none real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned F per grain + real(pReal), dimension (3,3), intent(in) :: avgF !< averaged F integer(pInt), intent(in) :: & instance, & - of !< element number + of + real(pReal), dimension (3) :: aVect,nVect integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3 @@ -265,6 +279,7 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations associate(prm => param(instance)) + F = 0.0_pReal do iGrain = 1_pInt,product(prm%Nconstituents) iGrain3 = grain1to3(iGrain,prm%Nconstituents) @@ -279,18 +294,18 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) !-------------------------------------------------------------------------------------------------- ! debugging the grain deformation gradients +#ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain do i = 1_pInt,3_pInt write(6,'(1x,3(e15.8,1x))')(F(i,j,iGrain), j = 1_pInt,3_pInt) enddo write(6,*)' ' flush(6) - !$OMP END CRITICAL (write2out) endif - +#endif enddo + end associate end subroutine homogenization_RGC_partitionDeformation @@ -378,17 +393,16 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) relax = homogState(mappingHomogenization(2,ip,el))%state (1:3_pInt*nIntFaceTot,of) drelax = relax & - homogState(mappingHomogenization(2,ip,el))%state0(1:3_pInt*nIntFaceTot,of) -!-------------------------------------------------------------------------------------------------- -! debugging the obtained state + +#ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(1x,a30)')'Obtained state: ' do i = 1_pInt,3_pInt*nIntFaceTot write(6,'(1x,2(e15.8,1x))')homogState(mappingHomogenization(2,ip,el))%state(i,of) enddo write(6,*)' ' - !$OMP END CRITICAL (write2out) endif +#endif !-------------------------------------------------------------------------------------------------- ! computing interface mismatch and stress penalty tensor for all interfaces of all grains @@ -398,10 +412,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! calculating volume discrepancy and stress penalty related to overall volume discrepancy call volumePenalty(D,volDiscrep,F,avgF,ip,el) -!-------------------------------------------------------------------------------------------------- -! debugging the mismatch, stress and penalties of grains +#ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then - !$OMP CRITICAL (write2out) do iGrain = 1_pInt,nGrain write(6,'(1x,a30,1x,i3,1x,a4,3(1x,e15.8))')'Mismatch magnitude of grain(',iGrain,') :',& NN(1,iGrain),NN(2,iGrain),NN(3,iGrain) @@ -413,8 +425,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) enddo write(6,*)' ' enddo - !$OMP END CRITICAL (write2out) endif +#endif !------------------------------------------------------------------------------------------------ ! computing the residual stress from the balance of traction at all (interior) interfaces @@ -448,15 +460,13 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) enddo enddo -!-------------------------------------------------------------------------------------------------- -! debugging the residual stress +#ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum write(6,'(1x,3(e15.8,1x))')(tract(iNum,j), j = 1_pInt,3_pInt) write(6,*)' ' - !$OMP END CRITICAL (write2out) endif +#endif enddo !-------------------------------------------------------------------------------------------------- @@ -466,8 +476,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) residMax = maxval(abs(tract)) ! get the maximum of the residual residLoc = int(maxloc(abs(tract)),pInt) ! get the position of the maximum residual -!-------------------------------------------------------------------------------------------------- -! Debugging the convergent criteria +#ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip) then !$OMP CRITICAL (write2out) @@ -478,8 +487,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) write(6,'(1x,a15,1x,e15.8,1x,a7,i3,1x,a12,i2)')'Max residual: ',residMax, & '@ iface',residLoc(1),'in direction',residLoc(2) flush(6) - !$OMP END CRITICAL (write2out) endif +#endif homogenization_RGC_updateState = .false. diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index 66acdd5e5..9987b7e61 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -7,12 +7,13 @@ module homogenization_isostrain use prec, only: & pInt - + implicit none private enum, bind(c) - enumerator :: parallel_ID, & - average_ID + enumerator :: & + parallel_ID, & + average_ID end enum type, private :: tParameters !< container type for internal constitutive parameters @@ -59,22 +60,17 @@ subroutine homogenization_isostrain_init() implicit none integer(pInt) :: & - h - integer :: & - Ninstance - integer :: & - NofMyHomog ! no pInt (stores a system dependen value from 'count' + Ninstance, & + h, & + NofMyHomog character(len=65536) :: & tag = '' - type(tParameters) :: prm - + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - Ninstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) - if (Ninstance == 0) return - + Ninstance = int(count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID),pInt) if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance @@ -82,12 +78,13 @@ subroutine homogenization_isostrain_init() do h = 1_pInt, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_ISOSTRAIN_ID) cycle - associate(prm => param(homogenization_typeInstance(h))) + + associate(prm => param(homogenization_typeInstance(h)),& + config => config_homogenization(h)) prm%Nconstituents = config_homogenization(h)%getInt('nconstituents') tag = 'sum' - tag = config_homogenization(h)%getString('mapping',defaultVal = tag) - select case(trim(tag)) + select case(trim(config%getString('mapping',defaultVal = tag))) case ('sum') prm%mapping = parallel_ID case ('avg') @@ -97,12 +94,12 @@ subroutine homogenization_isostrain_init() end select NofMyHomog = count(material_homog == h) - homogState(h)%sizeState = 0_pInt homogState(h)%sizePostResults = 0_pInt allocate(homogState(h)%state0 (0_pInt,NofMyHomog)) allocate(homogState(h)%subState0(0_pInt,NofMyHomog)) allocate(homogState(h)%state (0_pInt,NofMyHomog)) + end associate enddo @@ -120,16 +117,18 @@ subroutine homogenization_isostrain_partitionDeformation(F,avgF,instance) homogenization_maxNgrains implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned def grad per grain - real(pReal), dimension (3,3), intent(in) :: avgF !< my average def grad + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partitioned deformation gradient + + real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point integer(pInt), intent(in) :: instance - type(tParameters) :: & - prm + associate(prm => param(instance)) + F(1:3,1:3,1:prm%Nconstituents) = spread(avgF,3,prm%Nconstituents) if (homogenization_maxNgrains > prm%Nconstituents) & F(1:3,1:3,prm%Nconstituents+1_pInt:homogenization_maxNgrains) = 0.0_pReal + end associate end subroutine homogenization_isostrain_partitionDeformation @@ -147,13 +146,13 @@ subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P implicit none real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: P !< array of current grain stresses - real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< array of current grain stiffnesses + + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: P !< partitioned stresses + real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< partitioned stiffnesses integer(pInt), intent(in) :: instance - type(tParameters) :: & - prm associate(prm => param(instance)) + select case (prm%mapping) case (parallel_ID) avgP = sum(P,3) @@ -162,6 +161,7 @@ subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P avgP = sum(P,3) /real(prm%Nconstituents,pReal) dAvgPdAvgF = sum(dPdF,5)/real(prm%Nconstituents,pReal) end select + end associate end subroutine homogenization_isostrain_averageStressAndItsTangent diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index ebff9cdc9..04ea55abe 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -2,7 +2,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 dummy homogenization homogenization scheme +!> @brief dummy homogenization homogenization scheme for 1 constituent per material point !-------------------------------------------------------------------------------------------------- module homogenization_none @@ -24,9 +24,14 @@ subroutine homogenization_none_init() compiler_options #endif use prec, only: & - pInt + pInt + use debug, only: & + debug_HOMOGENIZATION, & + debug_level, & + debug_levelBasic use IO, only: & IO_timeStamp + use material, only: & homogenization_type, & material_homog, & @@ -36,6 +41,7 @@ subroutine homogenization_none_init() implicit none integer(pInt) :: & + Ninstance, & h, & NofMyHomog @@ -43,6 +49,10 @@ subroutine homogenization_none_init() write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + Ninstance = int(count(homogenization_type == HOMOGENIZATION_NONE_ID),pInt) + if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + do h = 1_pInt, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle From 837699e6c12aa59ea3c694bdaff06e3adf6b77a2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 12 Jan 2019 23:07:35 +0100 Subject: [PATCH 043/107] polishing --- src/homogenization.f90 | 31 ++-- src/homogenization_RGC.f90 | 287 +++++++++++++++++++------------------ 2 files changed, 164 insertions(+), 154 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 32b033ffe..3f62ffd7d 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -922,6 +922,8 @@ function homogenization_postResults(ip,el) use mesh, only: & mesh_element use material, only: & + material_homogenizationAt, & + homogenization_typeInstance,& mappingHomogenization, & homogState, & thermalState, & @@ -958,45 +960,42 @@ function homogenization_postResults(ip,el) + damageState (mappingHomogenization(2,ip,el))%sizePostResults) :: & homogenization_postResults integer(pInt) :: & - startPos, endPos + startPos, endPos ,& + of, instance + homogenization_postResults = 0.0_pReal - startPos = 1_pInt endPos = homogState(mappingHomogenization(2,ip,el))%sizePostResults chosenHomogenization: select case (homogenization_type(mesh_element(3,el))) - case (HOMOGENIZATION_NONE_ID,HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization case (HOMOGENIZATION_RGC_ID) chosenHomogenization - homogenization_postResults(startPos:endPos) = & - homogenization_RGC_postResults(ip,el) + instance = homogenization_typeInstance(material_homogenizationAt(el)) + of = mappingHomogenization(1,ip,el) + homogenization_postResults(startPos:endPos) = homogenization_RGC_postResults(instance,of) + end select chosenHomogenization startPos = endPos + 1_pInt endPos = endPos + thermalState(mappingHomogenization(2,ip,el))%sizePostResults chosenThermal: select case (thermal_type(mesh_element(3,el))) - case (THERMAL_isothermal_ID) chosenThermal case (THERMAL_adiabatic_ID) chosenThermal - homogenization_postResults(startPos:endPos) = & - thermal_adiabatic_postResults(ip, el) + homogenization_postResults(startPos:endPos) = thermal_adiabatic_postResults(ip, el) case (THERMAL_conduction_ID) chosenThermal - homogenization_postResults(startPos:endPos) = & - thermal_conduction_postResults(ip, el) + homogenization_postResults(startPos:endPos) = thermal_conduction_postResults(ip, el) + end select chosenThermal startPos = endPos + 1_pInt endPos = endPos + damageState(mappingHomogenization(2,ip,el))%sizePostResults chosenDamage: select case (damage_type(mesh_element(3,el))) - case (DAMAGE_none_ID) chosenDamage case (DAMAGE_local_ID) chosenDamage - homogenization_postResults(startPos:endPos) = & - damage_local_postResults(ip, el) - + homogenization_postResults(startPos:endPos) = damage_local_postResults(ip, el) case (DAMAGE_nonlocal_ID) chosenDamage - homogenization_postResults(startPos:endPos) = & - damage_nonlocal_postResults(ip, el) + homogenization_postResults(startPos:endPos) = damage_nonlocal_postResults(ip, el) + end select chosenDamage end function homogenization_postResults diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 45fd078fb..7374abcd8 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -39,7 +39,7 @@ module homogenization_RGC dAlpha, & angles integer(pInt) :: & - of_debug + of_debug = 0_pInt integer(kind(undefined_ID)), dimension(:), allocatable :: & outputID end type @@ -133,7 +133,6 @@ subroutine homogenization_RGC_init() #include "compilation_info.f90" Ninstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt) - if (Ninstance == 0_pInt) return if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance @@ -318,12 +317,14 @@ end subroutine homogenization_RGC_partitionDeformation function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) use prec, only: & dEq0 +#ifdef DEBUG use debug, only: & debug_level, & debug_homogenization,& debug_levelExtensive, & debug_e, & debug_i +#endif use math, only: & math_invert use material, only: & @@ -363,9 +364,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) integer(pInt), dimension (2) :: residLoc integer(pInt) instance,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain, of real(pReal), dimension (3,3,homogenization_maxNgrains) :: R,pF,pR,D,pD - real(pReal), dimension (3,homogenization_maxNgrains) :: NN,pNN + real(pReal), dimension (3,homogenization_maxNgrains) :: NN,devNull33 real(pReal), dimension (3) :: normP,normN,mornP,mornN - real(pReal) :: residMax,stresMax,volDiscrep + real(pReal) :: residMax,stresMax,devNull logical error real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix @@ -376,12 +377,16 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) return endif zeroTimeStep -!-------------------------------------------------------------------------------------------------- -! get the dimension of the cluster (grains and interfaces) + instance = homogenization_typeInstance(material_homogenizationAt(el)) of = mappingHomogenization(1,ip,el) - nGDim = param(instance)%Nconstituents - nGrain = homogenization_Ngrains(material_homogenizationAt(el)) + + associate(stt => state(instance), prm => param(instance)) + +!-------------------------------------------------------------------------------------------------- +! get the dimension of the cluster (grains and interfaces) + nGDim = prm%Nconstituents + nGrain = product(nGDim) nIntFaceTot = (nGDim(1)-1_pInt)*nGDim(2)*nGDim(3) & + nGDim(1)*(nGDim(2)-1_pInt)*nGDim(3) & + nGDim(1)*nGDim(2)*(nGDim(3)-1_pInt) @@ -390,15 +395,15 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster allocate(resid(3_pInt*nIntFaceTot), source=0.0_pReal) allocate(tract(nIntFaceTot,3), source=0.0_pReal) - relax = homogState(mappingHomogenization(2,ip,el))%state (1:3_pInt*nIntFaceTot,of) + relax = stt%relaxationVector(:,of) drelax = relax & - homogState(mappingHomogenization(2,ip,el))%state0(1:3_pInt*nIntFaceTot,of) #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then write(6,'(1x,a30)')'Obtained state: ' - do i = 1_pInt,3_pInt*nIntFaceTot - write(6,'(1x,2(e15.8,1x))')homogState(mappingHomogenization(2,ip,el))%state(i,of) + do i = 1_pInt,size(stt%relaxationVector(:,of)) + write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) enddo write(6,*)' ' endif @@ -406,11 +411,11 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! computing interface mismatch and stress penalty tensor for all interfaces of all grains - call stressPenalty(R,NN,avgF,F,ip,el,instance) + call stressPenalty(R,NN,avgF,F,ip,el,instance,of) !-------------------------------------------------------------------------------------------------- ! calculating volume discrepancy and stress penalty related to overall volume discrepancy - call volumePenalty(D,volDiscrep,F,avgF,ip,el) + call volumePenalty(D,stt%volumeDiscrepancy(of),avgF,F,nGrain,instance,of) #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then @@ -479,7 +484,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) write(6,'(1x,a)')' ' write(6,'(1x,a,1x,i2,1x,i4)')'RGC residual check ...',ip,el write(6,'(1x,a15,1x,e15.8,1x,a7,i3,1x,a12,i2,i2)')'Max stress: ',stresMax, & @@ -496,45 +500,43 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! If convergence reached => done and happy if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then homogenization_RGC_updateState = .true. - +#ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) write(6,'(1x,a55,/)')'... done and happy' flush(6) - !$OMP END CRITICAL (write2out) endif +#endif !-------------------------------------------------------------------------------------------------- ! compute/update the state for postResult, i.e., all energy densities computed by time-integration do iGrain = 1_pInt,homogenization_Ngrains(material_homogenizationAt(el)) ! time-integration loop for work and energy do i = 1_pInt,3_pInt;do j = 1_pInt,3_pInt - state(instance)%work(of) = state(instance)%work(of) & - + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) - state(instance)%penaltyEnergy(of) = state(instance)%penaltyEnergy(of) & - + R(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) + stt%work(of) = stt%work(of) & + + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) + stt%penaltyEnergy(of) = stt%penaltyEnergy(of) & + + R(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) enddo; enddo enddo - state(instance)%mismatch(1:3,of) = sum(NN,2)/real(nGrain,pReal) ! the overall mismatch of all interface normals - state(instance)%volumeDiscrepancy(of) = volDiscrep - state(instance)%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) - state(instance)%relaxationRate_max(of) = maxval(abs(drelax))/dt - + stt%mismatch(1:3,of) = sum(NN,2)/real(nGrain,pReal) + stt%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) + stt%relaxationRate_max(of) = maxval(abs(drelax))/dt + +#ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) - write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',state(instance)%work(of) - write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',state(instance)%mismatch(1,of), & - state(instance)%mismatch(2,of), & - state(instance)%mismatch(3,of) - write(6,'(1x,a30,1x,e15.8)') 'Penalty energy: ', state(instance)%penaltyEnergy(of) - write(6,'(1x,a30,1x,e15.8,/)') 'Volume discrepancy: ', state(instance)%volumeDiscrepancy(of) - write(6,'(1x,a30,1x,e15.8)') 'Maximum relaxation rate: ', state(instance)%relaxationRate_max(of) - write(6,'(1x,a30,1x,e15.8,/)') 'Average relaxation rate: ', state(instance)%relaxationRate_avg(of) + write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',stt%work(of) + write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',stt%mismatch(1,of), & + stt%mismatch(2,of), & + stt%mismatch(3,of) + write(6,'(1x,a30,1x,e15.8)') 'Penalty energy: ', stt%penaltyEnergy(of) + write(6,'(1x,a30,1x,e15.8,/)') 'Volume discrepancy: ', stt%volumeDiscrepancy(of) + write(6,'(1x,a30,1x,e15.8)') 'Maximum relaxation rate: ', stt%relaxationRate_max(of) + write(6,'(1x,a30,1x,e15.8,/)') 'Average relaxation rate: ', stt%relaxationRate_avg(of) flush(6) - !$OMP END CRITICAL (write2out) endif +#endif return @@ -542,24 +544,25 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! if residual blows-up => done but unhappy elseif (residMax > relMax_RGC*stresMax .or. residMax > absMax_RGC) then ! try to restart when residual blows up exceeding maximum bound homogenization_RGC_updateState = [.true.,.false.] ! with direct cut-back - + +#ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) write(6,'(1x,a55,/)')'... broken' flush(6) - !$OMP END CRITICAL (write2out) endif +#endif + + return - return else ! proceed with computing the Jacobian and state update +#ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip) then - !$OMP CRITICAL (write2out) write(6,'(1x,a55,/)')'... not yet done' flush(6) - !$OMP END CRITICAL (write2out) endif +#endif endif @@ -613,18 +616,16 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) enddo enddo -!-------------------------------------------------------------------------------------------------- -! debugging the global Jacobian matrix of stress tangent +#ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(1x,a30)')'Jacobian matrix of stress' do i = 1_pInt,3_pInt*nIntFaceTot write(6,'(1x,100(e11.4,1x))')(smatrix(i,j), j = 1_pInt,3_pInt*nIntFaceTot) enddo write(6,*)' ' flush(6) - !$OMP END CRITICAL (write2out) endif +#endif !-------------------------------------------------------------------------------------------------- ! ... of the stress penalty tangent (mismatch penalty and volume penalty, computed using numerical @@ -636,10 +637,10 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) do ipert = 1_pInt,3_pInt*nIntFaceTot p_relax = relax p_relax(ipert) = relax(ipert) + pPert_RGC ! perturb the relaxation vector - homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,of) = p_relax + stt%relaxationVector(:,of) = p_relax call grainDeformation(pF,avgF,instance,of) ! rain deformation from perturbed state - call stressPenalty(pR,pNN,avgF,pF,ip,el,instance) ! stress penalty due to interface mismatch from perturbed state - call volumePenalty(pD,volDiscrep,pF,avgF,ip,el) ! stress penalty due to volume discrepancy from perturbed state + call stressPenalty(pR,DevNull33, avgF,pF,ip,el,instance,of) ! stress penalty due to interface mismatch from perturbed state + call volumePenalty(pD,devNull, avgF,pF,nGrain,instance,of) ! stress penalty due to volume discrepancy from perturbed state !-------------------------------------------------------------------------------------------------- ! computing the global stress residual array from the perturbed state @@ -675,18 +676,16 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) pmatrix(:,ipert) = p_resid/pPert_RGC enddo -!-------------------------------------------------------------------------------------------------- -! debugging the global Jacobian matrix of penalty tangent +#ifdef DEBUG if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(1x,a30)')'Jacobian matrix of penalty' do i = 1_pInt,3_pInt*nIntFaceTot write(6,'(1x,100(e11.4,1x))')(pmatrix(i,j), j = 1_pInt,3_pInt*nIntFaceTot) enddo write(6,*)' ' flush(6) - !$OMP END CRITICAL (write2out) endif +#endif !-------------------------------------------------------------------------------------------------- ! ... of the numerical viscosity traction "rmatrix" @@ -694,54 +693,48 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) forall (i=1_pInt:3_pInt*nIntFaceTot) & rmatrix(i,i) = viscModus_RGC*viscPower_RGC/(refRelaxRate_RGC*dt)* & ! tangent due to numerical viscosity traction appears (abs(drelax(i))/(refRelaxRate_RGC*dt))**(viscPower_RGC - 1.0_pReal) ! only in the main diagonal term - - - -!-------------------------------------------------------------------------------------------------- -! debugging the global Jacobian matrix of numerical viscosity tangent + +#ifdef DEBUG if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(1x,a30)')'Jacobian matrix of penalty' do i = 1_pInt,3_pInt*nIntFaceTot write(6,'(1x,100(e11.4,1x))')(rmatrix(i,j), j = 1_pInt,3_pInt*nIntFaceTot) enddo write(6,*)' ' flush(6) - !$OMP END CRITICAL (write2out) endif +#endif !-------------------------------------------------------------------------------------------------- ! The overall Jacobian matrix summarizing contributions of smatrix, pmatrix, rmatrix allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix - + +#ifdef DEBUG if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(1x,a30)')'Jacobian matrix (total)' do i = 1_pInt,3_pInt*nIntFaceTot write(6,'(1x,100(e11.4,1x))')(jmatrix(i,j), j = 1_pInt,3_pInt*nIntFaceTot) enddo write(6,*)' ' flush(6) - !$OMP END CRITICAL (write2out) endif +#endif !-------------------------------------------------------------------------------------------------- ! computing the update of the state variable (relaxation vectors) using the Jacobian matrix allocate(jnverse(3_pInt*nIntFaceTot,3_pInt*nIntFaceTot),source=0.0_pReal) call math_invert(size(jmatrix,1),jmatrix,jnverse,error) ! Compute the inverse of the overall Jacobian matrix -!-------------------------------------------------------------------------------------------------- -! debugging the inverse Jacobian matrix +#ifdef DEBUG if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(1x,a30)')'Jacobian inverse' do i = 1_pInt,3_pInt*nIntFaceTot write(6,'(1x,100(e11.4,1x))')(jnverse(i,j), j = 1_pInt,3_pInt*nIntFaceTot) enddo write(6,*)' ' flush(6) - !$OMP END CRITICAL (write2out) endif +#endif !-------------------------------------------------------------------------------------------------- ! calculate the state update (global relaxation vectors) for the next Newton-Raphson iteration @@ -750,7 +743,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) drelax(i) = drelax(i) - jnverse(i,j)*resid(j) ! Calculate the correction for the state variable enddo; enddo relax = relax + drelax ! Updateing the state variable for the next iteration - homogState(mappingHomogenization(2,ip,el))%state(1:3*nIntFaceTot,of) = relax + stt%relaxationVector(:,of) = relax if (any(abs(drelax) > maxdRelax_RGC)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large homogenization_RGC_updateState = [.true.,.false.] !$OMP CRITICAL (write2out) @@ -760,24 +753,24 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !$OMP END CRITICAL (write2out) endif -!-------------------------------------------------------------------------------------------------- -! debugging the return state +#ifdef DEBUG if (iand(debug_homogenization, debug_levelExtensive) > 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(1x,a30)')'Returned state: ' - do i = 1_pInt,3_pInt*nIntFaceTot - write(6,'(1x,2(e15.8,1x))')homogState(mappingHomogenization(2,ip,el))%state(i,of) + do i = 1_pInt,size(stt%relaxationVector(:,of)) + write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(:,of) enddo write(6,*)' ' flush(6) - !$OMP END CRITICAL (write2out) endif +#endif + + end associate contains !-------------------------------------------------------------------------------------------------- !> @brief calculate stress-like penalty due to deformation mismatch !-------------------------------------------------------------------------------------------------- - subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance) + subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of) use math, only: & math_civita use numerics, only: & @@ -786,22 +779,23 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) implicit none real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: rPen !< stress-like penalty real(pReal), dimension (3,homogenization_maxNgrains), intent(out) :: nMis !< total amount of mismatch + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef !< deformation gradients real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor - integer(pInt), intent(in) :: ip,el,instance + integer(pInt), intent(in) :: ip,el,instance,of + integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3,iGNghb3,nGDim real(pReal), dimension (3,3) :: gDef,nDef real(pReal), dimension (3) :: nVect,surfCorr real(pReal), dimension (2) :: Gmoduli - integer(pInt) :: iGrain,iGNghb,iFace,i,j,k,l,of + integer(pInt) :: iGrain,iGNghb,iFace,i,j,k,l real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb real(pReal), parameter :: nDefToler = 1.0e-10_pReal +#ifdef DEBUG logical :: debugActive +#endif - debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip - nGDim = param(instance)%Nconstituents rPen = 0.0_pReal nMis = 0.0_pReal @@ -810,25 +804,29 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) ! get the correction factor the modulus of penalty stress representing the evolution of area of ! the interfaces due to deformations - of = mappingHomogenization(1,ip,el) surfCorr = surfaceCorrection(avgF,instance,of) + associate(prm => param(instance)) +#ifdef DEBUG + debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. prm%of_debug = of + if (debugActive) then write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el write(6,*) surfCorr endif +#endif !-------------------------------------------------------------------------------------------------- ! computing the mismatch and penalty stress tensor of all grains - do iGrain = 1_pInt,product(prm%Nconstituents) + grainLoop: do iGrain = 1_pInt,product(prm%Nconstituents) Gmoduli = equivalentModuli(iGrain,ip,el) muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector iGrain3 = grain1to3(iGrain,prm%Nconstituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position - !* Looping over all six interfaces of each grain - do iFace = 1_pInt,6_pInt + interfaceLoop: do iFace = 1_pInt,6_pInt intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain nVect = interfaceNormal(intFace,instance,of) iGNghb3 = iGrain3 ! identify the neighboring grain across the interface @@ -854,13 +852,14 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) enddo; enddo nDefNorm = max(nDefToler,sqrt(nDefNorm)) ! approximation to zero mismatch if mismatch is zero (singularity) nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm ! total amount of mismatch experienced by the grain (at all six interfaces) - +#ifdef DEBUG if (debugActive) then write(6,'(1x,a20,i2,1x,a20,1x,i3)')'Mismatch to face: ',intFace(1),'neighbor grain: ',iGNghb write(6,*) transpose(nDef) write(6,'(1x,a20,e11.4)')'with magnitude: ',nDefNorm endif - +#endif + !-------------------------------------------------------------------------------------------------- ! compute the stress penalty of all interfaces do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt; do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt @@ -870,14 +869,16 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_civita(k,l,j) & *tanh(nDefNorm/xSmoo_RGC) enddo; enddo;enddo; enddo - enddo - + enddo interfaceLoop +#ifdef DEBUG if (debugActive) then - write(6,'(1x,a20,i2)')'Penalty of grain: ',iGrain - write(6,*) transpose(rPen(1:3,1:3,iGrain)) + write(6,'(1x,a20,i2)')'Penalty of grain: ',iGrain + write(6,*) transpose(rPen(1:3,1:3,iGrain)) endif +#endif - enddo + enddo grainLoop + end associate end subroutine stressPenalty @@ -886,7 +887,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- !> @brief calculate stress-like penalty due to volume discrepancy !-------------------------------------------------------------------------------------------------- - subroutine volumePenalty(vPen,vDiscrep,fDef,fAvg,ip,el) + subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of) use math, only: & math_det33, & math_inv33 @@ -898,40 +899,41 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) implicit none real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: vPen ! stress-like penalty due to volume real(pReal), intent(out) :: vDiscrep ! total volume discrepancy + real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef ! deformation gradients real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient - integer(pInt), intent(in) :: ip,& ! integration point - el + integer(pInt), intent(in) :: & + Ngrain, & + instance, & + of + real(pReal), dimension (homogenization_maxNgrains) :: gVol - integer(pInt) :: iGrain,nGrain - logical :: debugActive - - debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip - - nGrain = homogenization_Ngrains(material_homogenizationAt(el)) + integer(pInt) :: i !-------------------------------------------------------------------------------------------------- ! compute the volumes of grains and of cluster - vDiscrep = math_det33(fAvg) ! compute the volume of the cluster - do iGrain = 1_pInt,nGrain - gVol(iGrain) = math_det33(fDef(1:3,1:3,iGrain)) ! compute the volume of individual grains - vDiscrep = vDiscrep - gVol(iGrain)/real(nGrain,pReal) ! calculate the difference/dicrepancy between - ! the volume of the cluster and the the total volume of grains + vDiscrep = math_det33(fAvg) ! compute the volume of the cluster + do i = 1_pInt,nGrain + gVol(i) = math_det33(fDef(1:3,1:3,i)) ! compute the volume of individual grains + vDiscrep = vDiscrep - gVol(i)/real(nGrain,pReal) ! calculate the difference/dicrepancy between + ! the volume of the cluster and the the total volume of grains enddo !-------------------------------------------------------------------------------------------------- ! calculate the stress and penalty due to volume discrepancy vPen = 0.0_pReal - do iGrain = 1_pInt,nGrain - vPen(:,:,iGrain) = -1.0_pReal/real(nGrain,pReal)*volDiscrMod_RGC*volDiscrPow_RGC/maxVolDiscr_RGC* & + do i = 1_pInt,nGrain + vPen(:,:,i) = -1.0_pReal/real(nGrain,pReal)*volDiscrMod_RGC*volDiscrPow_RGC/maxVolDiscr_RGC* & sign((abs(vDiscrep)/maxVolDiscr_RGC)**(volDiscrPow_RGC - 1.0),vDiscrep)* & - gVol(iGrain)*transpose(math_inv33(fDef(:,:,iGrain))) + gVol(i)*transpose(math_inv33(fDef(:,:,i))) - if (debugActive) then - write(6,'(1x,a30,i2)')'Volume penalty of grain: ',iGrain - write(6,*) transpose(vPen(:,:,iGrain)) +#ifdef DEBUG + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & + .and. param(instance)%of_debug == of) then + write(6,'(1x,a30,i2)')'Volume penalty of grain: ',i + write(6,*) transpose(vPen(:,:,i)) endif +#endif enddo end subroutine volumePenalty @@ -1020,6 +1022,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) integer(pInt), intent(in) :: & instance, & of + real(pReal), dimension (3) :: aVect,nVect integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3 @@ -1027,9 +1030,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations + + associate(prm => param(instance)) + F = 0.0_pReal - do iGrain = 1_pInt,product(param(instance)%Nconstituents) - iGrain3 = grain1to3(iGrain,param(instance)%Nconstituents) + do iGrain = 1_pInt,product(prm%Nconstituents) + iGrain3 = grain1to3(iGrain,prm%Nconstituents) do iFace = 1_pInt,6_pInt intFace = getInterface(iFace,iGrain3) aVect = relaxationVector(intFace,instance,of) @@ -1040,6 +1046,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! relaxed deformation gradient enddo + end associate + end subroutine grainDeformation end function homogenization_RGC_updateState @@ -1068,50 +1076,48 @@ end subroutine homogenization_RGC_averageStressAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief return array of homogenization results for post file inclusion !-------------------------------------------------------------------------------------------------- -pure function homogenization_RGC_postResults(ip,el) result(postResults) - use material, only: & - material_homogenizationAt, & - homogenization_typeInstance,& - mappingHomogenization - +pure function homogenization_RGC_postResults(instance,of) result(postResults) implicit none integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - - integer(pInt) instance,o,c,of - real(pReal), dimension(sum(homogenization_RGC_sizePostResult(:,homogenization_typeInstance(material_homogenizationAt(el))))) :: & + instance, & + of + + integer(pInt) :: & + o,c + real(pReal), dimension(sum(homogenization_RGC_sizePostResult(:,instance))) :: & postResults - instance = homogenization_typeInstance(material_homogenizationAt(el)) - associate(prm => param(instance)) - of = mappingHomogenization(1,ip,el) + associate(prm => param(instance), stt => state(instance)) c = 0_pInt - postResults = 0.0_pReal + outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) + case (constitutivework_ID) - postResults(c+1) = state(instance)%work(of) + postResults(c+1) = stt%work(of) c = c + 1_pInt case (magnitudemismatch_ID) - postResults(c+1:c+3) = state(instance)%mismatch(1:3,of) + postResults(c+1:c+3) = stt%mismatch(1:3,of) c = c + 3_pInt case (penaltyenergy_ID) - postResults(c+1) = state(instance)%penaltyEnergy(of) + postResults(c+1) = stt%penaltyEnergy(of) c = c + 1_pInt case (volumediscrepancy_ID) - postResults(c+1) = state(instance)%volumeDiscrepancy(of) + postResults(c+1) = stt%volumeDiscrepancy(of) c = c + 1_pInt case (averagerelaxrate_ID) - postResults(c+1) = state(instance)%relaxationrate_avg(of) + postResults(c+1) = stt%relaxationrate_avg(of) c = c + 1_pInt case (maximumrelaxrate_ID) - postResults(c+1) = state(instance)%relaxationrate_max(of) + postResults(c+1) = stt%relaxationrate_max(of) c = c + 1_pInt end select + enddo outputsLoop + end associate + end function homogenization_RGC_postResults @@ -1122,6 +1128,7 @@ pure function relaxationVector(intFace,instance,of) implicit none integer(pInt), intent(in) :: instance,of + real(pReal), dimension (3) :: relaxationVector integer(pInt), dimension (4), intent(in) :: intFace !< set of interface ID in 4D array (normal and position) integer(pInt) :: & @@ -1129,9 +1136,13 @@ pure function relaxationVector(intFace,instance,of) !-------------------------------------------------------------------------------------------------- ! collect the interface relaxation vector from the global state array - relaxationVector = 0.0_pReal + iNum = interface4to1(intFace,param(instance)%Nconstituents) ! identify the position of the interface in global state array - if (iNum > 0_pInt) relaxationVector = state(instance)%relaxationVector((3*iNum-2):(3*iNum),of) + if (iNum > 0_pInt) then + relaxationVector = state(instance)%relaxationVector((3*iNum-2):(3*iNum),of) + else + relaxationVector = 0.0_pReal + endif end function relaxationVector @@ -1274,7 +1285,7 @@ pure function interface1to4(iFace1D, nGDim) integer(pInt), dimension(4) :: interface1to4 integer(pInt), intent(in) :: iFace1D !< interface ID in 1D array integer(pInt), dimension(3), intent(in) :: nGDim - integer(pInt), dimension (3) :: nIntFace + integer(pInt), dimension(3) :: nIntFace !-------------------------------------------------------------------------------------------------- ! compute the total number of interfaces, which ... From 7f459e85f182784350a3c6d1fcedf15a47d49ada Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 12 Jan 2019 23:22:13 +0100 Subject: [PATCH 044/107] no need to be real state --- src/homogenization_RGC.f90 | 71 ++++++++++++++++++++------------------ 1 file changed, 37 insertions(+), 34 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 7374abcd8..1448b5a76 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -47,23 +47,28 @@ module homogenization_RGC type, private :: tRGCstate real(pReal), pointer, dimension(:) :: & work, & - penaltyEnergy, & - volumeDiscrepancy, & - relaxationRate_avg, & - relaxationRate_max + penaltyEnergy real(pReal), pointer, dimension(:,:) :: & - relaxationVector, & - mismatch + relaxationVector end type tRGCstate type, private :: tRGCdependentState + real(pReal), allocatable, dimension(:) :: & + volumeDiscrepancy, & + relaxationRate_avg, & + relaxationRate_max + real(pReal), allocatable, dimension(:,:) :: & + mismatch real(pReal), allocatable, dimension(:,:,:) :: & orientation end type tRGCdependentState - type(tparameters), dimension(:), allocatable, private :: param !< containers of parameters (len Ninstance) - type(tRGCstate), dimension(:), allocatable, private :: state - type(tRGCdependentState), dimension(:), allocatable, private :: dependentState + type(tparameters), dimension(:), allocatable, private :: & + param + type(tRGCstate), dimension(:), allocatable, private :: & + state + type(tRGCdependentState), dimension(:), allocatable, private :: & + dependentState public :: & homogenization_RGC_init, & @@ -215,9 +220,7 @@ subroutine homogenization_RGC_init() + prm%Nconstituents(1)*(prm%Nconstituents(2)-1_pInt)*prm%Nconstituents(3) & + prm%Nconstituents(1)*prm%Nconstituents(2)*(prm%Nconstituents(3)-1_pInt)) sizeState = nIntFaceTot & - + size(['avg constitutive work']) + size(['overall mismatch']) * 3_pInt & - + size(['average penalty energy ','volume discrepancy ',& - 'avg relaxation rate component ','max relaxation rate componenty']) + + size(['avg constitutive work ','average penalty energy']) homogState(h)%sizeState = sizeState homogState(h)%sizePostResults = sum(homogenization_RGC_sizePostResult(:,homogenization_typeInstance(h))) @@ -227,13 +230,13 @@ subroutine homogenization_RGC_init() stt%relaxationVector => homogState(h)%state(1:nIntFaceTot,:) stt%work => homogState(h)%state(nIntFaceTot+1,:) - stt%mismatch => homogState(h)%state(nIntFaceTot+2:nIntFaceTot+4,:) - stt%penaltyEnergy => homogState(h)%state(nIntFaceTot+5,:) - stt%volumeDiscrepancy => homogState(h)%state(nIntFaceTot+6,:) - stt%relaxationRate_avg => homogState(h)%state(nIntFaceTot+7,:) - stt%relaxationRate_max => homogState(h)%state(nIntFaceTot+8,:) + stt%penaltyEnergy => homogState(h)%state(nIntFaceTot+2,:) - allocate(dst%orientation(3,3,NofMyHomog)) + allocate(dst%volumeDiscrepancy( NofMyHomog)) + allocate(dst%relaxationRate_avg( NofMyHomog)) + allocate(dst%relaxationRate_max( NofMyHomog)) + allocate(dst%mismatch( 3, NofMyHomog)) + allocate(dst%orientation( 3,3,NofMyHomog)) !-------------------------------------------------------------------------------------------------- @@ -381,7 +384,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) instance = homogenization_typeInstance(material_homogenizationAt(el)) of = mappingHomogenization(1,ip,el) - associate(stt => state(instance), prm => param(instance)) + associate(stt => state(instance), dst => dependentState(instance), prm => param(instance)) !-------------------------------------------------------------------------------------------------- ! get the dimension of the cluster (grains and interfaces) @@ -415,7 +418,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! calculating volume discrepancy and stress penalty related to overall volume discrepancy - call volumePenalty(D,stt%volumeDiscrepancy(of),avgF,F,nGrain,instance,of) + call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of) #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then @@ -519,21 +522,21 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) enddo; enddo enddo - stt%mismatch(1:3,of) = sum(NN,2)/real(nGrain,pReal) - stt%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) - stt%relaxationRate_max(of) = maxval(abs(drelax))/dt + dst%mismatch(1:3,of) = sum(NN,2)/real(nGrain,pReal) + dst%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) + dst%relaxationRate_max(of) = maxval(abs(drelax))/dt #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip) then write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',stt%work(of) - write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',stt%mismatch(1,of), & - stt%mismatch(2,of), & - stt%mismatch(3,of) + write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',dst%mismatch(1,of), & + dst%mismatch(2,of), & + dst%mismatch(3,of) write(6,'(1x,a30,1x,e15.8)') 'Penalty energy: ', stt%penaltyEnergy(of) - write(6,'(1x,a30,1x,e15.8,/)') 'Volume discrepancy: ', stt%volumeDiscrepancy(of) - write(6,'(1x,a30,1x,e15.8)') 'Maximum relaxation rate: ', stt%relaxationRate_max(of) - write(6,'(1x,a30,1x,e15.8,/)') 'Average relaxation rate: ', stt%relaxationRate_avg(of) + write(6,'(1x,a30,1x,e15.8,/)') 'Volume discrepancy: ', dst%volumeDiscrepancy(of) + write(6,'(1x,a30,1x,e15.8)') 'Maximum relaxation rate: ', dst%relaxationRate_max(of) + write(6,'(1x,a30,1x,e15.8,/)') 'Average relaxation rate: ', dst%relaxationRate_avg(of) flush(6) endif #endif @@ -1087,7 +1090,7 @@ pure function homogenization_RGC_postResults(instance,of) result(postResults) real(pReal), dimension(sum(homogenization_RGC_sizePostResult(:,instance))) :: & postResults - associate(prm => param(instance), stt => state(instance)) + associate(stt => state(instance), dst => dependentState(instance), prm => param(instance)) c = 0_pInt @@ -1098,19 +1101,19 @@ pure function homogenization_RGC_postResults(instance,of) result(postResults) postResults(c+1) = stt%work(of) c = c + 1_pInt case (magnitudemismatch_ID) - postResults(c+1:c+3) = stt%mismatch(1:3,of) + postResults(c+1:c+3) = dst%mismatch(1:3,of) c = c + 3_pInt case (penaltyenergy_ID) postResults(c+1) = stt%penaltyEnergy(of) c = c + 1_pInt case (volumediscrepancy_ID) - postResults(c+1) = stt%volumeDiscrepancy(of) + postResults(c+1) = dst%volumeDiscrepancy(of) c = c + 1_pInt case (averagerelaxrate_ID) - postResults(c+1) = stt%relaxationrate_avg(of) + postResults(c+1) = dst%relaxationrate_avg(of) c = c + 1_pInt case (maximumrelaxrate_ID) - postResults(c+1) = stt%relaxationrate_max(of) + postResults(c+1) = dst%relaxationrate_max(of) c = c + 1_pInt end select From fe28e0d7396964f49216e0fe8ca4d2a4830aae3c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Jan 2019 08:47:01 +0100 Subject: [PATCH 045/107] better follow the same conventions everywhere --- src/math.f90 | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/src/math.f90 b/src/math.f90 index cf942ab68..923e2badf 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -99,6 +99,7 @@ module math math_invert33, & math_invSym3333, & math_invert, & + math_invert2, & math_symmetric33, & math_symmetric66, & math_skew33, & @@ -779,6 +780,7 @@ end function math_inv33 ! direct Cramer inversion of matrix A. ! also returns determinant ! returns error if not possible, i.e. if det close to zero +! ToDo: has wrong order of arguments (out should be first) !-------------------------------------------------------------------------------------------------- pure subroutine math_invert33(A, InvA, DetA, error) use prec, only: & @@ -847,8 +849,37 @@ function math_invSym3333(A) end function math_invSym3333 +!-------------------------------------------------------------------------------------------------- +!> @brief invert quare matrix of arbitrary dimension +!-------------------------------------------------------------------------------------------------- +subroutine math_invert2(InvA, error, A) + + implicit none + real(pReal), dimension(:,:), intent(in) :: A + + real(pReal), dimension(size(A,1),size(A,2)), intent(out) :: invA + logical, intent(out) :: error + + integer(pInt) :: ierr + integer(pInt), dimension(size(A,1)) :: ipiv + real(pReal), dimension(size(A,1)) :: work + + external :: & + dgetrf, & + dgetri + + invA = A + call dgetrf(size(A,1),size(A,2),invA,size(A,1),ipiv,ierr) + call dgetri(size(A,1),InvA,size(A,1),ipiv,work,size(A,1),ierr) + error = merge(.true.,.false., ierr /= 0_pInt) + +end subroutine math_invert2 + + !-------------------------------------------------------------------------------------------------- !> @brief invert matrix of arbitrary dimension +! Obsolete: has wrong order of arguments and superflouous argumen myDim +! use math_inver2 instead !-------------------------------------------------------------------------------------------------- subroutine math_invert(myDim,A, InvA, error) @@ -1926,6 +1957,7 @@ end function math_symmetricEulers !-------------------------------------------------------------------------------------------------- !> @brief eigenvalues and eigenvectors of symmetric matrix m +! ToDo: has wrong order of arguments !-------------------------------------------------------------------------------------------------- subroutine math_eigenValuesVectorsSym(m,values,vectors,error) @@ -1952,6 +1984,7 @@ end subroutine math_eigenValuesVectorsSym !> @author Joachim Kopp, Max–Planck–Institut für Kernphysik, Heidelberg (Copyright (C) 2006) !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @details See http://arxiv.org/abs/physics/0610206 (DSYEVH3) +! ToDo: has wrong order of arguments !-------------------------------------------------------------------------------------------------- subroutine math_eigenValuesVectorsSym33(m,values,vectors) From 11bb6f1f47748b7bc396205d0b0ff05097260a26 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Jan 2019 09:14:23 +0100 Subject: [PATCH 046/107] limit size to actual Ngrains, not potential maximum --- src/homogenization.f90 | 43 ++++-------- src/homogenization_RGC.f90 | 115 +++++++++++++++---------------- src/homogenization_isostrain.f90 | 30 +++----- 3 files changed, 78 insertions(+), 110 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 3f62ffd7d..aadc7ee89 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -743,10 +743,8 @@ subroutine homogenization_partitionDeformation(ip,el) use mesh, only: & mesh_element use material, only: & - mappingHomogenization, & homogenization_type, & - homogenization_maxNgrains, & - homogenization_typeInstance, & + homogenization_Ngrains, & HOMOGENIZATION_NONE_ID, & HOMOGENIZATION_ISOSTRAIN_ID, & HOMOGENIZATION_RGC_ID @@ -761,28 +759,20 @@ subroutine homogenization_partitionDeformation(ip,el) integer(pInt), intent(in) :: & ip, & !< integration point el !< element number - integer(pInt) :: & - instance, of chosenHomogenization: select case(homogenization_type(mesh_element(3,el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el) = 0.0_pReal - crystallite_partionedF(1:3,1:3,1:1,ip,el) = & - spread(materialpoint_subF(1:3,1:3,ip,el),3,1) + crystallite_partionedF(1:3,1:3,1,ip,el) = materialpoint_subF(1:3,1:3,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - instance = homogenization_typeInstance(mesh_element(3,el)) call homogenization_isostrain_partitionDeformation(& - crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), & - materialpoint_subF(1:3,1:3,ip,el),& - instance) + crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + materialpoint_subF(1:3,1:3,ip,el)) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - instance = homogenization_typeInstance(mesh_element(3,el)) - of = mappingHomogenization(1,ip,el) call homogenization_RGC_partitionDeformation(& - crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), & + crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & materialpoint_subF(1:3,1:3,ip,el),& ip, & el) @@ -869,7 +859,7 @@ subroutine homogenization_averageStressAndItsTangent(ip,el) use material, only: & homogenization_type, & homogenization_typeInstance, & - homogenization_maxNgrains, & + homogenization_Ngrains, & HOMOGENIZATION_NONE_ID, & HOMOGENIZATION_ISOSTRAIN_ID, & HOMOGENIZATION_RGC_ID @@ -884,32 +874,27 @@ subroutine homogenization_averageStressAndItsTangent(ip,el) integer(pInt), intent(in) :: & ip, & !< integration point el !< element number - integer(pInt) :: & - instance chosenHomogenization: select case(homogenization_type(mesh_element(3,el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - materialpoint_P(1:3,1:3,ip,el) = sum(crystallite_P(1:3,1:3,1:1,ip,el),3) - materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el) & - = sum(crystallite_dPdF(1:3,1:3,1:3,1:3,1:1,ip,el),5) + materialpoint_P(1:3,1:3,ip,el) = crystallite_P(1:3,1:3,1,ip,el) + materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el) = crystallite_dPdF(1:3,1:3,1:3,1:3,1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - instance = homogenization_typeInstance(mesh_element(3,el)) call homogenization_isostrain_averageStressAndItsTangent(& materialpoint_P(1:3,1:3,ip,el), & materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),& - crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), & - crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), & - instance) + crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + homogenization_typeInstance(mesh_element(3,el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - instance = homogenization_typeInstance(mesh_element(3,el)) call homogenization_RGC_averageStressAndItsTangent(& materialpoint_P(1:3,1:3,ip,el), & materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),& - crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), & - crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), & - instance) + crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + homogenization_typeInstance(mesh_element(3,el))) end select chosenHomogenization end subroutine homogenization_averageStressAndItsTangent diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 1448b5a76..6c67249d0 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -66,7 +66,8 @@ module homogenization_RGC type(tparameters), dimension(:), allocatable, private :: & param type(tRGCstate), dimension(:), allocatable, private :: & - state + state, & + state0 type(tRGCdependentState), dimension(:), allocatable, private :: & dependentState @@ -100,24 +101,35 @@ subroutine homogenization_RGC_init() pReal, & pInt use debug, only: & - debug_level, & - debug_homogenization, & - debug_levelBasic, & - debug_levelExtensive +#ifdef DEBUG + debug_i, & + debug_e, & +#endif + debug_level, & + debug_homogenization, & + debug_levelBasic use math, only: & math_EulerToR,& INRAD use IO, only: & IO_error, & IO_timeStamp - use material + use material, only: & + homogenization_type, & + material_homog, & + homogState, & + HOMOGENIZATION_RGC_ID, & + HOMOGENIZATION_RGC_LABEL, & + homogenization_typeInstance, & + homogenization_Noutput, & + homogenization_Ngrains use config, only: & config_homogenization implicit none integer(pInt) :: & Ninstance, & - h, i, j, & + h, i, & NofMyHomog, outputSize, & sizeState, nIntFaceTot @@ -143,6 +155,7 @@ subroutine homogenization_RGC_init() allocate(param(Ninstance)) allocate(state(Ninstance)) + allocate(state0(Ninstance)) allocate(dependentState(Ninstance)) allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),Ninstance),source=0_pInt) @@ -153,13 +166,14 @@ subroutine homogenization_RGC_init() if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle associate(prm => param(homogenization_typeInstance(h)), & stt => state(homogenization_typeInstance(h)), & + st0 => state0(homogenization_typeInstance(h)), & dst => dependentState(homogenization_typeInstance(h)), & config => config_homogenization(h)) #ifdef DEBUG - if (h==material_homogenizationAt(debug_e)) then - prm%of_debug = mappingHomogenization(1,debug_i,debug_e) - endif + !if (h==material_homogenizationAt(debug_e)) then + ! prm%of_debug = mappingHomogenization(1,debug_i,debug_e) + !endif #endif prm%Nconstituents = config%getInts('clustersize',requiredShape=[3]) @@ -206,15 +220,6 @@ subroutine homogenization_RGC_init() enddo - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then - write(6,'(a15,1x,i4,/)') 'instance: ', homogenization_typeInstance(h) - write(6,'(a25,3(1x,i8))') 'cluster size: ',(prm%Nconstituents(j),j=1_pInt,3_pInt) - write(6,'(a25,1x,e10.3)') 'scaling parameter: ', prm%xiAlpha - write(6,'(a25,1x,e10.3)') 'over-proportionality: ', prm%ciAlpha - write(6,'(a25,3(1x,e10.3))') 'grain size: ',(prm%dAlpha(j),j=1_pInt,3_pInt) - write(6,'(a25,3(1x,e10.3))') 'cluster orientation: ',(prm%angles(j),j=1_pInt,3_pInt) - endif - NofMyHomog = count(material_homog == h) nIntFaceTot = 3_pInt*( (prm%Nconstituents(1)-1_pInt)*prm%Nconstituents(2)*prm%Nconstituents(3) & + prm%Nconstituents(1)*(prm%Nconstituents(2)-1_pInt)*prm%Nconstituents(3) & @@ -229,6 +234,7 @@ subroutine homogenization_RGC_init() allocate(homogState(h)%state (sizeState,NofMyHomog), source=0.0_pReal) stt%relaxationVector => homogState(h)%state(1:nIntFaceTot,:) + st0%relaxationVector => homogState(h)%state0(1:nIntFaceTot,:) stt%work => homogState(h)%state(nIntFaceTot+1,:) stt%penaltyEnergy => homogState(h)%state(nIntFaceTot+2,:) @@ -238,12 +244,9 @@ subroutine homogenization_RGC_init() allocate(dst%mismatch( 3, NofMyHomog)) allocate(dst%orientation( 3,3,NofMyHomog)) - !-------------------------------------------------------------------------------------------------- ! assigning cluster orientations - do j=1, NofMyHomog - dst%orientation(1:3,1:3,j) = math_EulerToR(prm%angles*inRad) !ToDo: use spread - enddo + dst%orientation = spread(math_EulerToR(prm%angles*inRad),3,NofMyHomog) end associate @@ -262,14 +265,12 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) debug_homogenization, & debug_levelExtensive #endif - use material, only: & - homogenization_maxNgrains implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned F per grain + real(pReal), dimension (:,:,:), intent(out) :: F !< partioned F per grain - real(pReal), dimension (3,3), intent(in) :: avgF !< averaged F - integer(pInt), intent(in) :: & + real(pReal), dimension (:,:), intent(in) :: avgF !< averaged F + integer(pInt), intent(in) :: & instance, & of @@ -278,10 +279,10 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) integer(pInt), dimension (3) :: iGrain3 integer(pInt) :: iGrain,iFace,i,j -!-------------------------------------------------------------------------------------------------- -! compute the deformation gradient of individual grains due to relaxations associate(prm => param(instance)) +!-------------------------------------------------------------------------------------------------- +! compute the deformation gradient of individual grains due to relaxations F = 0.0_pReal do iGrain = 1_pInt,product(prm%Nconstituents) iGrain3 = grain1to3(iGrain,prm%Nconstituents) @@ -294,8 +295,6 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of) enddo F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient -!-------------------------------------------------------------------------------------------------- -! debugging the grain deformation gradients #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain @@ -329,14 +328,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) debug_i #endif use math, only: & - math_invert + math_invert2 use material, only: & material_homogenizationAt, & - homogenization_maxNgrains, & homogenization_typeInstance, & - homogState, & - mappingHomogenization, & - homogenization_Ngrains + mappingHomogenization, & + homogenization_maxNgrains use numerics, only: & absTol_RGC, & relTol_RGC, & @@ -380,11 +377,10 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) return endif zeroTimeStep - instance = homogenization_typeInstance(material_homogenizationAt(el)) of = mappingHomogenization(1,ip,el) - associate(stt => state(instance), dst => dependentState(instance), prm => param(instance)) + associate(stt => state(instance), st0 => state0(instance), dst => dependentState(instance), prm => param(instance)) !-------------------------------------------------------------------------------------------------- ! get the dimension of the cluster (grains and interfaces) @@ -399,8 +395,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) allocate(resid(3_pInt*nIntFaceTot), source=0.0_pReal) allocate(tract(nIntFaceTot,3), source=0.0_pReal) relax = stt%relaxationVector(:,of) - drelax = relax & - - homogState(mappingHomogenization(2,ip,el))%state0(1:3_pInt*nIntFaceTot,of) + drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then @@ -513,7 +508,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! compute/update the state for postResult, i.e., all energy densities computed by time-integration - do iGrain = 1_pInt,homogenization_Ngrains(material_homogenizationAt(el)) ! time-integration loop for work and energy + do iGrain = 1_pInt,product(prm%Nconstituents) do i = 1_pInt,3_pInt;do j = 1_pInt,3_pInt stt%work(of) = stt%work(of) & + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) @@ -726,7 +721,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! computing the update of the state variable (relaxation vectors) using the Jacobian matrix allocate(jnverse(3_pInt*nIntFaceTot,3_pInt*nIntFaceTot),source=0.0_pReal) - call math_invert(size(jmatrix,1),jmatrix,jnverse,error) ! Compute the inverse of the overall Jacobian matrix + call math_invert2(jnverse,error,jmatrix) #ifdef DEBUG if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then @@ -745,8 +740,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) do i = 1_pInt,3_pInt*nIntFaceTot;do j = 1_pInt,3_pInt*nIntFaceTot drelax(i) = drelax(i) - jnverse(i,j)*resid(j) ! Calculate the correction for the state variable enddo; enddo - relax = relax + drelax ! Updateing the state variable for the next iteration - stt%relaxationVector(:,of) = relax + stt%relaxationVector(:,of) = relax + drelax ! Updateing the state variable for the next iteration if (any(abs(drelax) > maxdRelax_RGC)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large homogenization_RGC_updateState = [.true.,.false.] !$OMP CRITICAL (write2out) @@ -760,7 +754,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) if (iand(debug_homogenization, debug_levelExtensive) > 0_pInt) then write(6,'(1x,a30)')'Returned state: ' do i = 1_pInt,size(stt%relaxationVector(:,of)) - write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(:,of) + write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) enddo write(6,*)' ' flush(6) @@ -813,7 +807,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) #ifdef DEBUG debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. prm%of_debug = of + .and. prm%of_debug == of if (debugActive) then write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el @@ -969,9 +963,9 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) do iBase = 1_pInt,3_pInt nVect = interfaceNormal([iBase,1_pInt,1_pInt,1_pInt],instance,of) do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt - surfaceCorrection(iBase) = surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j) ! compute the component of (the inverse of) the stretch in the direction of the normal + surfaceCorrection(iBase) = surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j) ! compute the component of (the inverse of) the stretch in the direction of the normal enddo; enddo - surfaceCorrection(iBase) = sqrt(surfaceCorrection(iBase))*detF ! get the surface correction factor (area contraction/enlargement) + surfaceCorrection(iBase) = sqrt(surfaceCorrection(iBase))*detF ! get the surface correction factor (area contraction/enlargement) enddo end function surfaceCorrection @@ -988,8 +982,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) real(pReal), dimension(2) :: equivalentModuli integer(pInt), intent(in) :: & grainID,& - ip, & !< integration point number - el !< element number + ip, & !< integration point number + el !< element number real(pReal), dimension(6,6) :: elasTens real(pReal) :: & cEquiv_11, & @@ -1015,14 +1009,15 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- !> @brief calculating the grain deformation gradient (the same with - ! homogenization_RGC_partionDeformation, but used only for perturbation scheme) + ! homogenization_RGC_partitionDeformation, but used only for perturbation scheme) !-------------------------------------------------------------------------------------------------- subroutine grainDeformation(F, avgF, instance, of) implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partioned F per grain - real(pReal), dimension (3,3), intent(in) :: avgF !< - integer(pInt), intent(in) :: & + real(pReal), dimension (:,:,:), intent(out) :: F !< partioned F per grain + + real(pReal), dimension (:,:), intent(in) :: avgF !< averaged F + integer(pInt), intent(in) :: & instance, & of @@ -1031,7 +1026,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) integer(pInt), dimension (3) :: iGrain3 integer(pInt) :: iGrain,iFace,i,j - !-------------------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations associate(prm => param(instance)) @@ -1060,14 +1055,13 @@ end function homogenization_RGC_updateState !> @brief derive average stress and stiffness from constituent quantities !-------------------------------------------------------------------------------------------------- subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) - use material, only: & - homogenization_maxNgrains implicit none real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: P !< array of current grain stresses - real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< array of current grain stiffnesses + + real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses + real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses integer(pInt), intent(in) :: instance avgP = sum(P,3) /real(product(param(instance)%Nconstituents),pReal) @@ -1080,6 +1074,7 @@ end subroutine homogenization_RGC_averageStressAndItsTangent !> @brief return array of homogenization results for post file inclusion !-------------------------------------------------------------------------------------------------- pure function homogenization_RGC_postResults(instance,of) result(postResults) + implicit none integer(pInt), intent(in) :: & instance, & diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index 9987b7e61..42c0c9287 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -110,26 +110,16 @@ end subroutine homogenization_isostrain_init !-------------------------------------------------------------------------------------------------- !> @brief partitions the deformation gradient onto the constituents !-------------------------------------------------------------------------------------------------- -subroutine homogenization_isostrain_partitionDeformation(F,avgF,instance) +subroutine homogenization_isostrain_partitionDeformation(F,avgF) use prec, only: & pReal - use material, only: & - homogenization_maxNgrains implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: F !< partitioned deformation gradient + real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient - real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point - integer(pInt), intent(in) :: instance + real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point - - associate(prm => param(instance)) - - F(1:3,1:3,1:prm%Nconstituents) = spread(avgF,3,prm%Nconstituents) - if (homogenization_maxNgrains > prm%Nconstituents) & - F(1:3,1:3,prm%Nconstituents+1_pInt:homogenization_maxNgrains) = 0.0_pReal - - end associate + F = spread(avgF,3,size(F,3)) end subroutine homogenization_isostrain_partitionDeformation @@ -140,16 +130,14 @@ end subroutine homogenization_isostrain_partitionDeformation subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) use prec, only: & pReal - use material, only: & - homogenization_maxNgrains implicit none - real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point - real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point + real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point + real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: P !< partitioned stresses - real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< partitioned stiffnesses - integer(pInt), intent(in) :: instance + real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses + real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + integer(pInt), intent(in) :: instance associate(prm => param(instance)) From 57c6271894b29ab0e7fe47ed6433370744c9003d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Jan 2019 09:33:47 +0100 Subject: [PATCH 047/107] using less global variables --- src/homogenization.f90 | 10 +++---- src/homogenization_RGC.f90 | 60 ++++++++++++++++++++------------------ 2 files changed, 36 insertions(+), 34 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index aadc7ee89..6c968f723 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -792,7 +792,7 @@ function homogenization_updateState(ip,el) homogenization_type, & thermal_type, & damage_type, & - homogenization_maxNgrains, & + homogenization_Ngrains, & HOMOGENIZATION_RGC_ID, & THERMAL_adiabatic_ID, & DAMAGE_local_ID @@ -819,12 +819,12 @@ function homogenization_updateState(ip,el) case (HOMOGENIZATION_RGC_ID) chosenHomogenization homogenization_updateState = & homogenization_updateState .and. & - homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), & - crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), & - crystallite_partionedF0(1:3,1:3,1:homogenization_maxNgrains,ip,el),& + homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el),& materialpoint_subF(1:3,1:3,ip,el),& materialpoint_subdt(ip,el), & - crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), & + crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & ip, & el) end select chosenHomogenization diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 6c67249d0..8a101eb72 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -332,8 +332,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) use material, only: & material_homogenizationAt, & homogenization_typeInstance, & - mappingHomogenization, & - homogenization_maxNgrains + mappingHomogenization use numerics, only: & absTol_RGC, & relTol_RGC, & @@ -347,30 +346,33 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: & + real(pReal), dimension (:,:,:), intent(in) :: & P,& !< array of P F,& !< array of F F0 !< array of initial F - real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< array of current grain stiffness - real(pReal), dimension (3,3), intent(in) :: avgF !< average F - real(pReal), intent(in) :: dt !< time increment - integer(pInt), intent(in) :: & + real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< array of current grain stiffness + real(pReal), dimension (3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer(pInt), intent(in) :: & ip, & !< integration point number el !< element number logical, dimension(2) :: homogenization_RGC_updateState + integer(pInt), dimension (4) :: intFaceN,intFaceP,faceID integer(pInt), dimension (3) :: nGDim,iGr3N,iGr3P,stresLoc - integer(pInt), dimension (2) :: residLoc - integer(pInt) instance,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain, of - real(pReal), dimension (3,3,homogenization_maxNgrains) :: R,pF,pR,D,pD - real(pReal), dimension (3,homogenization_maxNgrains) :: NN,devNull33 - real(pReal), dimension (3) :: normP,normN,mornP,mornN - real(pReal) :: residMax,stresMax,devNull - logical error - + integer(pInt) :: instance,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain, of + real(pReal), dimension (3,3,size(P,3)) :: R,pF,pR,D,pD + real(pReal), dimension (3,size(P,3)) :: NN,devNull + real(pReal), dimension (3) :: normP,normN,mornP,mornN + real(pReal) :: residMax,stresMax + logical :: error real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix real(pReal), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax +#ifdef DEBUG + integer(pInt), dimension (3) :: stresLoc + integer(pInt), dimension (2) :: residLoc +#endif zeroTimeStep: if(dEq0(dt)) then homogenization_RGC_updateState = .true. ! pretend everything is fine and return @@ -475,13 +477,13 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! convergence check for stress residual stresMax = maxval(abs(P)) ! get the maximum of first Piola-Kirchhoff (material) stress - stresLoc = int(maxloc(abs(P)),pInt) ! get the location of the maximum stress residMax = maxval(abs(tract)) ! get the maximum of the residual - residLoc = int(maxloc(abs(tract)),pInt) ! get the position of the maximum residual #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip) then + stresLoc = int(maxloc(abs(P)),pInt) ! get the location of the maximum stress + residLoc = int(maxloc(abs(tract)),pInt) ! get the position of the maximum residual write(6,'(1x,a)')' ' write(6,'(1x,a,1x,i2,1x,i4)')'RGC residual check ...',ip,el write(6,'(1x,a15,1x,e15.8,1x,a7,i3,1x,a12,i2,i2)')'Max stress: ',stresMax, & @@ -637,8 +639,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) p_relax(ipert) = relax(ipert) + pPert_RGC ! perturb the relaxation vector stt%relaxationVector(:,of) = p_relax call grainDeformation(pF,avgF,instance,of) ! rain deformation from perturbed state - call stressPenalty(pR,DevNull33, avgF,pF,ip,el,instance,of) ! stress penalty due to interface mismatch from perturbed state - call volumePenalty(pD,devNull, avgF,pF,nGrain,instance,of) ! stress penalty due to volume discrepancy from perturbed state + call stressPenalty(pR,DevNull, avgF,pF,ip,el,instance,of) ! stress penalty due to interface mismatch from perturbed state + call volumePenalty(pD,devNull(1,1), avgF,pF,nGrain,instance,of) ! stress penalty due to volume discrepancy from perturbed state !-------------------------------------------------------------------------------------------------- ! computing the global stress residual array from the perturbed state @@ -774,12 +776,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) xSmoo_RGC implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: rPen !< stress-like penalty - real(pReal), dimension (3,homogenization_maxNgrains), intent(out) :: nMis !< total amount of mismatch + real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty + real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef !< deformation gradients - real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor - integer(pInt), intent(in) :: ip,el,instance,of + real(pReal), dimension (:,:,:), intent(in) :: fDef !< deformation gradients + real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor + integer(pInt), intent(in) :: ip,el,instance,of integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3,iGNghb3,nGDim @@ -894,17 +896,17 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) volDiscrPow_RGC implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: vPen ! stress-like penalty due to volume - real(pReal), intent(out) :: vDiscrep ! total volume discrepancy + real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume + real(pReal), intent(out) :: vDiscrep ! total volume discrepancy - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef ! deformation gradients - real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient + real(pReal), dimension (:,:,:), intent(in) :: fDef ! deformation gradients + real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient integer(pInt), intent(in) :: & Ngrain, & instance, & of - real(pReal), dimension (homogenization_maxNgrains) :: gVol + real(pReal), dimension(size(vPen,3)) :: gVol integer(pInt) :: i !-------------------------------------------------------------------------------------------------- From 49ef8e70d6435a1f86bcdc71e0dec2358df651a7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Jan 2019 09:48:47 +0100 Subject: [PATCH 048/107] no need to prefix private functions --- src/homogenization.f90 | 72 ++++++++++++++++++++---------------------- 1 file changed, 35 insertions(+), 37 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 6c968f723..795639b23 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -45,10 +45,10 @@ module homogenization materialpoint_stressAndItsTangent, & materialpoint_postResults private :: & - homogenization_partitionDeformation, & - homogenization_updateState, & - homogenization_averageStressAndItsTangent, & - homogenization_postResults + partitionDeformation, & + updateState, & + averageStressAndItsTangent, & + postResults contains @@ -118,12 +118,9 @@ subroutine homogenization_init !-------------------------------------------------------------------------------------------------- ! parse homogenization from config file - if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) & - call homogenization_none_init - if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) & - call homogenization_isostrain_init - if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) & - call homogenization_RGC_init + if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call homogenization_none_init + if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call homogenization_isostrain_init + if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call homogenization_RGC_init !-------------------------------------------------------------------------------------------------- ! parse thermal from config file @@ -611,7 +608,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) IpLooping2: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) if ( materialpoint_requested(i,e) .and. & ! process requested but... .not. materialpoint_doneAndHappy(1,i,e)) then ! ...not yet done material points - call homogenization_partitionDeformation(i,e) ! partition deformation onto constituents + call partitionDeformation(i,e) ! partition deformation onto constituents crystallite_dt(1:myNgrains,i,e) = materialpoint_subdt(i,e) ! propagate materialpoint dt to grains crystallite_requested(1:myNgrains,i,e) = .true. ! request calculation for constituents else @@ -638,7 +635,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) materialpoint_doneAndHappy(1:2,i,e) = [.true.,.false.] materialpoint_converged(i,e) = .false. else - materialpoint_doneAndHappy(1:2,i,e) = homogenization_updateState(i,e) + materialpoint_doneAndHappy(1:2,i,e) = updateState(i,e) materialpoint_converged(i,e) = all(materialpoint_doneAndHappy(1:2,i,e)) ! converged if done and happy endif endif @@ -657,7 +654,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) !$OMP PARALLEL DO elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2) IpLooping4: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - call homogenization_averageStressAndItsTangent(i,e) + call averageStressAndItsTangent(i,e) enddo IpLooping4 enddo elementLooping4 !$OMP END PARALLEL DO @@ -715,7 +712,7 @@ subroutine materialpoint_postResults thePos = thePos + 1_pInt if (theSize > 0_pInt) then ! any homogenization results to mention? - materialpoint_results(thePos+1:thePos+theSize,i,e) = homogenization_postResults(i,e) ! tell homogenization results + materialpoint_results(thePos+1:thePos+theSize,i,e) = postResults(i,e) ! tell homogenization results thePos = thePos + theSize endif @@ -739,7 +736,7 @@ end subroutine materialpoint_postResults !-------------------------------------------------------------------------------------------------- !> @brief partition material point def grad onto constituents !-------------------------------------------------------------------------------------------------- -subroutine homogenization_partitionDeformation(ip,el) +subroutine partitionDeformation(ip,el) use mesh, only: & mesh_element use material, only: & @@ -778,14 +775,14 @@ subroutine homogenization_partitionDeformation(ip,el) el) end select chosenHomogenization -end subroutine homogenization_partitionDeformation +end subroutine partitionDeformation !-------------------------------------------------------------------------------------------------- !> @brief update the internal state of the homogenization scheme and tell whether "done" and !> "happy" with result !-------------------------------------------------------------------------------------------------- -function homogenization_updateState(ip,el) +function updateState(ip,el) use mesh, only: & mesh_element use material, only: & @@ -812,13 +809,13 @@ function homogenization_updateState(ip,el) integer(pInt), intent(in) :: & ip, & !< integration point el !< element number - logical, dimension(2) :: homogenization_updateState + logical, dimension(2) :: updateState - homogenization_updateState = .true. + updateState = .true. chosenHomogenization: select case(homogenization_type(mesh_element(3,el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - homogenization_updateState = & - homogenization_updateState .and. & + updateState = & + updateState .and. & homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el),& @@ -831,8 +828,8 @@ function homogenization_updateState(ip,el) chosenThermal: select case (thermal_type(mesh_element(3,el))) case (THERMAL_adiabatic_ID) chosenThermal - homogenization_updateState = & - homogenization_updateState .and. & + updateState = & + updateState .and. & thermal_adiabatic_updateState(materialpoint_subdt(ip,el), & ip, & el) @@ -840,20 +837,20 @@ function homogenization_updateState(ip,el) chosenDamage: select case (damage_type(mesh_element(3,el))) case (DAMAGE_local_ID) chosenDamage - homogenization_updateState = & - homogenization_updateState .and. & + updateState = & + updateState .and. & damage_local_updateState(materialpoint_subdt(ip,el), & ip, & el) end select chosenDamage -end function homogenization_updateState +end function updateState !-------------------------------------------------------------------------------------------------- !> @brief derive average stress and stiffness from constituent quantities !-------------------------------------------------------------------------------------------------- -subroutine homogenization_averageStressAndItsTangent(ip,el) +subroutine averageStressAndItsTangent(ip,el) use mesh, only: & mesh_element use material, only: & @@ -897,13 +894,14 @@ subroutine homogenization_averageStressAndItsTangent(ip,el) homogenization_typeInstance(mesh_element(3,el))) end select chosenHomogenization -end subroutine homogenization_averageStressAndItsTangent +end subroutine averageStressAndItsTangent + !-------------------------------------------------------------------------------------------------- !> @brief return array of homogenization results for post file inclusion. call only, !> if homogenization_sizePostResults(i,e) > 0 !! !-------------------------------------------------------------------------------------------------- -function homogenization_postResults(ip,el) +function postResults(ip,el) use mesh, only: & mesh_element use material, only: & @@ -943,13 +941,13 @@ function homogenization_postResults(ip,el) real(pReal), dimension( homogState (mappingHomogenization(2,ip,el))%sizePostResults & + thermalState (mappingHomogenization(2,ip,el))%sizePostResults & + damageState (mappingHomogenization(2,ip,el))%sizePostResults) :: & - homogenization_postResults + postResults integer(pInt) :: & startPos, endPos ,& of, instance - homogenization_postResults = 0.0_pReal + postResults = 0.0_pReal startPos = 1_pInt endPos = homogState(mappingHomogenization(2,ip,el))%sizePostResults chosenHomogenization: select case (homogenization_type(mesh_element(3,el))) @@ -957,7 +955,7 @@ function homogenization_postResults(ip,el) case (HOMOGENIZATION_RGC_ID) chosenHomogenization instance = homogenization_typeInstance(material_homogenizationAt(el)) of = mappingHomogenization(1,ip,el) - homogenization_postResults(startPos:endPos) = homogenization_RGC_postResults(instance,of) + postResults(startPos:endPos) = homogenization_RGC_postResults(instance,of) end select chosenHomogenization @@ -966,9 +964,9 @@ function homogenization_postResults(ip,el) chosenThermal: select case (thermal_type(mesh_element(3,el))) case (THERMAL_adiabatic_ID) chosenThermal - homogenization_postResults(startPos:endPos) = thermal_adiabatic_postResults(ip, el) + postResults(startPos:endPos) = thermal_adiabatic_postResults(ip, el) case (THERMAL_conduction_ID) chosenThermal - homogenization_postResults(startPos:endPos) = thermal_conduction_postResults(ip, el) + postResults(startPos:endPos) = thermal_conduction_postResults(ip, el) end select chosenThermal @@ -977,12 +975,12 @@ function homogenization_postResults(ip,el) chosenDamage: select case (damage_type(mesh_element(3,el))) case (DAMAGE_local_ID) chosenDamage - homogenization_postResults(startPos:endPos) = damage_local_postResults(ip, el) + postResults(startPos:endPos) = damage_local_postResults(ip, el) case (DAMAGE_nonlocal_ID) chosenDamage - homogenization_postResults(startPos:endPos) = damage_nonlocal_postResults(ip, el) + postResults(startPos:endPos) = damage_nonlocal_postResults(ip, el) end select chosenDamage -end function homogenization_postResults +end function postResults end module homogenization From 6b6a26eb18979f5440328fe5d314a3b2d2f72f09 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Jan 2019 09:53:37 +0100 Subject: [PATCH 049/107] less 'use' statements --- src/homogenization_RGC.f90 | 41 ++++++++++++++++---------------------- 1 file changed, 17 insertions(+), 24 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 8a101eb72..1df881df0 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -97,9 +97,6 @@ subroutine homogenization_RGC_init() compiler_version, & compiler_options #endif - use prec, only: & - pReal, & - pInt use debug, only: & #ifdef DEBUG debug_i, & @@ -115,6 +112,10 @@ subroutine homogenization_RGC_init() IO_error, & IO_timeStamp use material, only: & +#ifdef DEBUG + material_homogenizationAt, & + mappingHomogenization, & +#endif homogenization_type, & material_homog, & homogState, & @@ -171,9 +172,9 @@ subroutine homogenization_RGC_init() config => config_homogenization(h)) #ifdef DEBUG - !if (h==material_homogenizationAt(debug_e)) then - ! prm%of_debug = mappingHomogenization(1,debug_i,debug_e) - !endif + if (h==material_homogenizationAt(debug_e)) then + prm%of_debug = mappingHomogenization(1,debug_i,debug_e) + endif #endif prm%Nconstituents = config%getInts('clustersize',requiredShape=[3]) @@ -323,9 +324,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) use debug, only: & debug_level, & debug_homogenization,& - debug_levelExtensive, & - debug_e, & - debug_i + debug_levelExtensive #endif use math, only: & math_invert2 @@ -360,7 +359,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) logical, dimension(2) :: homogenization_RGC_updateState integer(pInt), dimension (4) :: intFaceN,intFaceP,faceID - integer(pInt), dimension (3) :: nGDim,iGr3N,iGr3P,stresLoc + integer(pInt), dimension (3) :: nGDim,iGr3N,iGr3P integer(pInt) :: instance,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain, of real(pReal), dimension (3,3,size(P,3)) :: R,pF,pR,D,pD real(pReal), dimension (3,size(P,3)) :: NN,devNull @@ -481,7 +480,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then + .and. prm%of_debug == of) then stresLoc = int(maxloc(abs(P)),pInt) ! get the location of the maximum stress residLoc = int(maxloc(abs(tract)),pInt) ! get the position of the maximum residual write(6,'(1x,a)')' ' @@ -502,10 +501,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) homogenization_RGC_updateState = .true. #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then - write(6,'(1x,a55,/)')'... done and happy' - flush(6) - endif + .and. prm%of_debug == of) write(6,'(1x,a55,/)')'... done and happy' + flush(6) #endif !-------------------------------------------------------------------------------------------------- @@ -525,7 +522,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then + .and. prm%of_debug == of) then write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',stt%work(of) write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',dst%mismatch(1,of), & dst%mismatch(2,of), & @@ -547,10 +544,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then - write(6,'(1x,a55,/)')'... broken' - flush(6) - endif + .and. prm%of_debug == of) write(6,'(1x,a,/)') '... broken' + flush(6) #endif return @@ -558,10 +553,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) else ! proceed with computing the Jacobian and state update #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & - .and. debug_e == el .and. debug_i == ip) then - write(6,'(1x,a55,/)')'... not yet done' - flush(6) - endif + .and. prm%of_debug == of) write(6,'(1x,a,/)') '... not yet done' + flush(6) #endif endif From 9058587a2b0a3f9b554affabe2e2e7eabe0a4b8a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Jan 2019 18:13:00 +0100 Subject: [PATCH 050/107] test failed with Intel 18.0.1 don't know what is going on here. 18.0.3 and gfortran work fine. Bug? --- src/homogenization_RGC.f90 | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 1df881df0..ef81043eb 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -106,7 +106,7 @@ subroutine homogenization_RGC_init() debug_homogenization, & debug_levelBasic use math, only: & - math_EulerToR,& + math_EulerToR, & INRAD use IO, only: & IO_error, & @@ -180,9 +180,11 @@ subroutine homogenization_RGC_init() prm%Nconstituents = config%getInts('clustersize',requiredShape=[3]) if (homogenization_Ngrains(h) /= product(prm%Nconstituents)) & call IO_error(211_pInt,ext_msg='clustersize ('//HOMOGENIZATION_RGC_label//')') + prm%xiAlpha = config%getFloat('scalingparameter') prm%ciAlpha = config%getFloat('overproportionality') - prm%dAlpha = config%getFloats('grainsize',requiredShape=[3]) + + prm%dAlpha = config%getFloats('grainsize', requiredShape=[3]) prm%angles = config%getFloats('clusterorientation',requiredShape=[3]) outputs = config%getStrings('(output)',defaultVal=emptyStringArray) @@ -239,15 +241,15 @@ subroutine homogenization_RGC_init() stt%work => homogState(h)%state(nIntFaceTot+1,:) stt%penaltyEnergy => homogState(h)%state(nIntFaceTot+2,:) - allocate(dst%volumeDiscrepancy( NofMyHomog)) - allocate(dst%relaxationRate_avg( NofMyHomog)) - allocate(dst%relaxationRate_max( NofMyHomog)) - allocate(dst%mismatch( 3, NofMyHomog)) - allocate(dst%orientation( 3,3,NofMyHomog)) + allocate(dst%volumeDiscrepancy( NofMyHomog)) + allocate(dst%relaxationRate_avg( NofMyHomog)) + allocate(dst%relaxationRate_max( NofMyHomog)) + allocate(dst%mismatch( 3,NofMyHomog)) !-------------------------------------------------------------------------------------------------- ! assigning cluster orientations - dst%orientation = spread(math_EulerToR(prm%angles*inRad),3,NofMyHomog) + dependentState(homogenization_typeInstance(h))%orientation = spread(math_EulerToR(prm%angles*inRad),3,NofMyHomog) + !dst%orientation = spread(math_EulerToR(prm%angles*inRad),3,NofMyHomog) ifort version 18.0.1 crashes (for whatever reason) end associate From 8c2d6400b1802f5e8313b06c031d0840e51a8a48 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Jan 2019 11:28:46 +0100 Subject: [PATCH 051/107] cleaning --- src/crystallite.f90 | 97 +++++++++++++++------------------------------ 1 file changed, 31 insertions(+), 66 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index af69b1727..0d3eef17e 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -69,7 +69,7 @@ module crystallite crystallite_subS0, & !< 2nd Piola-Kirchhoff stress vector at start of crystallite inc crystallite_invFp, & !< inverse of current plastic def grad (end of converged time step) crystallite_subFp0,& !< plastic def grad at start of crystallite inc - crystallite_invFi, & !< inverse of current intermediate def grad (end of converged time step) + crystallite_invFi, & !< inverse of current intermediate def grad crystallite_subFi0,& !< intermediate def grad at start of crystallite inc crystallite_subF, & !< def grad to be reached at end of crystallite inc crystallite_subF0, & !< def grad at start of crystallite inc @@ -78,12 +78,11 @@ module crystallite real(pReal), dimension(:,:,:,:,:,:,:), allocatable, public :: & crystallite_dPdF !< current individual dPdF per grain (end of converged time step) logical, dimension(:,:,:), allocatable, public :: & - crystallite_requested !< flag to request crystallite calculation - logical, dimension(:,:,:), allocatable, public, protected :: & - crystallite_converged !< convergence flag + crystallite_requested !< used by upper level (homogenization) to request crystallite calculation logical, dimension(:,:,:), allocatable, private :: & - crystallite_localPlasticity, & !< indicates this grain to have purely local constitutive law - crystallite_todo !< flag to indicate need for further computation + crystallite_converged, & !< convergence flag + crystallite_todo, & !< flag to indicate need for further computation + crystallite_localPlasticity !< indicates this grain to have purely local constitutive law enum, bind(c) enumerator :: undefined_ID, & @@ -999,13 +998,11 @@ function crystallite_postResults(ipc, ip, el) mySize, & n - crystID = microstructure_crystallite(mesh_element(4,el)) crystallite_postResults = 0.0_pReal - c = 0_pInt - crystallite_postResults(c+1) = real(crystallite_sizePostResults(crystID),pReal) ! size of results from cryst - c = c + 1_pInt + crystallite_postResults(1) = real(crystallite_sizePostResults(crystID),pReal) ! header-like information (length) + c = 1_pInt do o = 1_pInt,crystallite_Noutput(crystID) mySize = 0_pInt @@ -1612,12 +1609,6 @@ subroutine integrateStateFPI() singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo at start of state integration' -#endif - - ! --+>> PREGUESS FOR STATE <<+-- call update_dotState(1.0_pReal) call update_state(1.0_pReal) @@ -1807,11 +1798,6 @@ subroutine integrateStateFPI() !$OMP ENDDO !$OMP END PARALLEL -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), & - ' grains converged after state integration #', NiterationState -#endif ! --- NON-LOCAL CONVERGENCE CHECK --- @@ -1820,20 +1806,11 @@ subroutine integrateStateFPI() crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged endif -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then - write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), & - ' grains converged after non-local check' - write(6,'(a,i8,a,i2,/)') '<< CRYST >> ', count(crystallite_todo(:,:,:)), & - ' grains todo after state integration #', NiterationState - endif -#endif ! --- CHECK IF DONE WITH INTEGRATION --- - doneWithIntegration = .true. elemLoop: do e = eIter(1),eIter(2) - do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then doneWithIntegration = .false. exit elemLoop @@ -1843,6 +1820,29 @@ subroutine integrateStateFPI() enddo crystalliteLooping + contains + +!-------------------------------------------------------------------------------------------------- +!> @brief calculate the damping for correction of state and dot state +!-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + implicit none + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(current - previous2, previous - previous2) + if (dot_prod22 > 0.0_pReal .and. (dot_prod12 < 0.0_pReal .or. dot_product(current,previous) < 0.0_pReal)) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + end subroutine integrateStateFPI @@ -2119,17 +2119,6 @@ end subroutine integrateStateAdaptiveEuler subroutine integrateStateRK4() use, intrinsic :: & IEEE_arithmetic -#ifdef DEBUG - use debug, only: & - debug_e, & - debug_i, & - debug_g, & - debug_level, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif use mesh, only: & mesh_element, & mesh_NcpElems @@ -2331,10 +2320,6 @@ subroutine integrateStateRKCK45() singleRun ! flag indicating computation for single (g,i,e) triple eIter = FEsolving_execElem(1:2) -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,1x,i1)') '<< CRYST >> Runge--Kutta step',1 -#endif ! --- LOOP ITERATOR FOR ELEMENT, GRAIN, IP --- do e = eIter(1),eIter(2) @@ -2483,22 +2468,6 @@ subroutine integrateStateRKCK45() abs(sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState)) enddo - -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt& - .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& - .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then - write(6,'(a,i8,1x,i3,1x,i3,/)') '<< CRYST >> updateState at el ip ipc ',e,i,g - write(6,'(a,/,(12x,12(f12.1,1x)),/)') '<< CRYST >> absolute residuum tolerance', & - plasticStateResiduum(1:mySizePlasticDotState,g,i,e) / plasticState(p)%aTolState(1:mySizePlasticDotState) - write(6,'(a,/,(12x,12(f12.1,1x)),/)') '<< CRYST >> relative residuum tolerance', & - relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e) / rTol_crystalliteState - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> dotState', & - plasticState(p)%dotState(1:mySizePlasticDotState,cc) - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', & - plasticState(p)%state(1:mySizePlasticDotState,cc) - endif -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2511,10 +2480,6 @@ subroutine integrateStateRKCK45() ! --- nonlocal convergence check --- -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,i8,a,i2,/)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), ' grains converged' ! if not requesting Integration of just a single IP -#endif if ((.not. singleRun) .and. any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged From 95cb404f81c7fd88c4a880f6f9a3454e14e74b13 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Jan 2019 11:49:24 +0100 Subject: [PATCH 052/107] further cleaning --- src/crystallite.f90 | 174 +++++++++----------------------------------- 1 file changed, 33 insertions(+), 141 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0d3eef17e..1b97f74c2 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1538,17 +1538,6 @@ end function integrateStress subroutine integrateStateFPI() use, intrinsic :: & IEEE_arithmetic -#ifdef DEBUG - use debug, only: & - debug_e, & - debug_i, & - debug_g, & - debug_level,& - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif use numerics, only: & nState, & rTol_crystalliteState @@ -1580,11 +1569,6 @@ subroutine integrateStateFPI() mySource, & mySizePlasticDotState, & ! size of dot states mySizeSourceDotState - integer(pInt), dimension(2) :: & - eIter ! bounds for element iteration - integer(pInt), dimension(2,mesh_NcpElems) :: & - iIter, & ! bounds for ip iteration - gIter ! bounds for grain iteration real(pReal) :: & dot_prod12, & dot_prod22, & @@ -1598,22 +1582,11 @@ subroutine integrateStateFPI() tempSourceState logical :: & converged, & - singleRun, & ! flag indicating computation for single (g,i,e) triple doneWithIntegration - eIter = FEsolving_execElem(1:2) - do e = eIter(1),eIter(2) - iIter(1:2,e) = FEsolving_execIP(1:2,e) - gIter(1:2,e) = [ 1_pInt,homogenization_Ngrains(mesh_element(3,e))] - enddo - - singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) - ! --+>> PREGUESS FOR STATE <<+-- - call update_dotState(1.0_pReal) - call update_state(1.0_pReal) - - ! --+>> STATE LOOP <<+-- + call update_dotState(1.0_pReal) + call update_state(1.0_pReal) NiterationState = 0_pInt doneWithIntegration = .false. @@ -1655,8 +1628,10 @@ subroutine integrateStateFPI() !$OMP& plasticStateResiduum,sourceStateResiduum, & !$OMP& plasticStatedamper,sourceStateDamper, & !$OMP& tempPlasticState,tempSourceState,converged,p,c) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) +if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e) c = phasememberAt(g,i,e) @@ -1737,20 +1712,6 @@ subroutine integrateStateFPI() * (1.0_pReal - sourceStateDamper) enddo -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & - .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & - .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then - write(6,'(a,i8,1x,i2,1x,i3,/)') '<< CRYST >> update state at el ip g ',e,i,g - write(6,'(a,f6.1,/)') '<< CRYST >> plasticstatedamper ',plasticStatedamper - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> plastic state residuum',& - abs(plasticStateResiduum(1:mySizePlasticDotState)) - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> abstol dotstate',plasticState(p)%aTolState(1:mySizePlasticDotState) - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> reltol dotstate',rTol_crystalliteState* & - abs(tempPlasticState(1:mySizePlasticDotState)) - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state',tempPlasticState(1:mySizePlasticDotState) - endif -#endif ! --- converged ? --- converged = all( abs(plasticStateResiduum(1:mySizePlasticDotState)) < & @@ -1780,7 +1741,9 @@ subroutine integrateStateFPI() ! --- STATE JUMP --- !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e) .and. crystallite_converged(g,i,e)) then ! converged and still alive... crystallite_todo(g,i,e) = stateJump(g,i,e) @@ -1801,7 +1764,7 @@ subroutine integrateStateFPI() ! --- NON-LOCAL CONVERGENCE CHECK --- - if (.not. singleRun) then ! if not requesting Integration of just a single IP + if (any(plasticState(:)%nonlocal)) then ! if not requesting Integration of just a single IP if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged endif @@ -1809,17 +1772,19 @@ subroutine integrateStateFPI() ! --- CHECK IF DONE WITH INTEGRATION --- doneWithIntegration = .true. - elemLoop: do e = eIter(1),eIter(2) - do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then doneWithIntegration = .false. - exit elemLoop + exit endif enddo; enddo - enddo elemLoop + enddo enddo crystalliteLooping - + + contains !-------------------------------------------------------------------------------------------------- @@ -1850,40 +1815,9 @@ end subroutine integrateStateFPI !> @brief integrate stress, and state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- subroutine integrateStateEuler() - use, intrinsic :: & - IEEE_arithmetic - use mesh, only: & - mesh_element, & - mesh_NcpElems use material, only: & - phase_Nsources, & - homogenization_Ngrains - use constitutive, only: & - constitutive_collectDotState, & - constitutive_microstructure - + plasticState implicit none - integer(pInt) :: & - e, & ! element index in element loop - i, & ! integration point index in ip loop - g ! grain index in grain loop - - integer(pInt), dimension(2) :: & - eIter ! bounds for element iteration - integer(pInt), dimension(2,mesh_NcpElems) :: & - iIter, & ! bounds for ip iteration - gIter ! bounds for grain iteration - logical :: & - singleRun ! flag indicating computation for single (g,i,e) triple - - -eIter = FEsolving_execElem(1:2) - do e = eIter(1),eIter(2) - iIter(1:2,e) = FEsolving_execIP(1:2,e) - gIter(1:2,e) = [ 1_pInt,homogenization_Ngrains(mesh_element(3,e))] - enddo - - singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) call update_dotState(1.0_pReal) call update_State(1.0_pReal) @@ -1894,7 +1828,7 @@ eIter = FEsolving_execElem(1:2) ! --- CHECK NON-LOCAL CONVERGENCE --- - if (.not. singleRun) then ! if not requesting Integration of just a single IP + if (any(plasticState(:)%nonlocal)) then if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity) ) & ! any non-local not yet converged (or broken)... crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged endif @@ -1908,17 +1842,6 @@ end subroutine integrateStateEuler subroutine integrateStateAdaptiveEuler() use, intrinsic :: & IEEE_arithmetic -#ifdef DEBUG - use debug, only: & - debug_e, & - debug_i, & - debug_g, & - debug_level, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif use numerics, only: & rTol_crystalliteState use mesh, only: & @@ -1949,12 +1872,7 @@ subroutine integrateStateAdaptiveEuler() mySource, & mySizePlasticDotState, & ! size of dot states mySizeSourceDotState - integer(pInt), dimension(2) :: & - eIter ! bounds for element iteration - integer(pInt), dimension(2,mesh_NcpElems) :: & - iIter, & ! bounds for ip iteration - gIter ! bounds for grain iteration - real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & +real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & plasticStateResiduum, & ! residuum from evolution in micrstructure relPlasticStateResiduum ! relative residuum from evolution in microstructure @@ -1966,18 +1884,7 @@ subroutine integrateStateAdaptiveEuler() logical :: & converged, & - NaN, & - singleRun ! flag indicating computation for single (g,i,e) triple - - - ! --- LOOP ITERATOR FOR ELEMENT, GRAIN, IP --- - eIter = FEsolving_execElem(1:2) - do e = eIter(1),eIter(2) - iIter(1:2,e) = FEsolving_execIP(1:2,e) - gIter(1:2,e) = [ 1_pInt,homogenization_Ngrains(mesh_element(3,e))] - enddo - - singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) + NaN plasticStateResiduum = 0.0_pReal @@ -1995,7 +1902,9 @@ subroutine integrateStateAdaptiveEuler() ! --- STATE UPDATE (EULER INTEGRATION) --- !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) c = phasememberAt(g,i,e) @@ -2037,7 +1946,9 @@ subroutine integrateStateAdaptiveEuler() !$OMP END SINGLE !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,converged,p,c,s) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) c = phasememberAt(g,i,e) @@ -2066,21 +1977,6 @@ subroutine integrateStateAdaptiveEuler() sourceStateResiduum(s,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(s,c) enddo -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & - .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& - .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then - write(6,'(a,i8,1x,i2,1x,i3,/)') '<< CRYST >> updateState at el ip g ',e,i,g - write(6,'(a,/,(12x,12(f12.1,1x)),/)') '<< CRYST >> absolute residuum tolerance', & - plasticStateResiduum(1:mySizePlasticDotState,g,i,e) / plasticState(p)%aTolState(1:mySizePlasticDotState) - write(6,'(a,/,(12x,12(f12.1,1x)),/)') '<< CRYST >> relative residuum tolerance', & - relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e) / rTol_crystalliteState - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> dotState', plasticState(p)%dotState(1:mySizePlasticDotState,c) & - - 2.0_pReal * plasticStateResiduum(1:mySizePlasticDotState,g,i,e) / crystallite_subdt(g,i,e) ! calculate former dotstate from higher order solution and state residuum - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', plasticState(p)%state(1:mySizePlasticDotState,c) - endif -#endif - ! --- converged ? --- converged = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & rTol_crystalliteState .or. & @@ -2102,14 +1998,11 @@ subroutine integrateStateAdaptiveEuler() ! --- NONLOCAL CONVERGENCE CHECK --- -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,i8,a,i2,/)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), ' grains converged' -#endif - if ((.not. singleRun) .and. any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged - + if (any(plasticState(:)%nonlocal)) then + if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity) ) & ! any non-local not yet converged (or broken)... + crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged + endif end subroutine integrateStateAdaptiveEuler @@ -2222,10 +2115,9 @@ subroutine integrateStateRK4() ! --- CHECK NONLOCAL CONVERGENCE --- - if (.not. singleRun) then ! if not requesting Integration of just a single IP - if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) then ! any non-local not yet converged (or broken)... + if (any(plasticState(:)%nonlocal)) then + if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity) ) & ! any non-local not yet converged (or broken)... crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged - endif endif end subroutine integrateStateRK4 From 8a2524b5d26aa81cb74148304607c82b6e4310f4 Mon Sep 17 00:00:00 2001 From: Franz Roters Date: Mon, 28 Jan 2019 15:56:05 +0100 Subject: [PATCH 053/107] requiredShape outdated: use requiredSize --- src/homogenization_RGC.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index ef81043eb..8ac76606a 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -177,15 +177,15 @@ subroutine homogenization_RGC_init() endif #endif - prm%Nconstituents = config%getInts('clustersize',requiredShape=[3]) + prm%Nconstituents = config%getInts('clustersize',requiredSize=3) if (homogenization_Ngrains(h) /= product(prm%Nconstituents)) & call IO_error(211_pInt,ext_msg='clustersize ('//HOMOGENIZATION_RGC_label//')') prm%xiAlpha = config%getFloat('scalingparameter') prm%ciAlpha = config%getFloat('overproportionality') - prm%dAlpha = config%getFloats('grainsize', requiredShape=[3]) - prm%angles = config%getFloats('clusterorientation',requiredShape=[3]) + prm%dAlpha = config%getFloats('grainsize', requiredSize=3) + prm%angles = config%getFloats('clusterorientation',requiredSize=3) outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) From 80cfc23f3655ea1f366191b0d952e15af52b3606 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 28 Jan 2019 21:16:42 +0100 Subject: [PATCH 054/107] [skip ci] updated version information after successful test of v2.0.2-1604-g8a2524b5 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 3801ac74e..59daee05a 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1540-ge2582a8d +v2.0.2-1604-g8a2524b5 From b62232022b4cad4187e65d0427c1680d05b6a100 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 00:27:58 +0100 Subject: [PATCH 055/107] polishing --- src/crystallite.f90 | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 1b97f74c2..19727af7d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -69,7 +69,7 @@ module crystallite crystallite_subS0, & !< 2nd Piola-Kirchhoff stress vector at start of crystallite inc crystallite_invFp, & !< inverse of current plastic def grad (end of converged time step) crystallite_subFp0,& !< plastic def grad at start of crystallite inc - crystallite_invFi, & !< inverse of current intermediate def grad + crystallite_invFi, & !< inverse of current intermediate def grad (end of converged time step) crystallite_subFi0,& !< intermediate def grad at start of crystallite inc crystallite_subF, & !< def grad to be reached at end of crystallite inc crystallite_subF0, & !< def grad at start of crystallite inc @@ -666,14 +666,14 @@ function crystallite_stress() ! return whether converged or not crystallite_stress = .false. elementLooping5: do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) crystallite_stress(i,e) = all(crystallite_converged(:,i,e)) enddo enddo elementLooping5 #ifdef DEBUG elementLooping6: do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do c = 1,homogenization_Ngrains(mesh_element(3,e)) if (.not. crystallite_converged(c,i,e)) then if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & @@ -844,17 +844,16 @@ subroutine crystallite_stressTangent() !-------------------------------------------------------------------------------------------------- ! assemble dPdF temp_33_1 = math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), & - math_mul33x33(math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & - transpose(crystallite_invFp(1:3,1:3,c,i,e)))) + math_mul33x33(math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & + transpose(crystallite_invFp(1:3,1:3,c,i,e)))) temp_33_2 = math_mul33x33(math_6toSym33(crystallite_Tstar_v(1:6,c,i,e)), & - transpose(crystallite_invFp(1:3,1:3,c,i,e))) + transpose(crystallite_invFp(1:3,1:3,c,i,e))) temp_33_3 = math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), & - crystallite_invFp(1:3,1:3,c,i,e)) + crystallite_invFp(1:3,1:3,c,i,e)) temp_33_4 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), & - crystallite_invFp(1:3,1:3,c,i,e)), & - math_6toSym33(crystallite_Tstar_v(1:6,c,i,e))) + crystallite_invFp(1:3,1:3,c,i,e)), & + math_6toSym33(crystallite_Tstar_v(1:6,c,i,e))) - crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal do p=1_pInt, 3_pInt crystallite_dPdF(p,1:3,p,1:3,c,i,e) = transpose(temp_33_1) enddo @@ -1628,10 +1627,10 @@ subroutine integrateStateFPI() !$OMP& plasticStateResiduum,sourceStateResiduum, & !$OMP& plasticStatedamper,sourceStateDamper, & !$OMP& tempPlasticState,tempSourceState,converged,p,c) - do e = FEsolving_execElem(1),FEsolving_execElem(2) + do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) -if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e) c = phasememberAt(g,i,e) @@ -1787,9 +1786,9 @@ if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then contains -!-------------------------------------------------------------------------------------------------- -!> @brief calculate the damping for correction of state and dot state -!-------------------------------------------------------------------------------------------------- + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- real(pReal) pure function damper(current,previous,previous2) implicit none From 2f9a571b9626682a7708fb3c960f763dacedf4ee Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 00:38:18 +0100 Subject: [PATCH 056/107] no need for 2 variables --- src/crystallite.f90 | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 19727af7d..358dacea8 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1571,8 +1571,7 @@ subroutine integrateStateFPI() real(pReal) :: & dot_prod12, & dot_prod22, & - plasticStateDamper, & ! damper for integration of state - sourceStateDamper + stateDamper real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & plasticStateResiduum, & tempPlasticState @@ -1625,7 +1624,7 @@ subroutine integrateStateFPI() !$OMP DO PRIVATE(dot_prod12,dot_prod22, & !$OMP& mySizePlasticDotState,mySizeSourceDotState, & !$OMP& plasticStateResiduum,sourceStateResiduum, & - !$OMP& plasticStatedamper,sourceStateDamper, & + !$OMP& stateDamper, & !$OMP& tempPlasticState,tempSourceState,converged,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) @@ -1646,9 +1645,9 @@ subroutine integrateStateFPI() .and. ( dot_prod12 < 0.0_pReal & .or. dot_product(plasticState(p)%dotState(:,c), & plasticState(p)%previousDotState(:,c)) < 0.0_pReal) ) then - plasticStateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + stateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) else - plasticStateDamper = 1.0_pReal + stateDamper = 1.0_pReal endif ! --- get residui --- @@ -1656,9 +1655,9 @@ subroutine integrateStateFPI() plasticStateResiduum(1:mySizePlasticDotState) = & plasticState(p)%state(1:mySizePlasticDotState,c) & - plasticState(p)%subState0(1:mySizePlasticDotState,c) & - - ( plasticState(p)%dotState(1:mySizePlasticDotState,c) * plasticStateDamper & + - ( plasticState(p)%dotState(1:mySizePlasticDotState,c) * stateDamper & + plasticState(p)%previousDotState(1:mySizePlasticDotState,c) & - * (1.0_pReal - plasticStateDamper)) * crystallite_subdt(g,i,e) + * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- tempPlasticState(1:mySizePlasticDotState) = & @@ -1667,9 +1666,9 @@ subroutine integrateStateFPI() ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * plasticStateDamper & + plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & + plasticState(p)%previousDotState(:,c) & - * (1.0_pReal - plasticStateDamper) + * (1.0_pReal - stateDamper) do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState @@ -1686,18 +1685,18 @@ subroutine integrateStateFPI() .and. ( dot_prod12 < 0.0_pReal & .or. dot_product(sourceState(p)%p(mySource)%dotState(:,c), & sourceState(p)%p(mySource)%previousDotState(:,c)) < 0.0_pReal) ) then - sourceStateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + stateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) else - sourceStateDamper = 1.0_pReal + stateDamper = 1.0_pReal endif ! --- get residui --- mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState sourceStateResiduum(1:mySizeSourceDotState,mySource) = & sourceState(p)%p(mySource)%state(1:mySizeSourceDotState,c) & - sourceState(p)%p(mySource)%subState0(1:mySizeSourceDotState,c) & - - ( sourceState(p)%p(mySource)%dotState(1:mySizeSourceDotState,c) * sourceStateDamper & + - ( sourceState(p)%p(mySource)%dotState(1:mySizeSourceDotState,c) * stateDamper & + sourceState(p)%p(mySource)%previousDotState(1:mySizeSourceDotState,c) & - * (1.0_pReal - sourceStateDamper)) * crystallite_subdt(g,i,e) + * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- tempSourceState(1:mySizeSourceDotState,mySource) = & @@ -1706,9 +1705,9 @@ subroutine integrateStateFPI() ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) sourceState(p)%p(mySource)%dotState(:,c) = & - sourceState(p)%p(mySource)%dotState(:,c) * sourceStateDamper & + sourceState(p)%p(mySource)%dotState(:,c) * stateDamper & + sourceState(p)%p(mySource)%previousDotState(:,c) & - * (1.0_pReal - sourceStateDamper) + * (1.0_pReal - stateDamper) enddo From 2cf44f4060f64d20001fc545e7a419c50509a7ef Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 00:39:44 +0100 Subject: [PATCH 057/107] shorter --- src/crystallite.f90 | 69 ++++++++++++++++++++++----------------------- 1 file changed, 34 insertions(+), 35 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 358dacea8..0ae050173 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1565,7 +1565,6 @@ subroutine integrateStateFPI() p, & c, & s, & - mySource, & mySizePlasticDotState, & ! size of dot states mySizeSourceDotState real(pReal) :: & @@ -1670,43 +1669,43 @@ subroutine integrateStateFPI() + plasticState(p)%previousDotState(:,c) & * (1.0_pReal - stateDamper) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - dot_prod12 = dot_product( sourceState(p)%p(mySource)%dotState (:,c) & - - sourceState(p)%p(mySource)%previousDotState (:,c), & - sourceState(p)%p(mySource)%previousDotState (:,c) & - - sourceState(p)%p(mySource)%previousDotState2(:,c)) - dot_prod22 = dot_product( sourceState(p)%p(mySource)%previousDotState (:,c) & - - sourceState(p)%p(mySource)%previousDotState2(:,c), & - sourceState(p)%p(mySource)%previousDotState (:,c) & - - sourceState(p)%p(mySource)%previousDotState2(:,c)) + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + dot_prod12 = dot_product( sourceState(p)%p(s)%dotState (:,c) & + - sourceState(p)%p(s)%previousDotState (:,c), & + sourceState(p)%p(s)%previousDotState (:,c) & + - sourceState(p)%p(s)%previousDotState2(:,c)) + dot_prod22 = dot_product( sourceState(p)%p(s)%previousDotState (:,c) & + - sourceState(p)%p(s)%previousDotState2(:,c), & + sourceState(p)%p(s)%previousDotState (:,c) & + - sourceState(p)%p(s)%previousDotState2(:,c)) if ( dot_prod22 > 0.0_pReal & .and. ( dot_prod12 < 0.0_pReal & - .or. dot_product(sourceState(p)%p(mySource)%dotState(:,c), & - sourceState(p)%p(mySource)%previousDotState(:,c)) < 0.0_pReal) ) then + .or. dot_product(sourceState(p)%p(s)%dotState(:,c), & + sourceState(p)%p(s)%previousDotState(:,c)) < 0.0_pReal) ) then stateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) else stateDamper = 1.0_pReal endif ! --- get residui --- - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - sourceStateResiduum(1:mySizeSourceDotState,mySource) = & - sourceState(p)%p(mySource)%state(1:mySizeSourceDotState,c) & - - sourceState(p)%p(mySource)%subState0(1:mySizeSourceDotState,c) & - - ( sourceState(p)%p(mySource)%dotState(1:mySizeSourceDotState,c) * stateDamper & - + sourceState(p)%p(mySource)%previousDotState(1:mySizeSourceDotState,c) & + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sourceStateResiduum(1:mySizeSourceDotState,s) = & + sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) & + - sourceState(p)%p(s)%subState0(1:mySizeSourceDotState,c) & + - ( sourceState(p)%p(s)%dotState(1:mySizeSourceDotState,c) * stateDamper & + + sourceState(p)%p(s)%previousDotState(1:mySizeSourceDotState,c) & * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- - tempSourceState(1:mySizeSourceDotState,mySource) = & - sourceState(p)%p(mySource)%state(1:mySizeSourceDotState,c) & - - sourceStateResiduum(1:mySizeSourceDotState,mySource) ! need to copy to local variable, since we cant flush a pointer in openmp + tempSourceState(1:mySizeSourceDotState,s) = & + sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) & + - sourceStateResiduum(1:mySizeSourceDotState,s) ! need to copy to local variable, since we cant flush a pointer in openmp ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) - sourceState(p)%p(mySource)%dotState(:,c) = & - sourceState(p)%p(mySource)%dotState(:,c) * stateDamper & - + sourceState(p)%p(mySource)%previousDotState(:,c) & + sourceState(p)%p(s)%dotState(:,c) = & + sourceState(p)%p(s)%dotState(:,c) * stateDamper & + + sourceState(p)%p(s)%previousDotState(:,c) & * (1.0_pReal - stateDamper) enddo @@ -1716,22 +1715,22 @@ subroutine integrateStateFPI() plasticState(p)%aTolState(1:mySizePlasticDotState) & .or. abs(plasticStateResiduum(1:mySizePlasticDotState)) < & rTol_crystalliteState * abs(tempPlasticState(1:mySizePlasticDotState))) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState converged = converged .and. & - all( abs(sourceStateResiduum(1:mySizeSourceDotState,mySource)) < & - sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState) & - .or. abs(sourceStateResiduum(1:mySizeSourceDotState,mySource)) < & - rTol_crystalliteState * abs(tempSourceState(1:mySizeSourceDotState,mySource))) + all( abs(sourceStateResiduum(1:mySizeSourceDotState,s)) < & + sourceState(p)%p(s)%aTolState(1:mySizeSourceDotState) & + .or. abs(sourceStateResiduum(1:mySizeSourceDotState,s)) < & + rTol_crystalliteState * abs(tempSourceState(1:mySizeSourceDotState,s))) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition plasticState(p)%state(1:mySizePlasticDotState,c) = & tempPlasticState(1:mySizePlasticDotState) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - sourceState(p)%p(mySource)%state(1:mySizeSourceDotState,c) = & - tempSourceState(1:mySizeSourceDotState,mySource) + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) = & + tempSourceState(1:mySizeSourceDotState,s) enddo endif enddo; enddo; enddo From ee586dfa0c0a99e7e93556a6ff356b9552cb702e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 00:46:57 +0100 Subject: [PATCH 058/107] avoid code duplication --- src/crystallite.f90 | 47 +++++++-------------------------------------- 1 file changed, 7 insertions(+), 40 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0ae050173..ad12b455e 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1568,8 +1568,6 @@ subroutine integrateStateFPI() mySizePlasticDotState, & ! size of dot states mySizeSourceDotState real(pReal) :: & - dot_prod12, & - dot_prod22, & stateDamper real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & plasticStateResiduum, & @@ -1620,8 +1618,7 @@ subroutine integrateStateFPI() !$OMP PARALLEL ! --- UPDATE STATE --- - !$OMP DO PRIVATE(dot_prod12,dot_prod22, & - !$OMP& mySizePlasticDotState,mySizeSourceDotState, & + !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState, & !$OMP& plasticStateResiduum,sourceStateResiduum, & !$OMP& stateDamper, & !$OMP& tempPlasticState,tempSourceState,converged,p,c) @@ -1632,23 +1629,9 @@ subroutine integrateStateFPI() p = phaseAt(g,i,e) c = phasememberAt(g,i,e) - dot_prod12 = dot_product( plasticState(p)%dotState (:,c) & - - plasticState(p)%previousDotState (:,c), & - plasticState(p)%previousDotState (:,c) & - - plasticState(p)%previousDotState2(:,c)) - dot_prod22 = dot_product( plasticState(p)%previousDotState (:,c) & - - plasticState(p)%previousDotState2(:,c), & - plasticState(p)%previousDotState (:,c) & - - plasticState(p)%previousDotState2(:,c)) - if ( dot_prod22 > 0.0_pReal & - .and. ( dot_prod12 < 0.0_pReal & - .or. dot_product(plasticState(p)%dotState(:,c), & - plasticState(p)%previousDotState(:,c)) < 0.0_pReal) ) then - stateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - stateDamper = 1.0_pReal - endif - ! --- get residui --- + StateDamper = damper(plasticState(p)%dotState (:,c), & + plasticState(p)%previousDotState (:,c), & + plasticState(p)%previousDotState2(:,c)) mySizePlasticDotState = plasticState(p)%sizeDotState plasticStateResiduum(1:mySizePlasticDotState) = & @@ -1670,25 +1653,9 @@ subroutine integrateStateFPI() * (1.0_pReal - stateDamper) do s = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState - dot_prod12 = dot_product( sourceState(p)%p(s)%dotState (:,c) & - - sourceState(p)%p(s)%previousDotState (:,c), & - sourceState(p)%p(s)%previousDotState (:,c) & - - sourceState(p)%p(s)%previousDotState2(:,c)) - dot_prod22 = dot_product( sourceState(p)%p(s)%previousDotState (:,c) & - - sourceState(p)%p(s)%previousDotState2(:,c), & - sourceState(p)%p(s)%previousDotState (:,c) & - - sourceState(p)%p(s)%previousDotState2(:,c)) - - if ( dot_prod22 > 0.0_pReal & - .and. ( dot_prod12 < 0.0_pReal & - .or. dot_product(sourceState(p)%p(s)%dotState(:,c), & - sourceState(p)%p(s)%previousDotState(:,c)) < 0.0_pReal) ) then - stateDamper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - stateDamper = 1.0_pReal - endif - ! --- get residui --- + StateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & + sourceState(p)%p(s)%previousDotState (:,c), & + sourceState(p)%p(s)%previousDotState2(:,c)) mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState sourceStateResiduum(1:mySizeSourceDotState,s) = & sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) & From 9b77bdd122c893412b2d39dd4129c2da4ee6545c Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 29 Jan 2019 04:24:32 +0100 Subject: [PATCH 059/107] [skip ci] updated version information after successful test of v2.0.2-1608-gcd3cbf47 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 59daee05a..31608bd97 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1604-g8a2524b5 +v2.0.2-1608-gcd3cbf47 From 918860ab386d32839fc4a9bab798089bb42618c8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 06:14:58 +0100 Subject: [PATCH 060/107] easier to store atomic volume instead of scaling factor --- src/plastic_dislotwin.f90 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index d9312ae18..2ee2a40e1 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -46,7 +46,6 @@ module plastic_dislotwin real(pReal) :: & mu, & nu, & - CAtomicVolume, & !< atomic volume in Bugers vector unit D0, & !< prefactor for self-diffusion coefficient Qsd, & !< activation energy for dislocation climb GrainSize, & ! system prm%rho0 = math_expand(prm%rho0, prm%Nslip) @@ -318,7 +319,8 @@ subroutine plastic_dislotwin_init prm%p = math_expand(prm%p, prm%Nslip) prm%q = math_expand(prm%q, prm%Nslip) prm%B = math_expand(prm%B, prm%Nslip) - prm%tau_peierls = math_expand(prm%tau_peierls, prm%Nslip) + prm%tau_peierls = math_expand(prm%tau_peierls, prm%Nslip) + prm%atomicVolume = math_expand(prm%atomicVolume,prm%Nslip) ! sanity checks if (any(prm%rho0 < 0.0_pReal)) extmsg = trim(extmsg)//'rho0 ' @@ -450,7 +452,6 @@ subroutine plastic_dislotwin_init prm%aTolTwinFrac = config%getFloat('atol_twinfrac', defaultVal=0.0_pReal) prm%aTolTransFrac = config%getFloat('atol_transfrac', defaultVal=0.0_pReal) - prm%CAtomicVolume = config%getFloat('catomicvolume') prm%GrainSize = config%getFloat('grainsize') @@ -470,7 +471,7 @@ subroutine plastic_dislotwin_init !if (Ndot0PerTwinFamily(f,p) < 0.0_pReal) & ! call IO_error(211_pInt,el=p,ext_msg='ndot0_twin ('//PLASTICITY_DISLOTWIN_label//')') - if (prm%CAtomicVolume <= 0.0_pReal) & + if (any(prm%atomicVolume <= 0.0_pReal)) & call IO_error(211_pInt,el=p,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOTWIN_label//')') if (prm%D0 <= 0.0_pReal) & call IO_error(211_pInt,el=p,ext_msg='D0 ('//PLASTICITY_DISLOTWIN_label//')') @@ -830,7 +831,7 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) integer(pInt) :: i real(pReal) :: f_unrotated,& - EdgeDipMinDistance,AtomicVolume,VacancyDiffusion,& + EdgeDipMinDistance,VacancyDiffusion,& EdgeDipDistance, ClimbVelocity,DotRhoEdgeDipClimb,DotRhoEdgeDipAnnihilation, & DotRhoDipFormation,DotRhoMultiplication,DotRhoEdgeEdgeAnnihilation, & tau @@ -859,11 +860,11 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) significantSlipStress2: if (dEq0(tau)) then DotRhoDipFormation = 0.0_pReal else significantSlipStress2 - EdgeDipDistance = (3.0_pReal*prm%mu*prm%burgers_slip(i))/(16.0_pReal*PI*abs(tau)) + EdgeDipDistance = 3.0_pReal*prm%mu*prm%burgers_slip(i)/(16.0_pReal*PI*abs(tau)) if (EdgeDipDistance>dst%mfp_slip(i,of)) EdgeDipDistance = dst%mfp_slip(i,of) if (EdgeDipDistance Date: Tue, 29 Jan 2019 06:41:27 +0100 Subject: [PATCH 061/107] sanity checks in more sensible order --- src/plastic_dislotwin.f90 | 113 ++++++++++++++++++-------------------- 1 file changed, 52 insertions(+), 61 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 2ee2a40e1..f201e90e0 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -150,8 +150,8 @@ module plastic_dislotwin threshold_stress_trans, & twinVolume, & martensiteVolume, & - tau_r_twin, & !< stress to bring partial close together for each twin system and instance - tau_r_trans !< stress to bring partial close together for each trans system and instance + tau_r_twin, & !< stress to bring partials close together (twin) + tau_r_trans !< stress to bring partials close together (trans) end type tDislotwinMicrostructure !-------------------------------------------------------------------------------------------------- @@ -269,6 +269,10 @@ subroutine plastic_dislotwin_init dst => microstructure(phase_plasticityInstance(p)), & config => config_phase(p)) + prm%aTolRho = config%getFloat('atol_rho', defaultVal=0.0_pReal) + prm%aTolTwinFrac = config%getFloat('atol_twinfrac', defaultVal=0.0_pReal) + prm%aTolTransFrac = config%getFloat('atol_transfrac', defaultVal=0.0_pReal) + ! This data is read in already in lattice prm%mu = lattice_mu(p) prm%nu = lattice_nu(p) @@ -307,6 +311,8 @@ subroutine plastic_dislotwin_init defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) ! Deprecated prm%CEdgeDipMinDistance = config%getFloat('cedgedipmindistance') + prm%D0 = config%getFloat('d0') + prm%Qsd = config%getFloat('qsd') prm%atomicVolume = config%getFloat('catomicvolume') * prm%burgers_slip**3.0_pReal ! expand: family => system @@ -323,16 +329,18 @@ subroutine plastic_dislotwin_init prm%atomicVolume = math_expand(prm%atomicVolume,prm%Nslip) ! sanity checks - if (any(prm%rho0 < 0.0_pReal)) extmsg = trim(extmsg)//'rho0 ' - if (any(prm%rhoDip0 < 0.0_pReal)) extmsg = trim(extmsg)//'rhoDip0 ' - if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//'v0 ' - if (any(prm%burgers_slip <= 0.0_pReal)) extmsg = trim(extmsg)//'burgers_slip ' - if (any(prm%Qedge <= 0.0_pReal)) extmsg = trim(extmsg)//'Qedge ' - if (any(prm%CLambdaSlip <= 0.0_pReal)) extmsg = trim(extmsg)//'CLambdaSlip ' - if (any(prm%B < 0.0_pReal)) extmsg = trim(extmsg)//'B ' - if (any(prm%tau_peierls < 0.0_pReal)) extmsg = trim(extmsg)//'tau_peierls ' - if (any(prm%p<=0.0_pReal .or. prm%p>1.0_pReal)) extmsg = trim(extmsg)//'p ' - if (any(prm%q< 1.0_pReal .or. prm%q>2.0_pReal)) extmsg = trim(extmsg)//'q ' + if ( prm%D0 <= 0.0_pReal) extmsg = trim(extmsg)//' D0' + if ( prm%Qsd <= 0.0_pReal) extmsg = trim(extmsg)//' Qsd' + if (any(prm%rho0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho0' + if (any(prm%rhoDip0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoDip0' + if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//' v0' + if (any(prm%burgers_slip <= 0.0_pReal)) extmsg = trim(extmsg)//' burgers_slip' + if (any(prm%Qedge <= 0.0_pReal)) extmsg = trim(extmsg)//' Qedge' + if (any(prm%CLambdaSlip <= 0.0_pReal)) extmsg = trim(extmsg)//' CLambdaSlip' + if (any(prm%B < 0.0_pReal)) extmsg = trim(extmsg)//' B' + if (any(prm%tau_peierls < 0.0_pReal)) extmsg = trim(extmsg)//' tau_peierls' + if (any(prm%p<=0.0_pReal .or. prm%p>1.0_pReal)) extmsg = trim(extmsg)//' p' + if (any(prm%q< 1.0_pReal .or. prm%q>2.0_pReal)) extmsg = trim(extmsg)//' q' else slipActive allocate(prm%burgers_slip(0)) @@ -445,66 +453,48 @@ subroutine plastic_dislotwin_init config%getFloats('interaction_sliptrans'), & config%getString('lattice_structure')) if (prm%fccTwinTransNucleation .and. prm%totalNtrans > 12_pInt) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if ntrans is [6,6] - endif - - - prm%aTolRho = config%getFloat('atol_rho', defaultVal=0.0_pReal) - prm%aTolTwinFrac = config%getFloat('atol_twinfrac', defaultVal=0.0_pReal) - prm%aTolTransFrac = config%getFloat('atol_transfrac', defaultVal=0.0_pReal) - - prm%GrainSize = config%getFloat('grainsize') - - - prm%D0 = config%getFloat('d0') - prm%Qsd = config%getFloat('qsd') - prm%SolidSolutionStrength = config%getFloat('solidsolutionstrength') ! Deprecated - if (config%keyExists('dipoleformationfactor')) call IO_error(1,ext_msg='use /nodipoleformation/') - prm%dipoleformation = .not. config%keyExists('/nodipoleformation/') - prm%sbVelocity = config%getFloat('shearbandvelocity',defaultVal=0.0_pReal) + endif + +!-------------------------------------------------------------------------------------------------- +! shearband related parameters + prm%sbVelocity = config%getFloat('shearbandvelocity',defaultVal=0.0_pReal) if (prm%sbVelocity > 0.0_pReal) then prm%sbResistance = config%getFloat('shearbandresistance') - prm%sbQedge = config%getFloat('qedgepersbsystem') - prm%pShearBand = config%getFloat('p_shearband') - prm%qShearBand = config%getFloat('q_shearband') + prm%sbQedge = config%getFloat('qedgepersbsystem') + prm%pShearBand = config%getFloat('p_shearband') + prm%qShearBand = config%getFloat('q_shearband') + + ! sanity checks + if (prm%sbResistance < 0.0_pReal) extmsg = trim(extmsg)//' shearbandresistance' + if (prm%sbQedge < 0.0_pReal) extmsg = trim(extmsg)//' qedgepersbsystem' + if (prm%pShearBand <= 0.0_pReal) extmsg = trim(extmsg)//' p_shearband' + if (prm%qShearBand <= 0.0_pReal) extmsg = trim(extmsg)//' q_shearband' endif + + + prm%GrainSize = config%getFloat('grainsize') + prm%SolidSolutionStrength = config%getFloat('solidsolutionstrength') ! Deprecated + + if (config%keyExists('dipoleformationfactor')) call IO_error(1,ext_msg='use /nodipoleformation/') + prm%dipoleformation = .not. config%keyExists('/nodipoleformation/') + + !if (Ndot0PerTwinFamily(f,p) < 0.0_pReal) & ! call IO_error(211_pInt,el=p,ext_msg='ndot0_twin ('//PLASTICITY_DISLOTWIN_label//')') if (any(prm%atomicVolume <= 0.0_pReal)) & call IO_error(211_pInt,el=p,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOTWIN_label//')') - if (prm%D0 <= 0.0_pReal) & - call IO_error(211_pInt,el=p,ext_msg='D0 ('//PLASTICITY_DISLOTWIN_label//')') - if (prm%Qsd <= 0.0_pReal) & - call IO_error(211_pInt,el=p,ext_msg='Qsd ('//PLASTICITY_DISLOTWIN_label//')') if (prm%totalNtwin > 0_pInt) then - if (dEq0(prm%SFE_0K) .and. & - dEq0(prm%dSFE_dT) .and. & - lattice_structure(p) == LATTICE_fcc_ID) & - call IO_error(211_pInt,el=p,ext_msg='SFE0K ('//PLASTICITY_DISLOTWIN_label//')') if (prm%aTolRho <= 0.0_pReal) & call IO_error(211_pInt,el=p,ext_msg='aTolRho ('//PLASTICITY_DISLOTWIN_label//')') if (prm%aTolTwinFrac <= 0.0_pReal) & call IO_error(211_pInt,el=p,ext_msg='aTolTwinFrac ('//PLASTICITY_DISLOTWIN_label//')') endif if (prm%totalNtrans > 0_pInt) then - if (dEq0(prm%SFE_0K) .and. & - dEq0(prm%dSFE_dT) .and. & - lattice_structure(p) == LATTICE_fcc_ID) & - call IO_error(211_pInt,el=p,ext_msg='SFE0K ('//PLASTICITY_DISLOTWIN_label//')') if (prm%aTolTransFrac <= 0.0_pReal) & call IO_error(211_pInt,el=p,ext_msg='aTolTransFrac ('//PLASTICITY_DISLOTWIN_label//')') endif - !if (prm%sbResistance < 0.0_pReal) & - ! call IO_error(211_pInt,el=p,ext_msg='sbResistance ('//PLASTICITY_DISLOTWIN_label//')') - !if (prm%sbVelocity < 0.0_pReal) & - ! call IO_error(211_pInt,el=p,ext_msg='sbVelocity ('//PLASTICITY_DISLOTWIN_label//')') - !if (prm%sbVelocity > 0.0_pReal .and. & - ! prm%pShearBand <= 0.0_pReal) & - ! call IO_error(211_pInt,el=p,ext_msg='pShearBand ('//PLASTICITY_DISLOTWIN_label//')') - if (prm%sbVelocity > 0.0_pReal .and. & - prm%qShearBand <= 0.0_pReal) & - call IO_error(211_pInt,el=p,ext_msg='qShearBand ('//PLASTICITY_DISLOTWIN_label//')') outputs = config%getStrings('(output)', defaultVal=emptyStringArray) allocate(prm%outputID(0)) @@ -599,13 +589,13 @@ subroutine plastic_dislotwin_init plasticState(p)%accumulatedSlip => plasticState(p)%state(startIndex:endIndex,:) startIndex = endIndex + 1_pInt - endIndex=endIndex+prm%totalNtwin + endIndex = endIndex + prm%totalNtwin stt%twinFraction=>plasticState(p)%state(startIndex:endIndex,:) dot%twinFraction=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac startIndex = endIndex + 1_pInt - endIndex=endIndex+prm%totalNtrans + endIndex = endIndex + prm%totalNtrans stt%strainTransFraction=>plasticState(p)%state(startIndex:endIndex,:) dot%strainTransFraction=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTransFrac @@ -619,13 +609,13 @@ subroutine plastic_dislotwin_init allocate(dst%invLambdaTwin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) allocate(dst%mfp_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) allocate(dst%threshold_stress_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) - allocate(dst%tau_r_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) !* equilibrium separation of partial dislocations (twin) + allocate(dst%tau_r_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) allocate(dst%twinVolume (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) allocate(dst%invLambdaTrans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) allocate(dst%mfp_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) allocate(dst%threshold_stress_trans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) - allocate(dst%tau_r_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) !* equilibrium separation of partial dislocations (trans) + allocate(dst%tau_r_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) allocate(dst%martensiteVolume (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) @@ -815,8 +805,9 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) tol_math_check, & dEq0 use math, only: & + math_clip, & math_mul33xx33, & - pi + PI use material, only: & plasticState @@ -940,7 +931,7 @@ subroutine plastic_dislotwin_dependentState(temperature,instance,of) sumf_twin = sum(stt%twinFraction(1:prm%totalNtwin,of)) sumf_trans = sum(stt%strainTransFraction(1:prm%totalNtrans,of)) - sfe = prm%SFE_0K + prm%dSFE_dT * Temperature + SFE = prm%SFE_0K + prm%dSFE_dT * Temperature !* rescaled volume fraction for topology fOverStacksize = stt%twinFraction(1_pInt:prm%totalNtwin,of)/prm%twinsize !ToDo: this is per system @@ -999,11 +990,11 @@ subroutine plastic_dislotwin_dependentState(temperature,instance,of) !* threshold stress for growing twin/martensite if(prm%totalNtwin == prm%totalNslip) & dst%threshold_stress_twin(:,of) = prm%Cthresholdtwin* & - (sfe/(3.0_pReal*prm%burgers_twin)+ 3.0_pReal*prm%burgers_twin*prm%mu/ & + (SFE/(3.0_pReal*prm%burgers_twin)+ 3.0_pReal*prm%burgers_twin*prm%mu/ & (prm%L0_twin*prm%burgers_slip)) ! slip burgers here correct? if(prm%totalNtrans == prm%totalNslip) & dst%threshold_stress_trans(:,of) = prm%Cthresholdtrans* & - (sfe/(3.0_pReal*prm%burgers_trans) + 3.0_pReal*prm%burgers_trans*prm%mu/& + (SFE/(3.0_pReal*prm%burgers_trans) + 3.0_pReal*prm%burgers_trans*prm%mu/& (prm%L0_trans*prm%burgers_slip) + prm%transStackHeight*prm%deltaG/ (3.0_pReal*prm%burgers_trans) ) From c10922de2b4631f274597222d67cedf4c0aff65d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 06:52:55 +0100 Subject: [PATCH 062/107] vector notation easier to read --- src/plastic_dislotwin.f90 | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index f201e90e0..c96fb9c29 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -822,11 +822,13 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) integer(pInt) :: i real(pReal) :: f_unrotated,& - EdgeDipMinDistance,VacancyDiffusion,& + VacancyDiffusion,& EdgeDipDistance, ClimbVelocity,DotRhoEdgeDipClimb,DotRhoEdgeDipAnnihilation, & - DotRhoDipFormation,DotRhoMultiplication,DotRhoEdgeEdgeAnnihilation, & + DotRhoDipFormation,DotRhoEdgeEdgeAnnihilation, & tau real(pReal), dimension(plasticState(instance)%Nslip) :: & + EdgeDipMinDistance, & + DotRhoMultiplication, & gdot_slip real(pReal), dimension(plasticState(instance)%Ntwin) :: & gdot_twin @@ -839,23 +841,25 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) f_unrotated = 1.0_pReal & - sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) & - sum(stt%strainTransFraction(1_pInt:prm%totalNtrans,of)) + VacancyDiffusion = prm%D0*exp(-prm%Qsd/(kB*Temperature)) call kinetics_slip(Mp,temperature,instance,of,gdot_slip) + dot%accshear_slip(:,of) = abs(gdot_slip) + + DotRhoMultiplication = abs(gdot_slip)/(prm%burgers_slip*dst%mfp_slip(:,of)) + EdgeDipMinDistance = prm%CEdgeDipMinDistance*prm%burgers_slip slipState: do i = 1_pInt, prm%totalNslip tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) - DotRhoMultiplication = abs(gdot_slip(i))/(prm%burgers_slip(i)*dst%mfp_slip(i,of)) - EdgeDipMinDistance = prm%CEdgeDipMinDistance*prm%burgers_slip(i) - significantSlipStress2: if (dEq0(tau)) then DotRhoDipFormation = 0.0_pReal else significantSlipStress2 EdgeDipDistance = 3.0_pReal*prm%mu*prm%burgers_slip(i)/(16.0_pReal*PI*abs(tau)) if (EdgeDipDistance>dst%mfp_slip(i,of)) EdgeDipDistance = dst%mfp_slip(i,of) - if (EdgeDipDistance Date: Tue, 29 Jan 2019 07:06:16 +0100 Subject: [PATCH 063/107] bugfix: missing initialization --- src/crystallite.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index ad12b455e..da603a2bd 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -854,6 +854,7 @@ subroutine crystallite_stressTangent() crystallite_invFp(1:3,1:3,c,i,e)), & math_6toSym33(crystallite_Tstar_v(1:6,c,i,e))) + crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal do p=1_pInt, 3_pInt crystallite_dPdF(p,1:3,p,1:3,c,i,e) = transpose(temp_33_1) enddo From 4967ac0132beec639857d80b2adb01403319603f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 07:22:56 +0100 Subject: [PATCH 064/107] need to check for significant stress only once --- src/plastic_dislotwin.f90 | 36 +++++++++++++++++------------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index c96fb9c29..7e5272dc2 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -852,19 +852,30 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) slipState: do i = 1_pInt, prm%totalNslip tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) - significantSlipStress2: if (dEq0(tau)) then + significantSlipStress: if (dEq0(tau)) then DotRhoDipFormation = 0.0_pReal - else significantSlipStress2 + DotRhoEdgeDipClimb = 0.0_pReal + else significantSlipStress EdgeDipDistance = 3.0_pReal*prm%mu*prm%burgers_slip(i)/(16.0_pReal*PI*abs(tau)) - if (EdgeDipDistance>dst%mfp_slip(i,of)) EdgeDipDistance = dst%mfp_slip(i,of) - if (EdgeDipDistance Date: Tue, 29 Jan 2019 00:54:02 +0100 Subject: [PATCH 065/107] further simplifications --- src/crystallite.f90 | 34 ++++++++++++---------------------- 1 file changed, 12 insertions(+), 22 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index da603a2bd..ab99156d0 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1861,18 +1861,13 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & ! contribution to state and relative residui and from Euler integration call update_dotState(1.0_pReal) - !$OMP PARALLEL - - - ! --- STATE UPDATE (EULER INTEGRATION) --- - - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c) + !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - c = phasememberAt(g,i,e) + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + mySizePlasticDotState = plasticState(p)%sizeDotState plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & - 0.5_pReal & @@ -1895,28 +1890,24 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & enddo endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO + call update_deltaState call update_dependentState call update_stress(1.0_pReal) call update_dotState(1.0_pReal) - !$OMP PARALLEL - ! --- ERROR ESTIMATE FOR STATE (HEUN METHOD) --- - - !$OMP SINGLE relPlasticStateResiduum = 0.0_pReal relSourceStateResiduum = 0.0_pReal - !$OMP END SINGLE - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,converged,p,c,s) + + !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,converged,p,c,s) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - c = phasememberAt(g,i,e) + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + ! --- contribution of heun step to absolute residui --- mySizePlasticDotState = plasticState(p)%sizeDotState plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & @@ -1958,8 +1949,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definitionem endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO ! --- NONLOCAL CONVERGENCE CHECK --- From 1e4da6fbdb17f8a1ed70c0474755f4da8a8f70fc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 05:11:29 +0100 Subject: [PATCH 066/107] nonlocal convergence check in function --- src/crystallite.f90 | 108 ++++++++++++++++++-------------------------- 1 file changed, 44 insertions(+), 64 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index ab99156d0..14a54492a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1542,8 +1542,7 @@ subroutine integrateStateFPI() nState, & rTol_crystalliteState use mesh, only: & - mesh_element, & - mesh_NcpElems + mesh_element use material, only: & plasticState, & sourceState, & @@ -1727,12 +1726,7 @@ subroutine integrateStateFPI() !$OMP END PARALLEL - ! --- NON-LOCAL CONVERGENCE CHECK --- - - if (any(plasticState(:)%nonlocal)) then ! if not requesting Integration of just a single IP - if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged - endif + if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck ! --- CHECK IF DONE WITH INTEGRATION --- @@ -1777,26 +1771,21 @@ end subroutine integrateStateFPI !-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, and state with 1st order explicit Euler method +!> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- subroutine integrateStateEuler() use material, only: & plasticState + implicit none call update_dotState(1.0_pReal) - call update_State(1.0_pReal) + call update_state(1.0_pReal) call update_deltaState call update_dependentState call update_stress(1.0_pReal) call setConvergenceFlag - - ! --- CHECK NON-LOCAL CONVERGENCE --- - - if (any(plasticState(:)%nonlocal)) then - if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity) ) & ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged - endif + if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck end subroutine integrateStateEuler @@ -1848,8 +1837,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & relSourceStateResiduum ! relative residuum from evolution in microstructure logical :: & - converged, & - NaN + converged plasticStateResiduum = 0.0_pReal @@ -1951,13 +1939,8 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & enddo; enddo; enddo !$OMP END PARALLEL DO + if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck - ! --- NONLOCAL CONVERGENCE CHECK --- - - if (any(plasticState(:)%nonlocal)) then - if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity) ) & ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged - endif end subroutine integrateStateAdaptiveEuler @@ -2038,7 +2021,9 @@ subroutine integrateStateRK4() !$OMP PARALLEL !$OMP DO PRIVATE(p,c) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) c = phasememberAt(g,i,e) @@ -2066,14 +2051,9 @@ subroutine integrateStateRK4() enddo + call setConvergenceFlag - - ! --- CHECK NONLOCAL CONVERGENCE --- - - if (any(plasticState(:)%nonlocal)) then - if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity) ) & ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged - endif + if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck end subroutine integrateStateRK4 @@ -2148,11 +2128,7 @@ subroutine integrateStateRKCK45() mySource, & mySizePlasticDotState, & ! size of dot States mySizeSourceDotState - integer(pInt), dimension(2) :: & - eIter ! bounds for element iteration - integer(pInt), dimension(2,mesh_NcpElems) :: & - iIter, & ! bounds for ip iteration - gIter ! bounds for grain iteration + real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & @@ -2163,18 +2139,7 @@ subroutine integrateStateRKCK45() homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & sourceStateResiduum, & ! residuum from evolution in microstructure relSourceStateResiduum ! relative residuum from evolution in microstructure - logical :: & - singleRun ! flag indicating computation for single (g,i,e) triple - eIter = FEsolving_execElem(1:2) - - ! --- LOOP ITERATOR FOR ELEMENT, GRAIN, IP --- - do e = eIter(1),eIter(2) - iIter(1:2,e) = FEsolving_execIP(1:2,e) - gIter(1:2,e) = [ 1_pInt,homogenization_Ngrains(mesh_element(3,e))] - enddo - - singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) call update_dotState(1.0_pReal) @@ -2188,7 +2153,9 @@ subroutine integrateStateRKCK45() !$OMP PARALLEL !$OMP DO PRIVATE(p,cc) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) @@ -2201,7 +2168,9 @@ subroutine integrateStateRKCK45() !$OMP ENDDO !$OMP DO PRIVATE(p,cc,n) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) @@ -2239,7 +2208,9 @@ subroutine integrateStateRKCK45() relSourceStateResiduum = 0.0_pReal !$OMP PARALLEL !$OMP DO PRIVATE(p,cc) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) @@ -2252,7 +2223,9 @@ subroutine integrateStateRKCK45() !$OMP ENDDO !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) @@ -2288,7 +2261,9 @@ subroutine integrateStateRKCK45() ! --- relative residui and state convergence --- !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc,s) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) @@ -2324,15 +2299,25 @@ subroutine integrateStateRKCK45() call update_dependentState call update_stress(1.0_pReal) call setConvergenceFlag - - - ! --- nonlocal convergence check --- - if ((.not. singleRun) .and. any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... - crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged + if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck end subroutine integrateStateRKCK45 +!-------------------------------------------------------------------------------------------------- +!> @brief sets convergence flag for nonlocal calculations +!> @detail one non-converged nonlocal sets all other nonlocals to non-converged to trigger cut back +!-------------------------------------------------------------------------------------------------- +subroutine nonlocalConvergenceCheck() + + implicit none + + if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... + where( .not. crystallite_localPlasticity) crystallite_converged = .false. + +end subroutine nonlocalConvergenceCheck + + !-------------------------------------------------------------------------------------------------- !> @brief Sets convergence flag based on "todo": every point that survived the integration (todo is ! still .true. is considered as converged @@ -2361,11 +2346,6 @@ end subroutine setConvergenceFlag !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- subroutine update_stress(timeFraction) - use material, only: & - plasticState, & - sourceState, & - phase_Nsources, & - phaseAt, phasememberAt implicit none real(pReal), intent(in) :: & From 4a69032637141f7856e2bf65a72bfc0579ef66ed Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 05:16:56 +0100 Subject: [PATCH 067/107] better readable --- src/crystallite.f90 | 19 ++++--------------- 1 file changed, 4 insertions(+), 15 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 14a54492a..8ae1df5af 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2065,17 +2065,6 @@ end subroutine integrateStateRK4 subroutine integrateStateRKCK45() use, intrinsic :: & IEEE_arithmetic -#ifdef DEBUG - use debug, only: & - debug_e, & - debug_i, & - debug_g, & - debug_level, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif use numerics, only: & rTol_crystalliteState use mesh, only: & @@ -2098,11 +2087,11 @@ subroutine integrateStateRKCK45() implicit none real(pReal), dimension(5,5), parameter :: & A = reshape([& - .2_pReal, .075_pReal, .3_pReal, -11.0_pReal/54.0_pReal, 1631.0_pReal/55296.0_pReal, & - .0_pReal, .225_pReal, -.9_pReal, 2.5_pReal, 175.0_pReal/512.0_pReal, & - .0_pReal, .0_pReal, 1.2_pReal, -70.0_pReal/27.0_pReal, 575.0_pReal/13824.0_pReal, & + .2_pReal, .075_pReal, .3_pReal, -11.0_pReal/54.0_pReal, 1631.0_pReal/55296.0_pReal, & + .0_pReal, .225_pReal, -.9_pReal, 2.5_pReal, 175.0_pReal/512.0_pReal, & + .0_pReal, .0_pReal, 1.2_pReal, -70.0_pReal/27.0_pReal, 575.0_pReal/13824.0_pReal, & .0_pReal, .0_pReal, .0_pReal, 35.0_pReal/27.0_pReal, 44275.0_pReal/110592.0_pReal, & - .0_pReal, .0_pReal, .0_pReal, .0_pReal, 253.0_pReal/4096.0_pReal], & + .0_pReal, .0_pReal, .0_pReal, .0_pReal, 253.0_pReal/4096.0_pReal], & [5,5], order=[2,1]) !< coefficients in Butcher tableau (used for preliminary integration in stages 2 to 6) real(pReal), dimension(6), parameter :: & From a24d8b86bf44255e5fc9d29879d92eac6bafab59 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 05:20:16 +0100 Subject: [PATCH 068/107] convergence of plastic state can be done earlier --- src/crystallite.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 8ae1df5af..475d7dc2a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1651,6 +1651,13 @@ subroutine integrateStateFPI() plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & + plasticState(p)%previousDotState(:,c) & * (1.0_pReal - stateDamper) + + converged = all( abs(plasticStateResiduum(1:mySizePlasticDotState)) < & + plasticState(p)%aTolState(1:mySizePlasticDotState) & + .or. abs(plasticStateResiduum(1:mySizePlasticDotState)) < & + rTol_crystalliteState * abs(tempPlasticState(1:mySizePlasticDotState))) + + plasticState(p)%state(1:mySizePlasticDotState,c) = tempPlasticState(1:mySizePlasticDotState) do s = 1_pInt, phase_Nsources(p) StateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & @@ -1676,12 +1683,6 @@ subroutine integrateStateFPI() * (1.0_pReal - stateDamper) enddo - - ! --- converged ? --- - converged = all( abs(plasticStateResiduum(1:mySizePlasticDotState)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState) & - .or. abs(plasticStateResiduum(1:mySizePlasticDotState)) < & - rTol_crystalliteState * abs(tempPlasticState(1:mySizePlasticDotState))) do s = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState converged = converged .and. & @@ -1692,8 +1693,7 @@ subroutine integrateStateFPI() enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition - plasticState(p)%state(1:mySizePlasticDotState,c) = & - tempPlasticState(1:mySizePlasticDotState) + do s = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) = & From 41832fb554335c1ae0624fc310c749d40cfa542f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 05:39:01 +0100 Subject: [PATCH 069/107] no need for two variables only resulted in confusing code --- src/crystallite.f90 | 67 ++++++++++++++++++++++----------------------- 1 file changed, 33 insertions(+), 34 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 475d7dc2a..74dfd3731 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1565,8 +1565,7 @@ subroutine integrateStateFPI() p, & c, & s, & - mySizePlasticDotState, & ! size of dot states - mySizeSourceDotState + sizeDotState real(pReal) :: & stateDamper real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & @@ -1618,7 +1617,7 @@ subroutine integrateStateFPI() !$OMP PARALLEL ! --- UPDATE STATE --- - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState, & + !$OMP DO PRIVATE(sizeDotState, & !$OMP& plasticStateResiduum,sourceStateResiduum, & !$OMP& stateDamper, & !$OMP& tempPlasticState,tempSourceState,converged,p,c) @@ -1633,18 +1632,18 @@ subroutine integrateStateFPI() plasticState(p)%previousDotState (:,c), & plasticState(p)%previousDotState2(:,c)) - mySizePlasticDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:mySizePlasticDotState) = & - plasticState(p)%state(1:mySizePlasticDotState,c) & - - plasticState(p)%subState0(1:mySizePlasticDotState,c) & - - ( plasticState(p)%dotState(1:mySizePlasticDotState,c) * stateDamper & - + plasticState(p)%previousDotState(1:mySizePlasticDotState,c) & + sizeDotState = plasticState(p)%sizeDotState + plasticStateResiduum(1:sizeDotState) = & + plasticState(p)%state(1:sizeDotState,c) & + - plasticState(p)%subState0(1:sizeDotState,c) & + - ( plasticState(p)%dotState(1:sizeDotState,c) * stateDamper & + + plasticState(p)%previousDotState(1:sizeDotState,c) & * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- - tempPlasticState(1:mySizePlasticDotState) = & - plasticState(p)%state(1:mySizePlasticDotState,c) & - - plasticStateResiduum(1:mySizePlasticDotState) ! need to copy to local variable, since we cant flush a pointer in openmp + tempPlasticState(1:sizeDotState) = & + plasticState(p)%state(1:sizeDotState,c) & + - plasticStateResiduum(1:sizeDotState) ! need to copy to local variable, since we cant flush a pointer in openmp ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) @@ -1652,29 +1651,29 @@ subroutine integrateStateFPI() + plasticState(p)%previousDotState(:,c) & * (1.0_pReal - stateDamper) - converged = all( abs(plasticStateResiduum(1:mySizePlasticDotState)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState) & - .or. abs(plasticStateResiduum(1:mySizePlasticDotState)) < & - rTol_crystalliteState * abs(tempPlasticState(1:mySizePlasticDotState))) + converged = all( abs(plasticStateResiduum(1:sizeDotState)) < & + plasticState(p)%aTolState(1:sizeDotState) & + .or. abs(plasticStateResiduum(1:sizeDotState)) < & + rTol_crystalliteState * abs(tempPlasticState(1:sizeDotState))) - plasticState(p)%state(1:mySizePlasticDotState,c) = tempPlasticState(1:mySizePlasticDotState) + plasticState(p)%state(1:sizeDotState,c) = tempPlasticState(1:sizeDotState) do s = 1_pInt, phase_Nsources(p) StateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & sourceState(p)%p(s)%previousDotState (:,c), & sourceState(p)%p(s)%previousDotState2(:,c)) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:mySizeSourceDotState,s) = & - sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) & - - sourceState(p)%p(s)%subState0(1:mySizeSourceDotState,c) & - - ( sourceState(p)%p(s)%dotState(1:mySizeSourceDotState,c) * stateDamper & - + sourceState(p)%p(s)%previousDotState(1:mySizeSourceDotState,c) & + sizeDotState = sourceState(p)%p(s)%sizeDotState + sourceStateResiduum(1:sizeDotState,s) = & + sourceState(p)%p(s)%state(1:sizeDotState,c) & + - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & + - ( sourceState(p)%p(s)%dotState(1:sizeDotState,c) * stateDamper & + + sourceState(p)%p(s)%previousDotState(1:sizeDotState,c) & * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- - tempSourceState(1:mySizeSourceDotState,s) = & - sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) & - - sourceStateResiduum(1:mySizeSourceDotState,s) ! need to copy to local variable, since we cant flush a pointer in openmp + tempSourceState(1:sizeDotState,s) = & + sourceState(p)%p(s)%state(1:sizeDotState,c) & + - sourceStateResiduum(1:sizeDotState,s) ! need to copy to local variable, since we cant flush a pointer in openmp ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) sourceState(p)%p(s)%dotState(:,c) = & @@ -1684,20 +1683,20 @@ subroutine integrateStateFPI() enddo do s = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sizeDotState = sourceState(p)%p(s)%sizeDotState converged = converged .and. & - all( abs(sourceStateResiduum(1:mySizeSourceDotState,s)) < & - sourceState(p)%p(s)%aTolState(1:mySizeSourceDotState) & - .or. abs(sourceStateResiduum(1:mySizeSourceDotState,s)) < & - rTol_crystalliteState * abs(tempSourceState(1:mySizeSourceDotState,s))) + all( abs(sourceStateResiduum(1:sizeDotState,s)) < & + sourceState(p)%p(s)%aTolState(1:sizeDotState) & + .or. abs(sourceStateResiduum(1:sizeDotState,s)) < & + rTol_crystalliteState * abs(tempSourceState(1:sizeDotState,s))) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition do s = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%state(1:mySizeSourceDotState,c) = & - tempSourceState(1:mySizeSourceDotState,s) + sizeDotState = sourceState(p)%p(s)%sizeDotState + sourceState(p)%p(s)%state(1:sizeDotState,c) = & + tempSourceState(1:sizeDotState,s) enddo endif enddo; enddo; enddo From 34f3c15552a3639cbe7acbd89f8b001cc123bfef Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 05:47:13 +0100 Subject: [PATCH 070/107] no need for temp variables --- src/crystallite.f90 | 28 ++++++++-------------------- 1 file changed, 8 insertions(+), 20 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 74dfd3731..8efe15040 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1569,11 +1569,9 @@ subroutine integrateStateFPI() real(pReal) :: & stateDamper real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & - plasticStateResiduum, & - tempPlasticState + plasticStateResiduum real(pReal), dimension(constitutive_source_maxSizeDotState, maxval(phase_Nsources)) :: & - sourceStateResiduum, & ! residuum from evolution in micrstructure - tempSourceState + sourceStateResiduum logical :: & converged, & doneWithIntegration @@ -1619,8 +1617,7 @@ subroutine integrateStateFPI() !$OMP DO PRIVATE(sizeDotState, & !$OMP& plasticStateResiduum,sourceStateResiduum, & - !$OMP& stateDamper, & - !$OMP& tempPlasticState,tempSourceState,converged,p,c) + !$OMP& stateDamper, converged,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -1641,11 +1638,10 @@ subroutine integrateStateFPI() * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- - tempPlasticState(1:sizeDotState) = & + plasticState(p)%state(1:sizeDotState,c) = & plasticState(p)%state(1:sizeDotState,c) & - - plasticStateResiduum(1:sizeDotState) ! need to copy to local variable, since we cant flush a pointer in openmp + - plasticStateResiduum(1:sizeDotState) - ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & + plasticState(p)%previousDotState(:,c) & @@ -1654,9 +1650,8 @@ subroutine integrateStateFPI() converged = all( abs(plasticStateResiduum(1:sizeDotState)) < & plasticState(p)%aTolState(1:sizeDotState) & .or. abs(plasticStateResiduum(1:sizeDotState)) < & - rTol_crystalliteState * abs(tempPlasticState(1:sizeDotState))) + rTol_crystalliteState * abs( plasticState(p)%state(1:sizeDotState,c))) - plasticState(p)%state(1:sizeDotState,c) = tempPlasticState(1:sizeDotState) do s = 1_pInt, phase_Nsources(p) StateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & @@ -1671,11 +1666,10 @@ subroutine integrateStateFPI() * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- - tempSourceState(1:sizeDotState,s) = & + sourceState(p)%p(s)%state(1:sizeDotState,c) = & sourceState(p)%p(s)%state(1:sizeDotState,c) & - sourceStateResiduum(1:sizeDotState,s) ! need to copy to local variable, since we cant flush a pointer in openmp - ! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp) sourceState(p)%p(s)%dotState(:,c) = & sourceState(p)%p(s)%dotState(:,c) * stateDamper & + sourceState(p)%p(s)%previousDotState(:,c) & @@ -1688,16 +1682,10 @@ subroutine integrateStateFPI() all( abs(sourceStateResiduum(1:sizeDotState,s)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState) & .or. abs(sourceStateResiduum(1:sizeDotState,s)) < & - rTol_crystalliteState * abs(tempSourceState(1:sizeDotState,s))) + rTol_crystalliteState * abs(sourceState(p)%p(s)%state(1:sizeDotState,c))) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition - - do s = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%state(1:sizeDotState,c) = & - tempSourceState(1:sizeDotState,s) - enddo endif enddo; enddo; enddo !$OMP ENDDO From 066c598203a3bdb3f5e84185dd7051712fa17c0c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 10:52:00 +0100 Subject: [PATCH 071/107] wrong dot product in state damper --- src/crystallite.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 8efe15040..ef898bd77 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1744,8 +1744,8 @@ subroutine integrateStateFPI() real(pReal) :: dot_prod12, dot_prod22 - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(current - previous2, previous - previous2) + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) if (dot_prod22 > 0.0_pReal .and. (dot_prod12 < 0.0_pReal .or. dot_product(current,previous) < 0.0_pReal)) then damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) else From 27b034eb76dfe02a79e2f2e6e519b323ff8ad266 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Tue, 29 Jan 2019 12:31:16 -0500 Subject: [PATCH 072/107] fixed bug in recursiveRead that failed to properly {include} in the last line of a file --- src/IO.f90 | 49 +++++++++++++++++++++++++----------------------- src/material.f90 | 6 +++--- 2 files changed, 29 insertions(+), 26 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 1f9ff937c..c8fe26735 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -186,11 +186,10 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent) fileUnit, & startPos, endPos, & myTotalLines, & !< # lines read from file without include statements - includedLines, & !< # lines included from other file(s) - missingLines, & !< # lines missing from current file l,i, & myStat - + logical :: warned + if (present(cnt)) then if (cnt>10_pInt) call IO_error(106_pInt,ext_msg=trim(fileName)) endif @@ -207,37 +206,39 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent) !-------------------------------------------------------------------------------------------------- ! count lines to allocate string array - myTotalLines = 0_pInt + myTotalLines = 1_pInt do l=1_pInt, len(rawData) - if (rawData(l:l) == new_line('') .or. l==len(rawData)) myTotalLines = myTotalLines+1 ! end of line or end of file without new line + if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1 enddo allocate(fileContent(myTotalLines)) !-------------------------------------------------------------------------------------------------- ! split raw data at end of line and handle includes + warned = .false. startPos = 1_pInt - endPos = 0_pInt + l = 1_pInt + do while (l <= myTotalLines) + endPos = merge(startPos + scan(rawData(startPos:),new_line('')) - 2_pInt,len(rawData),l /= myTotalLines) + if (endPos - startPos > 255_pInt) then + line = rawData(startPos:startPos+255_pInt) + if (.not. warned) then + call IO_warning(207_pInt,ext_msg=trim(fileName),el=l) + warned = .true. + endif + else + line = rawData(startPos:endpos) + endif + startPos = endPos + 2_pInt ! jump to next line start - includedLines=0_pInt - l=0_pInt - do while (startPos <= len(rawData)) - l = l + 1_pInt - endPos = endPos + scan(rawData(startPos:),new_line('')) - if(endPos < startPos) endPos = len(rawData) ! end of file without end of line - if(endPos - startPos >256) call IO_error(107_pInt,ext_msg=trim(fileName)) - line = rawData(startPos:endPos-1_pInt) - startPos = endPos + 1_pInt - - recursion: if(scan(trim(line),'{') < scan(trim(line),'}')) then - myTotalLines = myTotalLines - 1_pInt + recursion: if (scan(trim(adjustl(line)),'{') == 1 .and. scan(trim(line),'}') > 2) then includedContent = IO_recursiveRead(trim(line(scan(line,'{')+1_pInt:scan(line,'}')-1_pInt)), & - merge(cnt,1_pInt,present(cnt))) ! to track recursion depth - includedLines = includedLines + size(includedContent) - missingLines = myTotalLines + includedLines - size(fileContent(1:l-1)) -size(includedContent) - fileContent = [ fileContent(1:l-1_pInt), includedContent, [(dummy,i=1,missingLines)] ] ! add content and grow array - l = l - 1_pInt + size(includedContent) + merge(cnt,1_pInt,present(cnt))) ! to track recursion depth + fileContent = [ fileContent(1:l-1_pInt), includedContent, [(dummy,i=1,myTotalLines-l)] ] ! add content and grow array + myTotalLines = myTotalLines - 1_pInt + size(includedContent) + l = l - 1_pInt + size(includedContent) else recursion fileContent(l) = line + l = l + 1_pInt endif recursion enddo @@ -1498,6 +1499,8 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) msg = 'invalid character in string chunk' case (203_pInt) msg = 'interpretation of string chunk failed' + case (207_pInt) + msg = 'line truncated' case (600_pInt) msg = 'crystallite responds elastically' case (601_pInt) diff --git a/src/material.f90 b/src/material.f90 index d12321235..3ae6c16a4 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -327,19 +327,19 @@ subroutine material_init() #include "compilation_info.f90" call material_parsePhase() - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) + 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) + 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) + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) allocate(plasticState (size(config_phase))) allocate(sourceState (size(config_phase))) From 0c21da2605b55bf0df36d7166977094fcaabd3a2 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 29 Jan 2019 19:25:42 +0100 Subject: [PATCH 073/107] [skip ci] updated version information after successful test of v2.0.2-1614-g8764c615 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 31608bd97..82ddb5e1a 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1608-gcd3cbf47 +v2.0.2-1614-g8764c615 From c017b6eea3af3fe9c8dce70904b30e63a6db80bf Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 29 Jan 2019 22:02:19 +0100 Subject: [PATCH 074/107] [skip ci] updated version information after successful test of v2.0.2-1615-g27b034eb --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 31608bd97..bf866d316 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1608-gcd3cbf47 +v2.0.2-1615-g27b034eb From 38d8e429fff2c4bdab56291ee209d853fa8a1c6b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 08:29:19 +0100 Subject: [PATCH 075/107] layout adjustments --- src/crystallite.f90 | 90 ++++++++++++++++++++------------------------- 1 file changed, 40 insertions(+), 50 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index ef898bd77..74eef259e 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1586,24 +1586,25 @@ subroutine integrateStateFPI() NiterationState = NiterationState + 1_pInt ! store previousDotState and previousDotState2 + !$OMP PARALLEL DO PRIVATE(p,c) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - plasticState(p)%previousDotState2(:,c) = merge(plasticState(p)%previousDotState(:,c),& - 0.0_pReal,& - NiterationState > 1_pInt) - plasticState(p)%previousDotState (:,c) = plasticState(p)%dotState(:,c) - do s = 1_pInt, phase_Nsources(p) - sourceState(p)%p(s)%previousDotState2(:,c) = merge(sourceState(p)%p(s)%previousDotState(:,c),& - 0.0_pReal, & - NiterationState > 1_pInt) - sourceState(p)%p(s)%previousDotState (:,c) = sourceState(p)%p(s)%dotState(:,c) - enddo - endif + plasticState(p)%previousDotState2(:,c) = merge(plasticState(p)%previousDotState(:,c),& + 0.0_pReal,& + NiterationState > 1_pInt) + plasticState(p)%previousDotState (:,c) = plasticState(p)%dotState(:,c) + do s = 1_pInt, phase_Nsources(p) + sourceState(p)%p(s)%previousDotState2(:,c) = merge(sourceState(p)%p(s)%previousDotState(:,c),& + 0.0_pReal, & + NiterationState > 1_pInt) + sourceState(p)%p(s)%previousDotState (:,c) = sourceState(p)%p(s)%dotState(:,c) + enddo + endif enddo enddo enddo @@ -1612,40 +1613,33 @@ subroutine integrateStateFPI() call update_dependentState call update_stress(1.0_pReal) call update_dotState(1.0_pReal) -!$OMP PARALLEL - ! --- UPDATE STATE --- - + + !$OMP PARALLEL !$OMP DO PRIVATE(sizeDotState, & !$OMP& plasticStateResiduum,sourceStateResiduum, & !$OMP& stateDamper, converged,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - p = phaseAt(g,i,e) - c = phasememberAt(g,i,e) StateDamper = damper(plasticState(p)%dotState (:,c), & plasticState(p)%previousDotState (:,c), & plasticState(p)%previousDotState2(:,c)) + sizeDotState = plasticState(p)%sizeDotState - sizeDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:sizeDotState) = & - plasticState(p)%state(1:sizeDotState,c) & - - plasticState(p)%subState0(1:sizeDotState,c) & - - ( plasticState(p)%dotState(1:sizeDotState,c) * stateDamper & - + plasticState(p)%previousDotState(1:sizeDotState,c) & - * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) + plasticStateResiduum(1:sizeDotState) = plasticState(p)%state (1:sizeDotState,c) & + - plasticState(p)%subState0(1:sizeDotState,c) & + - ( plasticState(p)%dotState (:,c) * stateDamper & + + plasticState(p)%previousDotState(:,c) * (1.0_pReal-stateDamper) & + ) * crystallite_subdt(g,i,e) - ! --- correct state with residuum --- - plasticState(p)%state(1:sizeDotState,c) = & - plasticState(p)%state(1:sizeDotState,c) & - - plasticStateResiduum(1:sizeDotState) + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%state(1:sizeDotState,c) & + - plasticStateResiduum(1:sizeDotState) - - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & - + plasticState(p)%previousDotState(:,c) & - * (1.0_pReal - stateDamper) + plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & + + plasticState(p)%previousDotState(:,c) * (1.0_pReal - stateDamper) converged = all( abs(plasticStateResiduum(1:sizeDotState)) < & plasticState(p)%aTolState(1:sizeDotState) & @@ -1653,17 +1647,16 @@ subroutine integrateStateFPI() rTol_crystalliteState * abs( plasticState(p)%state(1:sizeDotState,c))) - do s = 1_pInt, phase_Nsources(p) - StateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & + do s = 1_pInt, phase_Nsources(p) + stateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & sourceState(p)%p(s)%previousDotState (:,c), & sourceState(p)%p(s)%previousDotState2(:,c)) - sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s) = & - sourceState(p)%p(s)%state(1:sizeDotState,c) & - - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - - ( sourceState(p)%p(s)%dotState(1:sizeDotState,c) * stateDamper & - + sourceState(p)%p(s)%previousDotState(1:sizeDotState,c) & - * (1.0_pReal - stateDamper)) * crystallite_subdt(g,i,e) + sizeDotState = sourceState(p)%p(s)%sizeDotState + sourceStateResiduum(1:sizeDotState,s) = sourceState(p)%p(s)%state (1:sizeDotState,c) & + - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & + - ( sourceState(p)%p(s)%dotState (:,c) * stateDamper & + + sourceState(p)%p(s)%previousDotState(:,c) * (1.0_pReal - stateDamper) & + ) * crystallite_subdt(g,i,e) ! --- correct state with residuum --- sourceState(p)%p(s)%state(1:sizeDotState,c) = & @@ -1674,10 +1667,7 @@ subroutine integrateStateFPI() sourceState(p)%p(s)%dotState(:,c) * stateDamper & + sourceState(p)%p(s)%previousDotState(:,c) & * (1.0_pReal - stateDamper) - enddo - do s = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState converged = converged .and. & all( abs(sourceStateResiduum(1:sizeDotState,s)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState) & @@ -1921,7 +1911,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & abs(sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState)) enddo - if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definitionem + if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition endif enddo; enddo; enddo !$OMP END PARALLEL DO From 73f39136c48b5b33f7f515b545dd36ac54c26d32 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 22:19:38 +0100 Subject: [PATCH 076/107] taking over from old branch --- src/crystallite.f90 | 37 ++++++++++++++----------------------- 1 file changed, 14 insertions(+), 23 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 74eef259e..b720c4101 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1551,7 +1551,6 @@ subroutine integrateStateFPI() homogenization_Ngrains use constitutive, only: & constitutive_collectDotState, & - constitutive_microstructure, & constitutive_plasticity_maxSizeDotState, & constitutive_source_maxSizeDotState @@ -1569,9 +1568,9 @@ subroutine integrateStateFPI() real(pReal) :: & stateDamper real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & - plasticStateResiduum + residuum_plastic ! residuum for plastic state real(pReal), dimension(constitutive_source_maxSizeDotState, maxval(phase_Nsources)) :: & - sourceStateResiduum + residuum_source ! residuum for source state logical :: & converged, & doneWithIntegration @@ -1616,7 +1615,7 @@ subroutine integrateStateFPI() !$OMP PARALLEL !$OMP DO PRIVATE(sizeDotState, & - !$OMP& plasticStateResiduum,sourceStateResiduum, & + !$OMP& residuum_plastic,residuum_source, & !$OMP& stateDamper, converged,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) @@ -1629,21 +1628,20 @@ subroutine integrateStateFPI() plasticState(p)%previousDotState2(:,c)) sizeDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:sizeDotState) = plasticState(p)%state (1:sizeDotState,c) & + residuum_plastic(1:SizeDotState) = plasticState(p)%state (1:sizeDotState,c) & - plasticState(p)%subState0(1:sizeDotState,c) & - ( plasticState(p)%dotState (:,c) * stateDamper & + plasticState(p)%previousDotState(:,c) * (1.0_pReal-stateDamper) & ) * crystallite_subdt(g,i,e) plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%state(1:sizeDotState,c) & - - plasticStateResiduum(1:sizeDotState) - + - residuum_plastic(1:sizeDotState) plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & + plasticState(p)%previousDotState(:,c) * (1.0_pReal - stateDamper) - converged = all( abs(plasticStateResiduum(1:sizeDotState)) < & + converged = all( abs(residuum_plastic(1:sizeDotState)) < & plasticState(p)%aTolState(1:sizeDotState) & - .or. abs(plasticStateResiduum(1:sizeDotState)) < & + .or. abs(residuum_plastic(1:sizeDotState)) < & rTol_crystalliteState * abs( plasticState(p)%state(1:sizeDotState,c))) @@ -1652,26 +1650,21 @@ subroutine integrateStateFPI() sourceState(p)%p(s)%previousDotState (:,c), & sourceState(p)%p(s)%previousDotState2(:,c)) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s) = sourceState(p)%p(s)%state (1:sizeDotState,c) & + residuum_source(1:sizeDotState,s) = sourceState(p)%p(s)%state (1:sizeDotState,c) & - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - ( sourceState(p)%p(s)%dotState (:,c) * stateDamper & + sourceState(p)%p(s)%previousDotState(:,c) * (1.0_pReal - stateDamper) & ) * crystallite_subdt(g,i,e) - ! --- correct state with residuum --- - sourceState(p)%p(s)%state(1:sizeDotState,c) = & - sourceState(p)%p(s)%state(1:sizeDotState,c) & - - sourceStateResiduum(1:sizeDotState,s) ! need to copy to local variable, since we cant flush a pointer in openmp - - sourceState(p)%p(s)%dotState(:,c) = & - sourceState(p)%p(s)%dotState(:,c) * stateDamper & - + sourceState(p)%p(s)%previousDotState(:,c) & - * (1.0_pReal - stateDamper) + sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%state(1:sizeDotState,c) & + - residuum_source(1:sizeDotState,s) + sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) * stateDamper & + + sourceState(p)%p(s)%previousDotState(:,c)* (1.0_pReal - stateDamper) converged = converged .and. & - all( abs(sourceStateResiduum(1:sizeDotState,s)) < & + all( abs(residuum_source(1:sizeDotState,s)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState) & - .or. abs(sourceStateResiduum(1:sizeDotState,s)) < & + .or. abs(residuum_source(1:sizeDotState,s)) < & rTol_crystalliteState * abs(sourceState(p)%p(s)%state(1:sizeDotState,c))) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition @@ -1771,8 +1764,6 @@ end subroutine integrateStateEuler !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- subroutine integrateStateAdaptiveEuler() - use, intrinsic :: & - IEEE_arithmetic use numerics, only: & rTol_crystalliteState use mesh, only: & From b4afc303be3b2cdbd98bbc629d413cd96f3c17c3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 22:29:36 +0100 Subject: [PATCH 077/107] clearer logic --- src/crystallite.f90 | 96 ++++++++++++++++++++++----------------------- 1 file changed, 46 insertions(+), 50 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b720c4101..be14f801a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1566,13 +1566,12 @@ subroutine integrateStateFPI() s, & sizeDotState real(pReal) :: & - stateDamper + zeta real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & residuum_plastic ! residuum for plastic state - real(pReal), dimension(constitutive_source_maxSizeDotState, maxval(phase_Nsources)) :: & + real(pReal), dimension(constitutive_source_maxSizeDotState) :: & residuum_source ! residuum for source state logical :: & - converged, & doneWithIntegration ! --+>> PREGUESS FOR STATE <<+-- @@ -1614,65 +1613,59 @@ subroutine integrateStateFPI() call update_dotState(1.0_pReal) !$OMP PARALLEL - !$OMP DO PRIVATE(sizeDotState, & - !$OMP& residuum_plastic,residuum_source, & - !$OMP& stateDamper, converged,p,c) + !$OMP DO PRIVATE(sizeDotState,residuum_plastic,residuum_source,zeta,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - StateDamper = damper(plasticState(p)%dotState (:,c), & - plasticState(p)%previousDotState (:,c), & - plasticState(p)%previousDotState2(:,c)) + zeta = damper(plasticState(p)%dotState (:,c), & + plasticState(p)%previousDotState (:,c), & + plasticState(p)%previousDotState2(:,c)) sizeDotState = plasticState(p)%sizeDotState residuum_plastic(1:SizeDotState) = plasticState(p)%state (1:sizeDotState,c) & - plasticState(p)%subState0(1:sizeDotState,c) & - - ( plasticState(p)%dotState (:,c) * stateDamper & - + plasticState(p)%previousDotState(:,c) * (1.0_pReal-stateDamper) & + - ( plasticState(p)%dotState (:,c) * zeta & + + plasticState(p)%previousDotState(:,c) * (1.0_pReal-zeta) & ) * crystallite_subdt(g,i,e) plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%state(1:sizeDotState,c) & - residuum_plastic(1:sizeDotState) - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * stateDamper & - + plasticState(p)%previousDotState(:,c) * (1.0_pReal - stateDamper) - - converged = all( abs(residuum_plastic(1:sizeDotState)) < & - plasticState(p)%aTolState(1:sizeDotState) & - .or. abs(residuum_plastic(1:sizeDotState)) < & - rTol_crystalliteState * abs( plasticState(p)%state(1:sizeDotState,c))) + plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * zeta & + + plasticState(p)%previousDotState(:,c) * (1.0_pReal - zeta) + + crystallite_converged(g,i,e) = all(abs(residuum_plastic(1:sizeDotState)) & + < min(plasticState(p)%aTolState(1:sizeDotState), & + abs(plasticState(p)%state(1:sizeDotState,c)*rTol_crystalliteState))) do s = 1_pInt, phase_Nsources(p) - stateDamper = damper(sourceState(p)%p(s)%dotState (:,c), & - sourceState(p)%p(s)%previousDotState (:,c), & - sourceState(p)%p(s)%previousDotState2(:,c)) + zeta = damper(sourceState(p)%p(s)%dotState (:,c), & + sourceState(p)%p(s)%previousDotState (:,c), & + sourceState(p)%p(s)%previousDotState2(:,c)) sizeDotState = sourceState(p)%p(s)%sizeDotState - residuum_source(1:sizeDotState,s) = sourceState(p)%p(s)%state (1:sizeDotState,c) & - - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - - ( sourceState(p)%p(s)%dotState (:,c) * stateDamper & - + sourceState(p)%p(s)%previousDotState(:,c) * (1.0_pReal - stateDamper) & - ) * crystallite_subdt(g,i,e) + + residuum_source(1:sizeDotState) = sourceState(p)%p(s)%state (1:sizeDotState,c) & + - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & + - ( sourceState(p)%p(s)%dotState (:,c) * zeta & + + sourceState(p)%p(s)%previousDotState(:,c) * (1.0_pReal - zeta) & + ) * crystallite_subdt(g,i,e) - sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%state(1:sizeDotState,c) & - - residuum_source(1:sizeDotState,s) - sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) * stateDamper & - + sourceState(p)%p(s)%previousDotState(:,c)* (1.0_pReal - stateDamper) + sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%state(1:sizeDotState,c) & + - residuum_source(1:sizeDotState) + sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) * zeta & + + sourceState(p)%p(s)%previousDotState(:,c)* (1.0_pReal - zeta) - converged = converged .and. & - all( abs(residuum_source(1:sizeDotState,s)) < & - sourceState(p)%p(s)%aTolState(1:sizeDotState) & - .or. abs(residuum_source(1:sizeDotState,s)) < & - rTol_crystalliteState * abs(sourceState(p)%p(s)%state(1:sizeDotState,c))) - enddo - if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition - - endif - enddo; enddo; enddo + crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & + all(abs(residuum_source(1:sizeDotState)) & + < min(sourceState(p)%p(s)%aTolState(1:sizeDotState), & + abs(sourceState(p)%p(s)%state(1:sizeDotState,c)*rTol_crystalliteState))) + enddo + endif + enddo; enddo; enddo !$OMP ENDDO - ! --- STATE JUMP --- !$OMP DO do e = FEsolving_execElem(1),FEsolving_execElem(2) @@ -1870,6 +1863,17 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & plasticStateResiduum(1:mySizePlasticDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state + + converged = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + rTol_crystalliteState .or. & + abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + plasticState(p)%aTolState(1:mySizePlasticDotState)) + + forall (s = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & + relPlasticStateResiduum(s,g,i,e) = & + plasticStateResiduum(s,g,i,e) / plasticState(p)%dotState(s,c) + + do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) = & @@ -1878,10 +1882,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state enddo - ! --- relative residui --- - forall (s = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & - relPlasticStateResiduum(s,g,i,e) = & - plasticStateResiduum(s,g,i,e) / plasticState(p)%dotState(s,c) + do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState forall (s = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(mySource)%dotState(s,c)) > 0.0_pReal) & @@ -1889,11 +1890,6 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & sourceStateResiduum(s,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(s,c) enddo - ! --- converged ? --- - converged = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState)) do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState converged = converged .and. & From 0be05b3ee1c4a894b2e442ff3156945bb3a5efe5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 22:46:21 +0100 Subject: [PATCH 078/107] one variable is enough --- src/crystallite.f90 | 63 ++++++++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 32 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index be14f801a..100bd1aa4 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1785,8 +1785,7 @@ subroutine integrateStateAdaptiveEuler() p, & c, & mySource, & - mySizePlasticDotState, & ! size of dot states - mySizeSourceDotState + sizeDotState real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & plasticStateResiduum, & ! residuum from evolution in micrstructure @@ -1810,31 +1809,31 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & ! contribution to state and relative residui and from Euler integration call update_dotState(1.0_pReal) - !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c) + !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - mySizePlasticDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & + sizeDotState = plasticState(p)%sizeDotState + plasticStateResiduum(1:sizeDotState,g,i,e) = & - 0.5_pReal & - * plasticState(p)%dotstate(1:mySizePlasticDotState,c) & + * plasticState(p)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - plasticState(p)%state (1:mySizePlasticDotState,c) = & - plasticState(p)%state (1:mySizePlasticDotState,c) & - + plasticState(p)%dotstate(1:mySizePlasticDotState,c) & + plasticState(p)%state (1:sizeDotState,c) = & + plasticState(p)%state (1:sizeDotState,c) & + + plasticState(p)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) = & + sizeDotState = sourceState(p)%p(mySource)%sizeDotState + sourceStateResiduum(1:sizeDotState,mySource,g,i,e) = & - 0.5_pReal & - * sourceState(p)%p(mySource)%dotstate(1:mySizeSourceDotState,c) & + * sourceState(p)%p(mySource)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - sourceState(p)%p(mySource)%state (1:mySizeSourceDotState,c) = & - sourceState(p)%p(mySource)%state (1:mySizeSourceDotState,c) & - + sourceState(p)%p(mySource)%dotstate(1:mySizeSourceDotState,c) & + sourceState(p)%p(mySource)%state (1:sizeDotState,c) = & + sourceState(p)%p(mySource)%state (1:sizeDotState,c) & + + sourceState(p)%p(mySource)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) enddo endif @@ -1850,7 +1849,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & relSourceStateResiduum = 0.0_pReal - !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,converged,p,c,s) + !$OMP PARALLEL DO PRIVATE(sizeDotState,converged,p,c,s) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -1858,45 +1857,45 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & p = phaseAt(g,i,e); c = phasememberAt(g,i,e) ! --- contribution of heun step to absolute residui --- - mySizePlasticDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & - plasticStateResiduum(1:mySizePlasticDotState,g,i,e) & + sizeDotState = plasticState(p)%sizeDotState + plasticStateResiduum(1:sizeDotState,g,i,e) = & + plasticStateResiduum(1:sizeDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - converged = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + converged = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState)) + abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & + plasticState(p)%aTolState(1:sizeDotState)) - forall (s = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & + forall (s = 1_pInt:sizeDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & relPlasticStateResiduum(s,g,i,e) = & plasticStateResiduum(s,g,i,e) / plasticState(p)%dotState(s,c) do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) = & - sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) & + sizeDotState = sourceState(p)%p(mySource)%sizeDotState + sourceStateResiduum(1:sizeDotState,mySource,g,i,e) = & + sourceStateResiduum(1:sizeDotState,mySource,g,i,e) & + 0.5_pReal * sourceState(p)%p(mySource)%dotState(:,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state enddo do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - forall (s = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(mySource)%dotState(s,c)) > 0.0_pReal) & + sizeDotState = sourceState(p)%p(mySource)%sizeDotState + forall (s = 1_pInt:sizeDotState,abs(sourceState(p)%p(mySource)%dotState(s,c)) > 0.0_pReal) & relSourceStateResiduum(s,mySource,g,i,e) = & sourceStateResiduum(s,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(s,c) enddo do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState + sizeDotState = sourceState(p)%p(mySource)%sizeDotState converged = converged .and. & - all(abs(relSourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & + all(abs(relSourceStateResiduum(1:sizeDotState,mySource,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & - sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState)) + abs(sourceStateResiduum(1:sizeDotState,mySource,g,i,e)) < & + sourceState(p)%p(mySource)%aTolState(1:sizeDotState)) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition endif From 1408d66c0caec280768039732cb09ad53b579475 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 23:02:59 +0100 Subject: [PATCH 079/107] s is used for source --- src/crystallite.f90 | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 100bd1aa4..b416573de 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1781,7 +1781,7 @@ subroutine integrateStateAdaptiveEuler() e, & ! element index in element loop i, & ! integration point index in ip loop g, & ! grain index in grain loop - s, & ! state index + u, & ! state index p, & c, & mySource, & @@ -1849,7 +1849,7 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & relSourceStateResiduum = 0.0_pReal - !$OMP PARALLEL DO PRIVATE(sizeDotState,converged,p,c,s) + !$OMP PARALLEL DO PRIVATE(sizeDotState,converged,p,c,u) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -1868,9 +1868,9 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & plasticState(p)%aTolState(1:sizeDotState)) - forall (s = 1_pInt:sizeDotState, abs(plasticState(p)%dotState(s,c)) > 0.0_pReal) & - relPlasticStateResiduum(s,g,i,e) = & - plasticStateResiduum(s,g,i,e) / plasticState(p)%dotState(s,c) + forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%dotState(u,c)) > 0.0_pReal) & + relPlasticStateResiduum(u,g,i,e) = & + plasticStateResiduum(u,g,i,e) / plasticState(p)%dotState(u,c) do mySource = 1_pInt, phase_Nsources(p) @@ -1879,17 +1879,11 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & sourceStateResiduum(1:sizeDotState,mySource,g,i,e) & + 0.5_pReal * sourceState(p)%p(mySource)%dotState(:,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - enddo + forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(mySource)%dotState(u,c)) > 0.0_pReal) & + relSourceStateResiduum(u,mySource,g,i,e) = & + sourceStateResiduum(u,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(u,c) - do mySource = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(mySource)%sizeDotState - forall (s = 1_pInt:sizeDotState,abs(sourceState(p)%p(mySource)%dotState(s,c)) > 0.0_pReal) & - relSourceStateResiduum(s,mySource,g,i,e) = & - sourceStateResiduum(s,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(s,c) - enddo - - do mySource = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(mySource)%sizeDotState converged = converged .and. & all(abs(relSourceStateResiduum(1:sizeDotState,mySource,g,i,e)) < & From eade54a68f49c31e274577292970271efef2d915 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 23:04:50 +0100 Subject: [PATCH 080/107] consistent variable names --- src/crystallite.f90 | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b416573de..054bb9d22 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1784,7 +1784,7 @@ subroutine integrateStateAdaptiveEuler() u, & ! state index p, & c, & - mySource, & + s, & sizeDotState real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & @@ -1825,15 +1825,15 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & plasticState(p)%state (1:sizeDotState,c) & + plasticState(p)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) - do mySource = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(mySource)%sizeDotState - sourceStateResiduum(1:sizeDotState,mySource,g,i,e) = & + do s = 1_pInt, phase_Nsources(p) + sizeDotState = sourceState(p)%p(s)%sizeDotState + sourceStateResiduum(1:sizeDotState,s,g,i,e) = & - 0.5_pReal & - * sourceState(p)%p(mySource)%dotstate(1:sizeDotState,c) & + * sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - sourceState(p)%p(mySource)%state (1:sizeDotState,c) = & - sourceState(p)%p(mySource)%state (1:sizeDotState,c) & - + sourceState(p)%p(mySource)%dotstate(1:sizeDotState,c) & + sourceState(p)%p(s)%state (1:sizeDotState,c) = & + sourceState(p)%p(s)%state (1:sizeDotState,c) & + + sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & * crystallite_subdt(g,i,e) enddo endif @@ -1873,23 +1873,23 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & plasticStateResiduum(u,g,i,e) / plasticState(p)%dotState(u,c) - do mySource = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(mySource)%sizeDotState - sourceStateResiduum(1:sizeDotState,mySource,g,i,e) = & - sourceStateResiduum(1:sizeDotState,mySource,g,i,e) & - + 0.5_pReal * sourceState(p)%p(mySource)%dotState(:,c) & + do s = 1_pInt, phase_Nsources(p) + sizeDotState = sourceState(p)%p(s)%sizeDotState + sourceStateResiduum(1:sizeDotState,s,g,i,e) = & + sourceStateResiduum(1:sizeDotState,s,g,i,e) & + + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) & * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(mySource)%dotState(u,c)) > 0.0_pReal) & - relSourceStateResiduum(u,mySource,g,i,e) = & - sourceStateResiduum(u,mySource,g,i,e) / sourceState(p)%p(mySource)%dotState(u,c) + forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%dotState(u,c)) > 0.0_pReal) & + relSourceStateResiduum(u,s,g,i,e) = & + sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%dotState(u,c) - sizeDotState = sourceState(p)%p(mySource)%sizeDotState + sizeDotState = sourceState(p)%p(s)%sizeDotState converged = converged .and. & - all(abs(relSourceStateResiduum(1:sizeDotState,mySource,g,i,e)) < & + all(abs(relSourceStateResiduum(1:sizeDotState,s,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:sizeDotState,mySource,g,i,e)) < & - sourceState(p)%p(mySource)%aTolState(1:sizeDotState)) + abs(sourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition endif From bdd193fbd73eb9a1e2214684b90d4425edd94519 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 23:31:26 +0100 Subject: [PATCH 081/107] now readable (kind of) --- src/crystallite.f90 | 105 ++++++++++++++++++-------------------------- 1 file changed, 43 insertions(+), 62 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 054bb9d22..2e68ae756 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1619,12 +1619,12 @@ subroutine integrateStateFPI() do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + sizeDotState = plasticState(p)%sizeDotState zeta = damper(plasticState(p)%dotState (:,c), & plasticState(p)%previousDotState (:,c), & plasticState(p)%previousDotState2(:,c)) - sizeDotState = plasticState(p)%sizeDotState - + residuum_plastic(1:SizeDotState) = plasticState(p)%state (1:sizeDotState,c) & - plasticState(p)%subState0(1:sizeDotState,c) & - ( plasticState(p)%dotState (:,c) * zeta & @@ -1642,11 +1642,12 @@ subroutine integrateStateFPI() do s = 1_pInt, phase_Nsources(p) + sizeDotState = sourceState(p)%p(s)%sizeDotState + zeta = damper(sourceState(p)%p(s)%dotState (:,c), & sourceState(p)%p(s)%previousDotState (:,c), & sourceState(p)%p(s)%previousDotState2(:,c)) - sizeDotState = sourceState(p)%p(s)%sizeDotState - + residuum_source(1:sizeDotState) = sourceState(p)%p(s)%state (1:sizeDotState,c) & - sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - ( sourceState(p)%p(s)%dotState (:,c) * zeta & @@ -1771,8 +1772,6 @@ subroutine integrateStateAdaptiveEuler() phase_Nsources, & homogenization_maxNgrains use constitutive, only: & - constitutive_collectDotState, & - constitutive_microstructure, & constitutive_plasticity_maxSizeDotState, & constitutive_source_maxSizeDotState @@ -1786,6 +1785,8 @@ subroutine integrateStateAdaptiveEuler() c, & s, & sizeDotState + + ! ToDo: MD: once all constitutives use allocate state, attach these arrays to the state in case of adaptive Euler real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & plasticStateResiduum, & ! residuum from evolution in micrstructure @@ -1796,45 +1797,29 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & sourceStateResiduum, & ! residuum from evolution in micrstructure relSourceStateResiduum ! relative residuum from evolution in microstructure - logical :: & - converged - - - plasticStateResiduum = 0.0_pReal - relPlasticStateResiduum = 0.0_pReal - sourceStateResiduum = 0.0_pReal - relSourceStateResiduum = 0.0_pReal - !-------------------------------------------------------------------------------------------------- ! contribution to state and relative residui and from Euler integration call update_dotState(1.0_pReal) !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:sizeDotState,g,i,e) = & - - 0.5_pReal & - * plasticState(p)%dotstate(1:sizeDotState,c) & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - plasticState(p)%state (1:sizeDotState,c) = & - plasticState(p)%state (1:sizeDotState,c) & - + plasticState(p)%dotstate(1:sizeDotState,c) & - * crystallite_subdt(g,i,e) + + plasticStateResiduum(1:sizeDotState,g,i,e) = plasticState(p)%dotstate(1:sizeDotState,c) & + * (- 0.5_pReal * crystallite_subdt(g,i,e)) + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%state(1:sizeDotState,c) & + + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) !ToDo: state, partitioned state? do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s,g,i,e) = & - - 0.5_pReal & - * sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - sourceState(p)%p(s)%state (1:sizeDotState,c) = & - sourceState(p)%p(s)%state (1:sizeDotState,c) & - + sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & - * crystallite_subdt(g,i,e) + + sourceStateResiduum(1:sizeDotState,s,g,i,e) = sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & + * (- 0.5_pReal * crystallite_subdt(g,i,e)) + sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%state(1:sizeDotState,c) & + + sourceState(p)%p(s)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) !ToDo: state, partitioned state? enddo endif enddo; enddo; enddo @@ -1845,55 +1830,51 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & call update_stress(1.0_pReal) call update_dotState(1.0_pReal) - relPlasticStateResiduum = 0.0_pReal - relSourceStateResiduum = 0.0_pReal + relPlasticStateResiduum = 0.0_pReal + relSourceStateResiduum = 0.0_pReal - !$OMP PARALLEL DO PRIVATE(sizeDotState,converged,p,c,u) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) + !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c,u) + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + sizeDotState = plasticState(p)%sizeDotState ! --- contribution of heun step to absolute residui --- - sizeDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:sizeDotState,g,i,e) = & - plasticStateResiduum(1:sizeDotState,g,i,e) & - + 0.5_pReal * plasticState(p)%dotState(:,c) & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state + + plasticStateResiduum(1:sizeDotState,g,i,e) = plasticStateResiduum(1:sizeDotState,g,i,e) & + + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - converged = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & + crystallite_converged(g,i,e) = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & rTol_crystalliteState .or. & abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & plasticState(p)%aTolState(1:sizeDotState)) forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%dotState(u,c)) > 0.0_pReal) & - relPlasticStateResiduum(u,g,i,e) = & - plasticStateResiduum(u,g,i,e) / plasticState(p)%dotState(u,c) + relPlasticStateResiduum(u,g,i,e) = plasticStateResiduum(u,g,i,e) & + / plasticState(p)%dotState(u,c) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s,g,i,e) = & - sourceStateResiduum(1:sizeDotState,s,g,i,e) & - + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) & - * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state - + + sourceStateResiduum(1:sizeDotState,s,g,i,e) = sourceStateResiduum(1:sizeDotState,s,g,i,e) & + + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) + forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%dotState(u,c)) > 0.0_pReal) & - relSourceStateResiduum(u,s,g,i,e) = & - sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%dotState(u,c) + relSourceStateResiduum(u,s,g,i,e) = sourceStateResiduum(u,s,g,i,e) & + / sourceState(p)%p(s)%dotState(u,c) - sizeDotState = sourceState(p)%p(s)%sizeDotState - converged = converged .and. & + crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & all(abs(relSourceStateResiduum(1:sizeDotState,s,g,i,e)) < & rTol_crystalliteState .or. & abs(sourceStateResiduum(1:sizeDotState,s,g,i,e)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo - if (converged) crystallite_converged(g,i,e) = .true. ! ... converged per definition endif - enddo; enddo; enddo + enddo; enddo; enddo !$OMP END PARALLEL DO if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck From 6a3dac1df2ba3fe6fd0cd1bb457cdcc3b175ee72 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Jan 2019 23:45:41 +0100 Subject: [PATCH 082/107] still improving readability --- src/crystallite.f90 | 72 ++++++++++++++++++++++++--------------------- 1 file changed, 38 insertions(+), 34 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 2e68ae756..7fb3aefe6 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1758,6 +1758,8 @@ end subroutine integrateStateEuler !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- subroutine integrateStateAdaptiveEuler() + use prec, only: & + dNeq0 use numerics, only: & rTol_crystalliteState use mesh, only: & @@ -1780,22 +1782,23 @@ subroutine integrateStateAdaptiveEuler() e, & ! element index in element loop i, & ! integration point index in ip loop g, & ! grain index in grain loop - u, & ! state index p, & c, & s, & sizeDotState - ! ToDo: MD: once all constitutives use allocate state, attach these arrays to the state in case of adaptive Euler + ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler + ! ToDo: MD: rel residuu don't have to be pointwise + real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - plasticStateResiduum, & ! residuum from evolution in micrstructure - relPlasticStateResiduum ! relative residuum from evolution in microstructure + residuum_plastic, & + residuum_plastic_rel real(pReal), dimension(constitutive_source_maxSizeDotState,& maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - sourceStateResiduum, & ! residuum from evolution in micrstructure - relSourceStateResiduum ! relative residuum from evolution in microstructure + residuum_source_rel, & + residuum_source !-------------------------------------------------------------------------------------------------- ! contribution to state and relative residui and from Euler integration @@ -1809,15 +1812,15 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & p = phaseAt(g,i,e); c = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState - plasticStateResiduum(1:sizeDotState,g,i,e) = plasticState(p)%dotstate(1:sizeDotState,c) & - * (- 0.5_pReal * crystallite_subdt(g,i,e)) + residuum_plastic(1:sizeDotState,g,i,e) = plasticState(p)%dotstate(1:sizeDotState,c) & + * (- 0.5_pReal * crystallite_subdt(g,i,e)) plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%state(1:sizeDotState,c) & + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) !ToDo: state, partitioned state? do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s,g,i,e) = sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & - * (- 0.5_pReal * crystallite_subdt(g,i,e)) + residuum_source(1:sizeDotState,s,g,i,e) = sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & + * (- 0.5_pReal * crystallite_subdt(g,i,e)) sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%state(1:sizeDotState,c) & + sourceState(p)%p(s)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) !ToDo: state, partitioned state? enddo @@ -1829,12 +1832,8 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & call update_dependentState call update_stress(1.0_pReal) call update_dotState(1.0_pReal) - - relPlasticStateResiduum = 0.0_pReal - relSourceStateResiduum = 0.0_pReal - - !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c,u) + !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -1844,33 +1843,38 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & ! --- contribution of heun step to absolute residui --- - plasticStateResiduum(1:sizeDotState,g,i,e) = plasticStateResiduum(1:sizeDotState,g,i,e) & - + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - - crystallite_converged(g,i,e) = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & - rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & - plasticState(p)%aTolState(1:sizeDotState)) - - forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%dotState(u,c)) > 0.0_pReal) & - relPlasticStateResiduum(u,g,i,e) = plasticStateResiduum(u,g,i,e) & - / plasticState(p)%dotState(u,c) + residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - + where(dNeq0(plasticState(p)%dotState(1:sizeDotState,c))) + residuum_plastic_rel(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + / plasticState(p)%dotState(1:sizeDotState,c) + else where + residuum_plastic_rel(1:sizeDotState,g,i,e) = 0.0_pReal + end where + + crystallite_converged(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState,g,i,e)) < & + rTol_crystalliteState .or. & + abs(residuum_plastic(1:sizeDotState,g,i,e)) < & + plasticState(p)%aTolState(1:sizeDotState)) + do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceStateResiduum(1:sizeDotState,s,g,i,e) = sourceStateResiduum(1:sizeDotState,s,g,i,e) & - + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) + residuum_source(1:sizeDotState,s,g,i,e) = residuum_source(1:sizeDotState,s,g,i,e) & + + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) - forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%dotState(u,c)) > 0.0_pReal) & - relSourceStateResiduum(u,s,g,i,e) = sourceStateResiduum(u,s,g,i,e) & - / sourceState(p)%p(s)%dotState(u,c) + where(dNeq0(sourceState(p)%p(s)%dotState(1:sizeDotState,c))) + residuum_source_rel(1:sizeDotState,s,g,i,e) = residuum_source(1:sizeDotState,s,g,i,e) & + / sourceState(p)%p(s)%dotState(1:sizeDotState,c) + else where + residuum_source_rel(1:SizeDotState,s,g,i,e) = 0.0_pReal + end where crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & - all(abs(relSourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + all(abs(residuum_source_rel(1:sizeDotState,s,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + abs(residuum_source(1:sizeDotState,s,g,i,e)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif From 1a66f976b7e5d7f2edf6493562e92e10ea8f10d1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 00:01:40 +0100 Subject: [PATCH 083/107] common variable name --- src/crystallite.f90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 7fb3aefe6..b47f3334f 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1919,7 +1919,7 @@ subroutine integrateStateRK4() p, & ! phase loop c, & n, & - mySource + s integer(pInt), dimension(2) :: eIter ! bounds for element iteration integer(pInt), dimension(2,mesh_NcpElems) :: iIter, & ! bounds for ip iteration gIter ! bounds for grain iteration @@ -1938,8 +1938,8 @@ subroutine integrateStateRK4() if (.not. singleRun) then do p = 1_pInt, material_Nphase plasticState(p)%RK4dotState = 0.0_pReal - do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%RK4dotState = 0.0_pReal + do s = 1_pInt, phase_Nsources(p) + sourceState(p)%p(s)%RK4dotState = 0.0_pReal enddo enddo else @@ -1947,8 +1947,8 @@ subroutine integrateStateRK4() i = iIter(1,e) do g = gIter(1,e), gIter(2,e) plasticState(phaseAt(g,i,e))%RK4dotState(:,phasememberAt(g,i,e)) = 0.0_pReal - do mySource = 1_pInt, phase_Nsources(phaseAt(g,i,e)) - sourceState(phaseAt(g,i,e))%p(mySource)%RK4dotState(:,phasememberAt(g,i,e)) = 0.0_pReal + do s = 1_pInt, phase_Nsources(phaseAt(g,i,e)) + sourceState(phaseAt(g,i,e))%p(s)%RK4dotState(:,phasememberAt(g,i,e)) = 0.0_pReal enddo enddo endif @@ -1967,13 +1967,13 @@ subroutine integrateStateRK4() do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - c = phasememberAt(g,i,e) + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + plasticState(p)%RK4dotState(:,c) = plasticState(p)%RK4dotState(:,c) & + weight(n)*plasticState(p)%dotState(:,c) - do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%RK4dotState(:,c) = sourceState(p)%p(mySource)%RK4dotState(:,c) & - + weight(n)*sourceState(p)%p(mySource)%dotState(:,c) + do s = 1_pInt, phase_Nsources(p) + sourceState(p)%p(s)%RK4dotState(:,c) = sourceState(p)%p(s)%RK4dotState(:,c) & + + weight(n)*sourceState(p)%p(s)%dotState(:,c) enddo endif enddo; enddo; enddo From a09036ff4824531e4faebf787752bca6b60fdfbb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 00:11:10 +0100 Subject: [PATCH 084/107] on-the-fly initialization --- src/crystallite.f90 | 79 ++++++++++----------------------------------- 1 file changed, 17 insertions(+), 62 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b47f3334f..7767eb6f3 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1893,19 +1893,13 @@ subroutine integrateStateRK4() use, intrinsic :: & IEEE_arithmetic use mesh, only: & - mesh_element, & - mesh_NcpElems + mesh_element use material, only: & homogenization_Ngrains, & plasticState, & sourceState, & phase_Nsources, & phaseAt, phasememberAt - use config, only: & - material_Nphase - use constitutive, only: & - constitutive_collectDotState, & - constitutive_microstructure implicit none real(pReal), dimension(4), parameter :: & @@ -1920,65 +1914,28 @@ subroutine integrateStateRK4() c, & n, & s - integer(pInt), dimension(2) :: eIter ! bounds for element iteration - integer(pInt), dimension(2,mesh_NcpElems) :: iIter, & ! bounds for ip iteration - gIter ! bounds for grain iteration - logical :: singleRun ! flag indicating computation for single (g,i,e) triple - - eIter = FEsolving_execElem(1:2) - do e = eIter(1),eIter(2) - iIter(1:2,e) = FEsolving_execIP(1:2,e) - gIter(1:2,e) = [ 1_pInt,homogenization_Ngrains(mesh_element(3,e))] - enddo - - singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) - -!-------------------------------------------------------------------------------------------------- -! initialize dotState - if (.not. singleRun) then - do p = 1_pInt, material_Nphase - plasticState(p)%RK4dotState = 0.0_pReal - do s = 1_pInt, phase_Nsources(p) - sourceState(p)%p(s)%RK4dotState = 0.0_pReal - enddo - enddo - else - e = eIter(1) - i = iIter(1,e) - do g = gIter(1,e), gIter(2,e) - plasticState(phaseAt(g,i,e))%RK4dotState(:,phasememberAt(g,i,e)) = 0.0_pReal - do s = 1_pInt, phase_Nsources(phaseAt(g,i,e)) - sourceState(phaseAt(g,i,e))%p(s)%RK4dotState(:,phasememberAt(g,i,e)) = 0.0_pReal - enddo - enddo - endif call update_dotState(1.0_pReal) -!-------------------------------------------------------------------------------------------------- -! --- SECOND TO FOURTH RUNGE KUTTA STEP PLUS FINAL INTEGRATION --- do n = 1_pInt,4_pInt - ! --- state update --- - !$OMP PARALLEL - !$OMP DO PRIVATE(p,c) + !$OMP PARALLEL DO PRIVATE(p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) - plasticState(p)%RK4dotState(:,c) = plasticState(p)%RK4dotState(:,c) & - + weight(n)*plasticState(p)%dotState(:,c) + plasticState(p)%RK4dotState(:,c) = WEIGHT(n)*plasticState(p)%dotState(:,c) & + + merge(plasticState(p)%RK4dotState(:,c),0.0_pReal,n>1_pInt) do s = 1_pInt, phase_Nsources(p) - sourceState(p)%p(s)%RK4dotState(:,c) = sourceState(p)%p(s)%RK4dotState(:,c) & - + weight(n)*sourceState(p)%p(s)%dotState(:,c) + sourceState(p)%p(s)%RK4dotState(:,c) = WEIGHT(n)*sourceState(p)%p(s)%dotState(:,c) & + + merge(sourceState(p)%p(s)%RK4dotState(:,c),0.0_pReal,n>1_pInt) enddo endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO call update_state(TIMESTEPFRACTION(n)) call update_deltaState @@ -1988,9 +1945,8 @@ subroutine integrateStateRK4() ! --- dot state and RK dot state--- first3steps: if (n < 4) then - call update_dotState(timeStepFraction(n)) + call update_dotState(TIMESTEPFRACTION(n)) endif first3steps - enddo @@ -2458,9 +2414,8 @@ subroutine update_deltaState i, & !< integration point index in ip loop g, & !< grain index in grain loop p, & - mySize, & + mySize, & myOffset, & - mySource, & c, & s logical :: & @@ -2469,7 +2424,7 @@ subroutine update_deltaState nonlocalStop = .false. - !$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize,mySource,NaN) + !$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize,NaN) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -2489,15 +2444,15 @@ subroutine update_deltaState plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) = & plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) + & plasticState(p)%deltaState(1:mySize,c) - do mySource = 1_pInt, phase_Nsources(p) - myOffset = sourceState(p)%p(mySource)%offsetDeltaState - mySize = sourceState(p)%p(mySource)%sizeDeltaState - NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(1:mySize,c))) + do s = 1_pInt, phase_Nsources(p) + myOffset = sourceState(p)%p(s)%offsetDeltaState + mySize = sourceState(p)%p(s)%sizeDeltaState + NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(s)%deltaState(1:mySize,c))) if (.not. NaN) then - sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) = & - sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) + & - sourceState(p)%p(mySource)%deltaState(1:mySize,c) + sourceState(p)%p(s)%state(myOffset + 1_pInt:myOffset +mySize,c) = & + sourceState(p)%p(s)%state(myOffset + 1_pInt:myOffset +mySize,c) + & + sourceState(p)%p(s)%deltaState(1:mySize,c) endif enddo endif From 77f1f45c231d4bcfd4dd3b6844d1cd7cbf4e1c32 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 00:17:04 +0100 Subject: [PATCH 085/107] just figured out that RK4 integrator is totally broken readable code helps ;) --- src/crystallite.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 7767eb6f3..a5f7592d6 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1888,6 +1888,7 @@ end subroutine integrateStateAdaptiveEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 4th order explicit Runge Kutta method +! ToDo: This is totally BROKEN: RK4dotState is never used!!! !-------------------------------------------------------------------------------------------------- subroutine integrateStateRK4() use, intrinsic :: & @@ -1941,7 +1942,6 @@ subroutine integrateStateRK4() call update_deltaState call update_dependentState call update_stress(TIMESTEPFRACTION(n)) - ! --- dot state and RK dot state--- first3steps: if (n < 4) then From 5908e3fd3486e1584081908ab56cfc5d1ad3a022 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 06:44:26 +0100 Subject: [PATCH 086/107] wrong tolerance selection --- src/crystallite.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index a5f7592d6..b29ede160 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1637,7 +1637,7 @@ subroutine integrateStateFPI() + plasticState(p)%previousDotState(:,c) * (1.0_pReal - zeta) crystallite_converged(g,i,e) = all(abs(residuum_plastic(1:sizeDotState)) & - < min(plasticState(p)%aTolState(1:sizeDotState), & + < max(plasticState(p)%aTolState(1:sizeDotState), & abs(plasticState(p)%state(1:sizeDotState,c)*rTol_crystalliteState))) @@ -1661,7 +1661,7 @@ subroutine integrateStateFPI() crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & all(abs(residuum_source(1:sizeDotState)) & - < min(sourceState(p)%p(s)%aTolState(1:sizeDotState), & + < max(sourceState(p)%p(s)%aTolState(1:sizeDotState), & abs(sourceState(p)%p(s)%state(1:sizeDotState,c)*rTol_crystalliteState))) enddo endif From 462b1b7c189e8370c9930736b15ffc8ed22306f9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 06:47:36 +0100 Subject: [PATCH 087/107] sorted according to importance --- src/crystallite.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b29ede160..0150d68b0 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1723,7 +1723,7 @@ subroutine integrateStateFPI() dot_prod12 = dot_product(current - previous, previous - previous2) dot_prod22 = dot_product(previous - previous2, previous - previous2) - if (dot_prod22 > 0.0_pReal .and. (dot_prod12 < 0.0_pReal .or. dot_product(current,previous) < 0.0_pReal)) then + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) else damper = 1.0_pReal From 13af9fd3da8cfea3fe525c771b43da0760219d16 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 30 Jan 2019 09:04:55 +0100 Subject: [PATCH 088/107] [skip ci] updated version information after successful test of v2.0.2-1634-g370b23d5 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 82ddb5e1a..cd40c2f04 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1614-g8764c615 +v2.0.2-1634-g370b23d5 From ca7c105f363c80d49bce0fc5b9fd9add335961cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 08:56:16 +0100 Subject: [PATCH 089/107] only one loop needed --- src/crystallite.f90 | 35 +++++++++++------------------------ 1 file changed, 11 insertions(+), 24 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0150d68b0..b0f1c1f94 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2038,46 +2038,33 @@ subroutine integrateStateRKCK45() ! --- state update --- - !$OMP PARALLEL - !$OMP DO PRIVATE(p,cc) + !$OMP PARALLEL DO PRIVATE(p,cc) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) - plasticState(p)%RKCK45dotState(stage,:,cc) = plasticState(p)%dotState(:,cc) ! store Runge-Kutta dotState + plasticState(p)%RKCK45dotState(stage,:,cc) = plasticState(p)%dotState(:,cc) + plasticState(p)%dotState(:,cc) = A(1,stage) * plasticState(p)%RKCK45dotState(1,:,cc) + do mySource = 1_pInt, phase_Nsources(p) sourceState(p)%p(mySource)%RKCK45dotState(stage,:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) - enddo - endif - enddo; enddo; enddo - !$OMP ENDDO - - !$OMP DO PRIVATE(p,cc,n) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - cc = phasememberAt(g,i,e) - - plasticState(p)%dotState(:,cc) = A(1,stage) * plasticState(p)%RKCK45dotState(1,:,cc) - do mySource = 1_pInt, phase_Nsources(p) sourceState(p)%p(mySource)%dotState(:,cc) = A(1,stage) * sourceState(p)%p(mySource)%RKCK45dotState(1,:,cc) enddo + do n = 2_pInt, stage - plasticState(p)%dotState(:,cc) = & - plasticState(p)%dotState(:,cc) + A(n,stage) * plasticState(p)%RKCK45dotState(n,:,cc) + plasticState(p)%dotState(:,cc) = plasticState(p)%dotState(:,cc) & + + A(n,stage) * plasticState(p)%RKCK45dotState(n,:,cc) do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%dotState(:,cc) = & - sourceState(p)%p(mySource)%dotState(:,cc) + A(n,stage) * sourceState(p)%p(mySource)%RKCK45dotState(n,:,cc) + sourceState(p)%p(mySource)%dotState(:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) & + + A(n,stage) * sourceState(p)%p(mySource)%RKCK45dotState(n,:,cc) enddo enddo + endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO call update_state(1.0_pReal) !MD: 1.0 correct? call update_deltaState From df6ec59f76cdfa25e69e8e80486de4d47b56787b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 09:11:12 +0100 Subject: [PATCH 090/107] use "s" for source --- src/crystallite.f90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b0f1c1f94..de535e8c2 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2008,7 +2008,7 @@ subroutine integrateStateRKCK45() i, & ! integration point index in ip loop g, & ! grain index in grain loop stage, & ! stage index in integration stage loop - s, & ! state index + u, & ! state index n, & p, & cc, & @@ -2043,8 +2043,8 @@ subroutine integrateStateRKCK45() do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - cc = phasememberAt(g,i,e) + p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) + plasticState(p)%RKCK45dotState(stage,:,cc) = plasticState(p)%dotState(:,cc) plasticState(p)%dotState(:,cc) = A(1,stage) * plasticState(p)%RKCK45dotState(1,:,cc) @@ -2134,7 +2134,7 @@ subroutine integrateStateRKCK45() !$OMP PARALLEL ! --- relative residui and state convergence --- - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc,s) + !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc,u) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -2142,15 +2142,15 @@ subroutine integrateStateRKCK45() p = phaseAt(g,i,e) cc = phasememberAt(g,i,e) mySizePlasticDotState = plasticState(p)%sizeDotState - forall (s = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%state(s,cc)) > 0.0_pReal) & - relPlasticStateResiduum(s,g,i,e) = & - plasticStateResiduum(s,g,i,e) / plasticState(p)%state(s,cc) + forall (u = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & + relPlasticStateResiduum(u,g,i,e) = & + plasticStateResiduum(u,g,i,e) / plasticState(p)%state(u,cc) do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - forall (s = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(mySource)%state(s,cc)) > 0.0_pReal) & - relSourceStateResiduum(s,mySource,g,i,e) = & - sourceStateResiduum(s,mySource,g,i,e) / sourceState(p)%p(mySource)%state(s,cc) + forall (u = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(mySource)%state(u,cc)) > 0.0_pReal) & + relSourceStateResiduum(u,mySource,g,i,e) = & + sourceStateResiduum(u,mySource,g,i,e) / sourceState(p)%p(mySource)%state(u,cc) enddo crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & rTol_crystalliteState .or. & From 31906e3ebd70ea033e9f7fb652cd6280278f1fbd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 09:21:33 +0100 Subject: [PATCH 091/107] no need for 2 loops --- src/crystallite.f90 | 47 +++++++++++++++++---------------------------- 1 file changed, 18 insertions(+), 29 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index de535e8c2..3239f12c4 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2016,6 +2016,8 @@ subroutine integrateStateRKCK45() mySizePlasticDotState, & ! size of dot States mySizeSourceDotState + ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler + ! ToDo: MD: rel residuu don't have to be pointwise real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & @@ -2080,54 +2082,41 @@ subroutine integrateStateRKCK45() relPlasticStateResiduum = 0.0_pReal relSourceStateResiduum = 0.0_pReal - !$OMP PARALLEL - !$OMP DO PRIVATE(p,cc) + !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - cc = phasememberAt(g,i,e) - plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) ! store Runge-Kutta dotState - do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%RKCK45dotState(6,:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) ! store Runge-Kutta dotState - enddo - endif - enddo; enddo; enddo - !$OMP ENDDO - - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - cc = phasememberAt(g,i,e) - - ! --- absolute residuum in state --- - mySizePlasticDotState = plasticState(p)%sizeDotState + p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) + + mySizePlasticDotState = plasticState(p)%sizeDotState + + plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) + plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)),DB) & * crystallite_subdt(g,i,e) + + plasticState(p)%dotState(:,cc) = & + matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)), B) + do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState + + sourceState(p)%p(mySource)%RKCK45dotState(6,:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) ! store Runge-Kutta dotState + sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) = & matmul(transpose(sourceState(p)%p(mySource)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),DB) & * crystallite_subdt(g,i,e) - enddo - ! --- dot state --- - plasticState(p)%dotState(:,cc) = & - matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)), B) - do mySource = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState sourceState(p)%p(mySource)%dotState(:,cc) = & matmul(transpose(sourceState(p)%p(mySource)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),B) enddo + endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO call update_state(1.0_pReal) From 46be595ea803004d09a157c440a2848ad33e7f9e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:28:47 +0100 Subject: [PATCH 092/107] no need to store relative residual for all points --- src/crystallite.f90 | 43 +++++++++++++++++++++---------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 3239f12c4..d24b16dbf 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1787,18 +1787,19 @@ subroutine integrateStateAdaptiveEuler() s, & sizeDotState - ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler - ! ToDo: MD: rel residuu don't have to be pointwise - -real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & + ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler + real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - residuum_plastic, & - residuum_plastic_rel + residuum_plastic real(pReal), dimension(constitutive_source_maxSizeDotState,& maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - residuum_source_rel, & residuum_source + + real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & + residuum_plastic_rel + real(pReal), dimension(constitutive_source_maxSizeDotState) :: & + residuum_source_rel !-------------------------------------------------------------------------------------------------- ! contribution to state and relative residui and from Euler integration @@ -1828,10 +1829,10 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & enddo; enddo; enddo !$OMP END PARALLEL DO - call update_deltaState - call update_dependentState - call update_stress(1.0_pReal) - call update_dotState(1.0_pReal) + call update_deltaState + call update_dependentState + call update_stress(1.0_pReal) + call update_dotState(1.0_pReal) !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) @@ -1840,20 +1841,18 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState - - ! --- contribution of heun step to absolute residui --- residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) where(dNeq0(plasticState(p)%dotState(1:sizeDotState,c))) - residuum_plastic_rel(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & - / plasticState(p)%dotState(1:sizeDotState,c) + residuum_plastic_rel(1:sizeDotState) = residuum_plastic(1:sizeDotState,g,i,e) & + / plasticState(p)%dotState(1:sizeDotState,c) else where - residuum_plastic_rel(1:sizeDotState,g,i,e) = 0.0_pReal + residuum_plastic_rel(1:sizeDotState) = 0.0_pReal end where - crystallite_converged(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState,g,i,e)) < & + crystallite_converged(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState)) < & rTol_crystalliteState .or. & abs(residuum_plastic(1:sizeDotState,g,i,e)) < & plasticState(p)%aTolState(1:sizeDotState)) @@ -1865,14 +1864,14 @@ real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) where(dNeq0(sourceState(p)%p(s)%dotState(1:sizeDotState,c))) - residuum_source_rel(1:sizeDotState,s,g,i,e) = residuum_source(1:sizeDotState,s,g,i,e) & - / sourceState(p)%p(s)%dotState(1:sizeDotState,c) + residuum_source_rel(1:sizeDotState) = residuum_source(1:sizeDotState,s,g,i,e) & + / sourceState(p)%p(s)%dotState(1:sizeDotState,c) else where - residuum_source_rel(1:SizeDotState,s,g,i,e) = 0.0_pReal + residuum_source_rel(1:SizeDotState) = 0.0_pReal end where - crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & - all(abs(residuum_source_rel(1:sizeDotState,s,g,i,e)) < & + crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & + all(abs(residuum_source_rel(1:sizeDotState)) < & rTol_crystalliteState .or. & abs(residuum_source(1:sizeDotState,s,g,i,e)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState)) From 0745d7ebc20ab6803869d88ca88cb56a8afb0aca Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:33:57 +0100 Subject: [PATCH 093/107] convergence flag is set only later --- src/crystallite.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index d24b16dbf..053aa35eb 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1809,7 +1809,7 @@ subroutine integrateStateAdaptiveEuler() do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState @@ -1838,7 +1838,7 @@ subroutine integrateStateAdaptiveEuler() do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); c = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState From 72c4f2b25fae73f0c9ec665fbb1132571f80aa51 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:37:18 +0100 Subject: [PATCH 094/107] same names everywhere if possible --- src/crystallite.f90 | 54 ++++++++++++++++++++++----------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 053aa35eb..80e1a7ed6 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2011,7 +2011,7 @@ subroutine integrateStateRKCK45() n, & p, & cc, & - mySource, & + s, & mySizePlasticDotState, & ! size of dot States mySizeSourceDotState @@ -2049,17 +2049,17 @@ subroutine integrateStateRKCK45() plasticState(p)%RKCK45dotState(stage,:,cc) = plasticState(p)%dotState(:,cc) plasticState(p)%dotState(:,cc) = A(1,stage) * plasticState(p)%RKCK45dotState(1,:,cc) - do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%RKCK45dotState(stage,:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) - sourceState(p)%p(mySource)%dotState(:,cc) = A(1,stage) * sourceState(p)%p(mySource)%RKCK45dotState(1,:,cc) + do s = 1_pInt, phase_Nsources(p) + sourceState(p)%p(s)%RKCK45dotState(stage,:,cc) = sourceState(p)%p(s)%dotState(:,cc) + sourceState(p)%p(s)%dotState(:,cc) = A(1,stage) * sourceState(p)%p(s)%RKCK45dotState(1,:,cc) enddo do n = 2_pInt, stage plasticState(p)%dotState(:,cc) = plasticState(p)%dotState(:,cc) & + A(n,stage) * plasticState(p)%RKCK45dotState(n,:,cc) - do mySource = 1_pInt, phase_Nsources(p) - sourceState(p)%p(mySource)%dotState(:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) & - + A(n,stage) * sourceState(p)%p(mySource)%RKCK45dotState(n,:,cc) + do s = 1_pInt, phase_Nsources(p) + sourceState(p)%p(s)%dotState(:,cc) = sourceState(p)%p(s)%dotState(:,cc) & + + A(n,stage) * sourceState(p)%p(s)%RKCK45dotState(n,:,cc) enddo enddo @@ -2099,18 +2099,18 @@ subroutine integrateStateRKCK45() plasticState(p)%dotState(:,cc) = & matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)), B) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(mySource)%RKCK45dotState(6,:,cc) = sourceState(p)%p(mySource)%dotState(:,cc) ! store Runge-Kutta dotState + sourceState(p)%p(s)%RKCK45dotState(6,:,cc) = sourceState(p)%p(s)%dotState(:,cc) ! store Runge-Kutta dotState - sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e) = & - matmul(transpose(sourceState(p)%p(mySource)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),DB) & + sourceStateResiduum(1:mySizeSourceDotState,s,g,i,e) = & + matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),DB) & * crystallite_subdt(g,i,e) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - sourceState(p)%p(mySource)%dotState(:,cc) = & - matmul(transpose(sourceState(p)%p(mySource)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),B) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sourceState(p)%p(s)%dotState(:,cc) = & + matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),B) enddo endif @@ -2127,30 +2127,30 @@ subroutine integrateStateRKCK45() do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - cc = phasememberAt(g,i,e) + p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) + mySizePlasticDotState = plasticState(p)%sizeDotState forall (u = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & relPlasticStateResiduum(u,g,i,e) = & plasticStateResiduum(u,g,i,e) / plasticState(p)%state(u,cc) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState - forall (u = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(mySource)%state(u,cc)) > 0.0_pReal) & - relSourceStateResiduum(u,mySource,g,i,e) = & - sourceStateResiduum(u,mySource,g,i,e) / sourceState(p)%p(mySource)%state(u,cc) + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + forall (u = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & + relSourceStateResiduum(u,s,g,i,e) = & + sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) enddo crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & rTol_crystalliteState .or. & abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & plasticState(p)%aTolState(1:mySizePlasticDotState)) - do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(mySource)%sizeDotState + do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & - all(abs(relSourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & + all(abs(relSourceStateResiduum(1:mySizeSourceDotState,s,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & - sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState)) + abs(sourceStateResiduum(1:mySizeSourceDotState,s,g,i,e)) < & + sourceState(p)%p(s)%aTolState(1:mySizeSourceDotState)) enddo endif enddo; enddo; enddo From 0876787e3c56bd201214d599a74c1ce1c11ef9ce Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:46:53 +0100 Subject: [PATCH 095/107] avoid loops --- src/crystallite.f90 | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 80e1a7ed6..cc261726f 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1976,10 +1976,8 @@ subroutine integrateStateRKCK45() phaseAt, phasememberAt, & homogenization_maxNgrains use constitutive, only: & - constitutive_collectDotState, & constitutive_plasticity_maxSizeDotState, & - constitutive_source_maxSizeDotState, & - constitutive_microstructure + constitutive_source_maxSizeDotState implicit none real(pReal), dimension(5,5), parameter :: & @@ -2059,7 +2057,7 @@ subroutine integrateStateRKCK45() + A(n,stage) * plasticState(p)%RKCK45dotState(n,:,cc) do s = 1_pInt, phase_Nsources(p) sourceState(p)%p(s)%dotState(:,cc) = sourceState(p)%p(s)%dotState(:,cc) & - + A(n,stage) * sourceState(p)%p(s)%RKCK45dotState(n,:,cc) + + A(n,stage) * sourceState(p)%p(s)%RKCK45dotState(n,:,cc) enddo enddo @@ -2088,7 +2086,7 @@ subroutine integrateStateRKCK45() if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) - mySizePlasticDotState = plasticState(p)%sizeDotState + mySizePlasticDotState = plasticState(p)%sizeDotState plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) @@ -2133,18 +2131,18 @@ subroutine integrateStateRKCK45() forall (u = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & relPlasticStateResiduum(u,g,i,e) = & plasticStateResiduum(u,g,i,e) / plasticState(p)%state(u,cc) + + crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + rTol_crystalliteState .or. & + abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + plasticState(p)%aTolState(1:mySizePlasticDotState)) do s = 1_pInt, phase_Nsources(p) mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState forall (u = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & relSourceStateResiduum(u,s,g,i,e) = & sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) - enddo - crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState)) - do s = 1_pInt, phase_Nsources(p) + mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & all(abs(relSourceStateResiduum(1:mySizeSourceDotState,s,g,i,e)) < & From 4ec0fd70a2574e2caa84497fea165d53fcffb608 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:48:59 +0100 Subject: [PATCH 096/107] only one variable needed --- src/crystallite.f90 | 47 ++++++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 24 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index cc261726f..81b730aad 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2010,8 +2010,7 @@ subroutine integrateStateRKCK45() p, & cc, & s, & - mySizePlasticDotState, & ! size of dot States - mySizeSourceDotState + sizeDotState ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler ! ToDo: MD: rel residuu don't have to be pointwise @@ -2079,36 +2078,36 @@ subroutine integrateStateRKCK45() relPlasticStateResiduum = 0.0_pReal relSourceStateResiduum = 0.0_pReal - !$OMP PARALLEL DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc) + !$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) - mySizePlasticDotState = plasticState(p)%sizeDotState + sizeDotState = plasticState(p)%sizeDotState plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) - plasticStateResiduum(1:mySizePlasticDotState,g,i,e) = & - matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)),DB) & + plasticStateResiduum(1:sizeDotState,g,i,e) = & + matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & * crystallite_subdt(g,i,e) plasticState(p)%dotState(:,cc) = & - matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:mySizePlasticDotState,cc)), B) + matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)), B) do s = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sizeDotState = sourceState(p)%p(s)%sizeDotState sourceState(p)%p(s)%RKCK45dotState(6,:,cc) = sourceState(p)%p(s)%dotState(:,cc) ! store Runge-Kutta dotState - sourceStateResiduum(1:mySizeSourceDotState,s,g,i,e) = & - matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),DB) & + sourceStateResiduum(1:sizeDotState,s,g,i,e) = & + matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & * crystallite_subdt(g,i,e) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sizeDotState = sourceState(p)%p(s)%sizeDotState sourceState(p)%p(s)%dotState(:,cc) = & - matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:mySizeSourceDotState,cc)),B) + matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:sizeDotState,cc)),B) enddo endif @@ -2120,35 +2119,35 @@ subroutine integrateStateRKCK45() !$OMP PARALLEL ! --- relative residui and state convergence --- - !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc,u) + !$OMP DO PRIVATE(sizeDotState,p,cc,u) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) if (crystallite_todo(g,i,e)) then p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) - mySizePlasticDotState = plasticState(p)%sizeDotState - forall (u = 1_pInt:mySizePlasticDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & + sizeDotState = plasticState(p)%sizeDotState + forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & relPlasticStateResiduum(u,g,i,e) = & plasticStateResiduum(u,g,i,e) / plasticState(p)%state(u,cc) - crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & + crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:mySizePlasticDotState,g,i,e)) < & - plasticState(p)%aTolState(1:mySizePlasticDotState)) + abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState - forall (u = 1_pInt:mySizeSourceDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & + sizeDotState = sourceState(p)%p(s)%sizeDotState + forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & relSourceStateResiduum(u,s,g,i,e) = & sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) - mySizeSourceDotState = sourceState(p)%p(s)%sizeDotState + sizeDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & - all(abs(relSourceStateResiduum(1:mySizeSourceDotState,s,g,i,e)) < & + all(abs(relSourceStateResiduum(1:sizeDotState,s,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:mySizeSourceDotState,s,g,i,e)) < & - sourceState(p)%p(s)%aTolState(1:mySizeSourceDotState)) + abs(sourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif enddo; enddo; enddo From fd069a96cdc68941a44de7aca9083a2b03b5d5d9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 10:51:24 +0100 Subject: [PATCH 097/107] unifying name --- src/crystallite.f90 | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 81b730aad..f9f469a5d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2017,13 +2017,13 @@ subroutine integrateStateRKCK45() real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - plasticStateResiduum, & ! residuum from evolution in microstructure - relPlasticStateResiduum ! relative residuum from evolution in microstructure + residuum_plastic, & ! residuum from evolution in microstructure + residuum_plastic_rel ! relative residuum from evolution in microstructure real(pReal), dimension(constitutive_source_maxSizeDotState, & maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - sourceStateResiduum, & ! residuum from evolution in microstructure - relSourceStateResiduum ! relative residuum from evolution in microstructure + residuum_source, & ! residuum from evolution in microstructure + residuum_source_rel ! relative residuum from evolution in microstructure @@ -2076,8 +2076,8 @@ subroutine integrateStateRKCK45() !-------------------------------------------------------------------------------------------------- ! --- STATE UPDATE WITH ERROR ESTIMATE FOR STATE --- - relPlasticStateResiduum = 0.0_pReal - relSourceStateResiduum = 0.0_pReal + residuum_plastic_rel = 0.0_pReal + residuum_source_rel = 0.0_pReal !$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) @@ -2089,7 +2089,7 @@ subroutine integrateStateRKCK45() plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) - plasticStateResiduum(1:sizeDotState,g,i,e) = & + residuum_plastic(1:sizeDotState,g,i,e) = & matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & * crystallite_subdt(g,i,e) @@ -2101,7 +2101,7 @@ subroutine integrateStateRKCK45() sourceState(p)%p(s)%RKCK45dotState(6,:,cc) = sourceState(p)%p(s)%dotState(:,cc) ! store Runge-Kutta dotState - sourceStateResiduum(1:sizeDotState,s,g,i,e) = & + residuum_source(1:sizeDotState,s,g,i,e) = & matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & * crystallite_subdt(g,i,e) @@ -2128,25 +2128,25 @@ subroutine integrateStateRKCK45() sizeDotState = plasticState(p)%sizeDotState forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & - relPlasticStateResiduum(u,g,i,e) = & - plasticStateResiduum(u,g,i,e) / plasticState(p)%state(u,cc) + residuum_plastic_rel(u,g,i,e) = & + residuum_plastic(u,g,i,e) / plasticState(p)%state(u,cc) - crystallite_todo(g,i,e) = all(abs(relPlasticStateResiduum(1:sizeDotState,g,i,e)) < & + crystallite_todo(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState,g,i,e)) < & rTol_crystalliteState .or. & - abs(plasticStateResiduum(1:sizeDotState,g,i,e)) < & + abs(residuum_plastic(1:sizeDotState,g,i,e)) < & plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & - relSourceStateResiduum(u,s,g,i,e) = & - sourceStateResiduum(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) + residuum_source_rel(u,s,g,i,e) = & + residuum_source(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) sizeDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & - all(abs(relSourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + all(abs(residuum_source_rel(1:sizeDotState,s,g,i,e)) < & rTol_crystalliteState .or. & - abs(sourceStateResiduum(1:sizeDotState,s,g,i,e)) < & + abs(residuum_source(1:sizeDotState,s,g,i,e)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif From 3dd21177a0464faf46aca285cb7d3f8ca7325743 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 11:04:49 +0100 Subject: [PATCH 098/107] no need to store relative residual pointwise --- src/crystallite.f90 | 76 ++++++++++++++++++++++----------------------- 1 file changed, 38 insertions(+), 38 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index f9f469a5d..0a190e364 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1890,8 +1890,6 @@ end subroutine integrateStateAdaptiveEuler ! ToDo: This is totally BROKEN: RK4dotState is never used!!! !-------------------------------------------------------------------------------------------------- subroutine integrateStateRK4() - use, intrinsic :: & - IEEE_arithmetic use mesh, only: & mesh_element use material, only: & @@ -1960,8 +1958,8 @@ end subroutine integrateStateRK4 !> adaptive step size (use 5th order solution to advance = "local extrapolation") !-------------------------------------------------------------------------------------------------- subroutine integrateStateRKCK45() - use, intrinsic :: & - IEEE_arithmetic + use prec, only: & + dNeq0 use numerics, only: & rTol_crystalliteState use mesh, only: & @@ -2005,26 +2003,25 @@ subroutine integrateStateRKCK45() i, & ! integration point index in ip loop g, & ! grain index in grain loop stage, & ! stage index in integration stage loop - u, & ! state index n, & p, & cc, & s, & sizeDotState - ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler - ! ToDo: MD: rel residuu don't have to be pointwise + ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of RKCK45 real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - residuum_plastic, & ! residuum from evolution in microstructure - residuum_plastic_rel ! relative residuum from evolution in microstructure + residuum_plastic ! relative residuum from evolution in microstructure real(pReal), dimension(constitutive_source_maxSizeDotState, & maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & - residuum_source, & ! residuum from evolution in microstructure - residuum_source_rel ! relative residuum from evolution in microstructure - + residuum_source ! relative residuum from evolution in microstructure + real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & + residuum_plastic_rel + real(pReal), dimension(constitutive_source_maxSizeDotState) :: & + residuum_source_rel call update_dotState(1.0_pReal) @@ -2076,8 +2073,6 @@ subroutine integrateStateRKCK45() !-------------------------------------------------------------------------------------------------- ! --- STATE UPDATE WITH ERROR ESTIMATE FOR STATE --- - residuum_plastic_rel = 0.0_pReal - residuum_source_rel = 0.0_pReal !$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) @@ -2116,43 +2111,48 @@ subroutine integrateStateRKCK45() call update_state(1.0_pReal) -!$OMP PARALLEL ! --- relative residui and state convergence --- - !$OMP DO PRIVATE(sizeDotState,p,cc,u) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1,homogenization_Ngrains(mesh_element(3,e)) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) + !$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc) + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) + if (crystallite_todo(g,i,e)) then + p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) - sizeDotState = plasticState(p)%sizeDotState - forall (u = 1_pInt:sizeDotState, abs(plasticState(p)%state(u,cc)) > 0.0_pReal) & - residuum_plastic_rel(u,g,i,e) = & - residuum_plastic(u,g,i,e) / plasticState(p)%state(u,cc) + sizeDotState = plasticState(p)%sizeDotState + where(dNeq0(plasticState(p)%dotState(1:sizeDotState,cc))) + residuum_plastic_rel(1:sizeDotState) = residuum_plastic(1:sizeDotState,g,i,e) & + / plasticState(p)%state(1:sizeDotState,cc) + else where + residuum_plastic_rel(1:sizeDotState) = 0.0_pReal + end where + - crystallite_todo(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState,g,i,e)) < & - rTol_crystalliteState .or. & - abs(residuum_plastic(1:sizeDotState,g,i,e)) < & - plasticState(p)%aTolState(1:sizeDotState)) + crystallite_todo(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState)) < & + rTol_crystalliteState .or. & + abs(residuum_plastic(1:sizeDotState,g,i,e)) < & + plasticState(p)%aTolState(1:sizeDotState)) - do s = 1_pInt, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState - forall (u = 1_pInt:sizeDotState,abs(sourceState(p)%p(s)%state(u,cc)) > 0.0_pReal) & - residuum_source_rel(u,s,g,i,e) = & - residuum_source(u,s,g,i,e) / sourceState(p)%p(s)%state(u,cc) + do s = 1_pInt, phase_Nsources(p) + sizeDotState = sourceState(p)%p(s)%sizeDotState + + where(dNeq0(sourceState(p)%p(s)%dotState(1:sizeDotState,cc))) + residuum_source_rel(1:sizeDotState) = residuum_source(1:sizeDotState,s,g,i,e) & + / sourceState(p)%p(s)%state(1:sizeDotState,cc) + else where + residuum_source_rel(1:SizeDotState) = 0.0_pReal + end where - sizeDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & - all(abs(residuum_source_rel(1:sizeDotState,s,g,i,e)) < & + all(abs(residuum_source_rel(1:sizeDotState)) < & rTol_crystalliteState .or. & abs(residuum_source(1:sizeDotState,s,g,i,e)) < & sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif enddo; enddo; enddo - !$OMP ENDDO -!$OMP END PARALLEL + !$OMP END PARALLEL DO call update_deltaState call update_dependentState From 39e766bba006e52742a952fbf523e413fa02750d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 12:36:02 +0100 Subject: [PATCH 099/107] improved readability --- src/crystallite.f90 | 139 +++++++++++++++++++++++--------------------- 1 file changed, 73 insertions(+), 66 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0a190e364..210bf8198 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1758,10 +1758,6 @@ end subroutine integrateStateEuler !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- subroutine integrateStateAdaptiveEuler() - use prec, only: & - dNeq0 - use numerics, only: & - rTol_crystalliteState use mesh, only: & mesh_element, & mesh_NcpElems, & @@ -1795,11 +1791,6 @@ subroutine integrateStateAdaptiveEuler() maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & residuum_source - - real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & - residuum_plastic_rel - real(pReal), dimension(constitutive_source_maxSizeDotState) :: & - residuum_source_rel !-------------------------------------------------------------------------------------------------- ! contribution to state and relative residui and from Euler integration @@ -1845,42 +1836,55 @@ subroutine integrateStateAdaptiveEuler() residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - where(dNeq0(plasticState(p)%dotState(1:sizeDotState,c))) - residuum_plastic_rel(1:sizeDotState) = residuum_plastic(1:sizeDotState,g,i,e) & - / plasticState(p)%dotState(1:sizeDotState,c) - else where - residuum_plastic_rel(1:sizeDotState) = 0.0_pReal - end where - - crystallite_converged(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState)) < & - rTol_crystalliteState .or. & - abs(residuum_plastic(1:sizeDotState,g,i,e)) < & - plasticState(p)%aTolState(1:sizeDotState)) + crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & + plasticState(p)%dotState(1:sizeDotState,c), & + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState residuum_source(1:sizeDotState,s,g,i,e) = residuum_source(1:sizeDotState,s,g,i,e) & + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) - - where(dNeq0(sourceState(p)%p(s)%dotState(1:sizeDotState,c))) - residuum_source_rel(1:sizeDotState) = residuum_source(1:sizeDotState,s,g,i,e) & - / sourceState(p)%p(s)%dotState(1:sizeDotState,c) - else where - residuum_source_rel(1:SizeDotState) = 0.0_pReal - end where - crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & - all(abs(residuum_source_rel(1:sizeDotState)) < & - rTol_crystalliteState .or. & - abs(residuum_source(1:sizeDotState,s,g,i,e)) < & - sourceState(p)%p(s)%aTolState(1:sizeDotState)) - enddo + crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and.& + converged(residuum_source(1:sizeDotState,s,g,i,e), & + sourceState(p)%p(s)%dotState(1:sizeDotState,c), & + sourceState(p)%p(s)%aTolState(1:sizeDotState)) + enddo + endif enddo; enddo; enddo !$OMP END PARALLEL DO if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief determines whether a point is converged + !-------------------------------------------------------------------------------------------------- + logical pure function converged(residuum,dotState,absoluteTolerance) + use prec, only: & + dNeq0 + use numerics, only: & + rTol_crystalliteState + + implicit none + real(pReal), dimension(:), intent(in) ::& + residuum, dotState, absoluteTolerance + real(pReal), dimension(size(residuum,1)) ::& + residuum_rel + + where(dNeq0(dotState)) + residuum_rel = residuum/dotState + else where + residuum_rel = 0.0_pReal + end where + + converged = all(abs(residuum_rel) < rTol_crystalliteState .or. & + abs(residuum) < absoluteTolerance) + + end function converged end subroutine integrateStateAdaptiveEuler @@ -1958,10 +1962,6 @@ end subroutine integrateStateRK4 !> adaptive step size (use 5th order solution to advance = "local extrapolation") !-------------------------------------------------------------------------------------------------- subroutine integrateStateRKCK45() - use prec, only: & - dNeq0 - use numerics, only: & - rTol_crystalliteState use mesh, only: & mesh_element, & mesh_NcpElems, & @@ -2018,15 +2018,10 @@ subroutine integrateStateRKCK45() maxval(phase_Nsources), & homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & residuum_source ! relative residuum from evolution in microstructure - real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & - residuum_plastic_rel - real(pReal), dimension(constitutive_source_maxSizeDotState) :: & - residuum_source_rel call update_dotState(1.0_pReal) - ! --- SECOND TO SIXTH RUNGE KUTTA STEP --- do stage = 1_pInt,5_pInt @@ -2121,34 +2116,18 @@ subroutine integrateStateRKCK45() p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState - where(dNeq0(plasticState(p)%dotState(1:sizeDotState,cc))) - residuum_plastic_rel(1:sizeDotState) = residuum_plastic(1:sizeDotState,g,i,e) & - / plasticState(p)%state(1:sizeDotState,cc) - else where - residuum_plastic_rel(1:sizeDotState) = 0.0_pReal - end where - - - crystallite_todo(g,i,e) = all(abs(residuum_plastic_rel(1:sizeDotState)) < & - rTol_crystalliteState .or. & - abs(residuum_plastic(1:sizeDotState,g,i,e)) < & - plasticState(p)%aTolState(1:sizeDotState)) + + crystallite_todo(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & + plasticState(p)%dotState(1:sizeDotState,cc), & + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - where(dNeq0(sourceState(p)%p(s)%dotState(1:sizeDotState,cc))) - residuum_source_rel(1:sizeDotState) = residuum_source(1:sizeDotState,s,g,i,e) & - / sourceState(p)%p(s)%state(1:sizeDotState,cc) - else where - residuum_source_rel(1:SizeDotState) = 0.0_pReal - end where - - crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and. & - all(abs(residuum_source_rel(1:sizeDotState)) < & - rTol_crystalliteState .or. & - abs(residuum_source(1:sizeDotState,s,g,i,e)) < & - sourceState(p)%p(s)%aTolState(1:sizeDotState)) + crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and.& + converged(residuum_source(1:sizeDotState,s,g,i,e), & + sourceState(p)%p(s)%dotState(1:sizeDotState,cc), & + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif enddo; enddo; enddo @@ -2159,6 +2138,34 @@ subroutine integrateStateRKCK45() call update_stress(1.0_pReal) call setConvergenceFlag if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief determines whether a point is converged + !-------------------------------------------------------------------------------------------------- + logical pure function converged(residuum,dotState,absoluteTolerance) + use prec, only: & + dNeq0 + use numerics, only: & + rTol_crystalliteState + + implicit none + real(pReal), dimension(:), intent(in) ::& + residuum, dotState, absoluteTolerance + real(pReal), dimension(size(residuum,1)) ::& + residuum_rel + + where(dNeq0(dotState)) + residuum_rel = residuum/dotState + else where + residuum_rel = 0.0_pReal + end where + + converged = all(abs(residuum_rel) < rTol_crystalliteState .or. & + abs(residuum) < absoluteTolerance) + + end function converged end subroutine integrateStateRKCK45 From 64b89484d2b75693b15be359427bb22244b336aa Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 12:56:02 +0100 Subject: [PATCH 100/107] logic better visible --- src/crystallite.f90 | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 210bf8198..dc3e5b154 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1872,17 +1872,16 @@ subroutine integrateStateAdaptiveEuler() implicit none real(pReal), dimension(:), intent(in) ::& residuum, dotState, absoluteTolerance - real(pReal), dimension(size(residuum,1)) ::& - residuum_rel - + logical, dimension(size(residuum,1)) ::& + converged_array + where(dNeq0(dotState)) - residuum_rel = residuum/dotState + converged_array = abs(residuum) < absoluteTolerance .or. (abs(residuum/dotState) < rTol_crystalliteState) else where - residuum_rel = 0.0_pReal + converged_array = .true. end where - converged = all(abs(residuum_rel) < rTol_crystalliteState .or. & - abs(residuum) < absoluteTolerance) + converged = all(converged_array) end function converged @@ -2153,17 +2152,16 @@ subroutine integrateStateRKCK45() implicit none real(pReal), dimension(:), intent(in) ::& residuum, dotState, absoluteTolerance - real(pReal), dimension(size(residuum,1)) ::& - residuum_rel - + logical, dimension(size(residuum,1)) ::& + converged_array + where(dNeq0(dotState)) - residuum_rel = residuum/dotState + converged_array = abs(residuum) < absoluteTolerance .or. (abs(residuum/dotState) < rTol_crystalliteState) else where - residuum_rel = 0.0_pReal + converged_array = .true. end where - converged = all(abs(residuum_rel) < rTol_crystalliteState .or. & - abs(residuum) < absoluteTolerance) + converged = all(converged_array) end function converged From 1d88057ce42c7069d5a0b5d6c7ff8c1f13d29589 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 13:24:35 +0100 Subject: [PATCH 101/107] avoid superflous variables --- src/crystallite.f90 | 60 ++++++++++++++++++++------------------------- 1 file changed, 27 insertions(+), 33 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index dc3e5b154..4adae2a19 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1836,9 +1836,9 @@ subroutine integrateStateAdaptiveEuler() residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & + crystallite_converged(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & plasticState(p)%dotState(1:sizeDotState,c), & - plasticState(p)%aTolState(1:sizeDotState)) + plasticState(p)%aTolState(1:sizeDotState))) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState @@ -1847,9 +1847,9 @@ subroutine integrateStateAdaptiveEuler() + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and.& - converged(residuum_source(1:sizeDotState,s,g,i,e), & + all(converged(residuum_source(1:sizeDotState,s,g,i,e), & sourceState(p)%p(s)%dotState(1:sizeDotState,c), & - sourceState(p)%p(s)%aTolState(1:sizeDotState)) + sourceState(p)%p(s)%aTolState(1:sizeDotState))) enddo endif @@ -1863,25 +1863,22 @@ subroutine integrateStateAdaptiveEuler() !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure function converged(residuum,dotState,absoluteTolerance) + logical pure elemental function converged(residuum,dotState,absoluteTolerance) use prec, only: & - dNeq0 + dEq0 use numerics, only: & rTol_crystalliteState implicit none - real(pReal), dimension(:), intent(in) ::& + real(pReal), intent(in) ::& residuum, dotState, absoluteTolerance - logical, dimension(size(residuum,1)) ::& - converged_array - where(dNeq0(dotState)) - converged_array = abs(residuum) < absoluteTolerance .or. (abs(residuum/dotState) < rTol_crystalliteState) - else where - converged_array = .true. - end where - - converged = all(converged_array) + if (dEq0(dotState)) then + converged = .true. + else + converged = abs(residuum) < absoluteTolerance & + .or. abs(residuum/dotState) < rTol_crystalliteState + endif end function converged @@ -2116,17 +2113,17 @@ subroutine integrateStateRKCK45() sizeDotState = plasticState(p)%sizeDotState - crystallite_todo(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & + crystallite_todo(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & plasticState(p)%dotState(1:sizeDotState,cc), & - plasticState(p)%aTolState(1:sizeDotState)) + plasticState(p)%aTolState(1:sizeDotState))) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and.& - converged(residuum_source(1:sizeDotState,s,g,i,e), & + all(converged(residuum_source(1:sizeDotState,s,g,i,e), & sourceState(p)%p(s)%dotState(1:sizeDotState,cc), & - sourceState(p)%p(s)%aTolState(1:sizeDotState)) + sourceState(p)%p(s)%aTolState(1:sizeDotState))) enddo endif enddo; enddo; enddo @@ -2138,30 +2135,27 @@ subroutine integrateStateRKCK45() call setConvergenceFlag if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck - contains + contains !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure function converged(residuum,dotState,absoluteTolerance) + logical pure elemental function converged(residuum,dotState,absoluteTolerance) use prec, only: & - dNeq0 + dEq0 use numerics, only: & rTol_crystalliteState implicit none - real(pReal), dimension(:), intent(in) ::& + real(pReal), intent(in) ::& residuum, dotState, absoluteTolerance - logical, dimension(size(residuum,1)) ::& - converged_array - where(dNeq0(dotState)) - converged_array = abs(residuum) < absoluteTolerance .or. (abs(residuum/dotState) < rTol_crystalliteState) - else where - converged_array = .true. - end where - - converged = all(converged_array) + if (dEq0(dotState)) then + converged = .true. + else + converged = abs(residuum) < absoluteTolerance & + .or. abs(residuum/dotState) < rTol_crystalliteState + endif end function converged From fe88e5bf9cda3e38e2c7f46ce058052316f9b465 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 14:52:12 +0100 Subject: [PATCH 102/107] [skip ci] cleaning --- src/crystallite.f90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 4adae2a19..b089e2f77 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2085,13 +2085,12 @@ subroutine integrateStateRKCK45() do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%RKCK45dotState(6,:,cc) = sourceState(p)%p(s)%dotState(:,cc) ! store Runge-Kutta dotState - + sourceState(p)%p(s)%RKCK45dotState(6,:,cc) = sourceState(p)%p(s)%dotState(:,cc) + residuum_source(1:sizeDotState,s,g,i,e) = & matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & * crystallite_subdt(g,i,e) - sizeDotState = sourceState(p)%p(s)%sizeDotState sourceState(p)%p(s)%dotState(:,cc) = & matmul(transpose(sourceState(p)%p(s)%RKCK45dotState(1:6,1:sizeDotState,cc)),B) enddo @@ -2124,7 +2123,7 @@ subroutine integrateStateRKCK45() all(converged(residuum_source(1:sizeDotState,s,g,i,e), & sourceState(p)%p(s)%dotState(1:sizeDotState,cc), & sourceState(p)%p(s)%aTolState(1:sizeDotState))) - enddo + enddo endif enddo; enddo; enddo !$OMP END PARALLEL DO From e1c2747393392543bfee7cdcfe25a243d35116d9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 16:06:14 +0100 Subject: [PATCH 103/107] logic error for nonlocal --- src/crystallite.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index b089e2f77..3ad592147 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2340,7 +2340,7 @@ subroutine update_dotState(timeFraction) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) !$OMP FLUSH(nonlocalStop) - if (nonlocalStop .or. (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e))) then + if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Fe, & crystallite_Fi(1:3,1:3,g,i,e), & @@ -2399,7 +2399,7 @@ subroutine update_deltaState do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) !$OMP FLUSH(nonlocalStop) - if (nonlocalStop .or. (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e))) then + if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then call constitutive_collectDeltaState(math_6toSym33(crystallite_Tstar_v(1:6,g,i,e)), & crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fi(1:3,1:3,g,i,e), & From 3b13a1af6376314ef50f2f240bd2def7f7570c5e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Jan 2019 17:04:58 +0100 Subject: [PATCH 104/107] calculated convergence criteria wrongly --- src/crystallite.f90 | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 3ad592147..749f202e4 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1837,7 +1837,7 @@ subroutine integrateStateAdaptiveEuler() + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) crystallite_converged(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & - plasticState(p)%dotState(1:sizeDotState,c), & + plasticState(p)%state(1:sizeDotState,c), & plasticState(p)%aTolState(1:sizeDotState))) do s = 1_pInt, phase_Nsources(p) @@ -1848,7 +1848,7 @@ subroutine integrateStateAdaptiveEuler() crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and.& all(converged(residuum_source(1:sizeDotState,s,g,i,e), & - sourceState(p)%p(s)%dotState(1:sizeDotState,c), & + sourceState(p)%p(s)%state(1:sizeDotState,c), & sourceState(p)%p(s)%aTolState(1:sizeDotState))) enddo @@ -1863,21 +1863,21 @@ subroutine integrateStateAdaptiveEuler() !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure elemental function converged(residuum,dotState,absoluteTolerance) + logical pure elemental function converged(residuum,state,aTol) use prec, only: & dEq0 use numerics, only: & - rTol_crystalliteState + rTol => rTol_crystalliteState implicit none real(pReal), intent(in) ::& - residuum, dotState, absoluteTolerance + residuum, state, aTol - if (dEq0(dotState)) then - converged = .true. + if (dEq0(state)) then + converged = .true. ! ToDo: intended behavior? Not rely on absoluteTolerance else - converged = abs(residuum) < absoluteTolerance & - .or. abs(residuum/dotState) < rTol_crystalliteState + converged = abs(residuum) < aTol & + .or. abs(residuum/state) < rTol endif end function converged @@ -2113,7 +2113,7 @@ subroutine integrateStateRKCK45() sizeDotState = plasticState(p)%sizeDotState crystallite_todo(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & - plasticState(p)%dotState(1:sizeDotState,cc), & + plasticState(p)%state(1:sizeDotState,cc), & plasticState(p)%aTolState(1:sizeDotState))) do s = 1_pInt, phase_Nsources(p) @@ -2121,7 +2121,7 @@ subroutine integrateStateRKCK45() crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and.& all(converged(residuum_source(1:sizeDotState,s,g,i,e), & - sourceState(p)%p(s)%dotState(1:sizeDotState,cc), & + sourceState(p)%p(s)%state(1:sizeDotState,cc), & sourceState(p)%p(s)%aTolState(1:sizeDotState))) enddo endif @@ -2139,21 +2139,21 @@ subroutine integrateStateRKCK45() !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure elemental function converged(residuum,dotState,absoluteTolerance) + logical pure elemental function converged(residuum,state,aTol) use prec, only: & dEq0 use numerics, only: & - rTol_crystalliteState + rTol => rTol_crystalliteState implicit none real(pReal), intent(in) ::& - residuum, dotState, absoluteTolerance + residuum, state, aTol - if (dEq0(dotState)) then - converged = .true. + if (dEq0(state)) then + converged = .true. ! ToDo: intended behavior? Not rely on absoluteTolerance else - converged = abs(residuum) < absoluteTolerance & - .or. abs(residuum/dotState) < rTol_crystalliteState + converged = abs(residuum) < aTol & + .or. abs(residuum/state) < rTol endif end function converged From 5eaeb37ea48d2d8b23721d981f24cc8a9a25eda7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 05:17:46 +0100 Subject: [PATCH 105/107] just polishing --- src/crystallite.f90 | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 749f202e4..7c99c4d7a 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -819,8 +819,8 @@ subroutine crystallite_stressTangent() crystallite_invFi(1:3,1:3,c,i,e)) & + math_mul33x33(temp_33_3,dLidS(1:3,1:3,p,o)) end forall - lhs_3333 = crystallite_subdt(c,i,e)*math_mul3333xx3333(dSdFe,temp_3333) + & - math_mul3333xx3333(dSdFi,dFidS) + lhs_3333 = crystallite_subdt(c,i,e)*math_mul3333xx3333(dSdFe,temp_3333) & + + math_mul3333xx3333(dSdFi,dFidS) call math_invert2(temp_99,error,math_identity2nd(9_pInt)+math_3333to99(lhs_3333)) if (error) then @@ -1350,11 +1350,10 @@ logical function integrateStress(& !* calculate Jacobian for correction term if (mod(jacoCounterLp, iJacoLpresiduum) == 0_pInt) then - forall(o=1_pInt:3_pInt,p=1_pInt:3_pInt) & - dFe_dLp(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_dLp = - dt * dFe_dLp - dRLp_dLp = math_identity2nd(9_pInt) & - - math_3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) + forall(o=1_pInt:3_pInt,p=1_pInt:3_pInt) dFe_dLp(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_dLp = - dt * dFe_dLp + dRLp_dLp = math_identity2nd(9_pInt) & + - math_3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & @@ -2076,11 +2075,11 @@ subroutine integrateStateRKCK45() plasticState(p)%RKCK45dotState(6,:,cc) = plasticState (p)%dotState(:,cc) residuum_plastic(1:sizeDotState,g,i,e) = & - matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & + matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)),DB) & ! why transpose? Better to transpose constant DB * crystallite_subdt(g,i,e) plasticState(p)%dotState(:,cc) = & - matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)), B) + matmul(transpose(plasticState(p)%RKCK45dotState(1:6,1:sizeDotState,cc)), B) ! why transpose? Better to transpose constant B do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState From cbeb3dcff0133022622f1b16a2bf1375f463d4bf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 09:12:44 +0100 Subject: [PATCH 106/107] use the same formulation for convergence every where --- src/crystallite.f90 | 73 +++++++++++++++++++++++---------------------- 1 file changed, 38 insertions(+), 35 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 7c99c4d7a..f9ceab03c 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1535,11 +1535,8 @@ end function integrateStress !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- subroutine integrateStateFPI() - use, intrinsic :: & - IEEE_arithmetic use numerics, only: & - nState, & - rTol_crystalliteState + nState use mesh, only: & mesh_element use material, only: & @@ -1549,7 +1546,6 @@ subroutine integrateStateFPI() phase_Nsources, & homogenization_Ngrains use constitutive, only: & - constitutive_collectDotState, & constitutive_plasticity_maxSizeDotState, & constitutive_source_maxSizeDotState @@ -1635,9 +1631,9 @@ subroutine integrateStateFPI() plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * zeta & + plasticState(p)%previousDotState(:,c) * (1.0_pReal - zeta) - crystallite_converged(g,i,e) = all(abs(residuum_plastic(1:sizeDotState)) & - < max(plasticState(p)%aTolState(1:sizeDotState), & - abs(plasticState(p)%state(1:sizeDotState,c)*rTol_crystalliteState))) + crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState), & + plasticState(p)%state(1:sizeDotState,c), & + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) @@ -1659,9 +1655,9 @@ subroutine integrateStateFPI() + sourceState(p)%p(s)%previousDotState(:,c)* (1.0_pReal - zeta) crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and. & - all(abs(residuum_source(1:sizeDotState)) & - < max(sourceState(p)%p(s)%aTolState(1:sizeDotState), & - abs(sourceState(p)%p(s)%state(1:sizeDotState,c)*rTol_crystalliteState))) + converged(residuum_source(1:sizeDotState), & + sourceState(p)%p(s)%state(1:sizeDotState,c), & + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif enddo; enddo; enddo @@ -1729,6 +1725,23 @@ subroutine integrateStateFPI() endif end function damper + + !-------------------------------------------------------------------------------------------------- + !> @brief determines whether a point is converged + !-------------------------------------------------------------------------------------------------- + logical pure function converged(residuum,state,aTol) + use prec, only: & + dEq0 + use numerics, only: & + rTol => rTol_crystalliteState + + implicit none + real(pReal), intent(in), dimension(:) ::& + residuum, state, aTol + + converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) + + end function converged end subroutine integrateStateFPI @@ -1835,9 +1848,9 @@ subroutine integrateStateAdaptiveEuler() residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e) - crystallite_converged(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & + crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & plasticState(p)%state(1:sizeDotState,c), & - plasticState(p)%aTolState(1:sizeDotState))) + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState @@ -1846,9 +1859,9 @@ subroutine integrateStateAdaptiveEuler() + 0.5_pReal * sourceState(p)%p(s)%dotState(:,c) * crystallite_subdt(g,i,e) crystallite_converged(g,i,e) = crystallite_converged(g,i,e) .and.& - all(converged(residuum_source(1:sizeDotState,s,g,i,e), & + converged(residuum_source(1:sizeDotState,s,g,i,e), & sourceState(p)%p(s)%state(1:sizeDotState,c), & - sourceState(p)%p(s)%aTolState(1:sizeDotState))) + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif @@ -1862,22 +1875,17 @@ subroutine integrateStateAdaptiveEuler() !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure elemental function converged(residuum,state,aTol) + logical pure function converged(residuum,state,aTol) use prec, only: & dEq0 use numerics, only: & rTol => rTol_crystalliteState implicit none - real(pReal), intent(in) ::& + real(pReal), intent(in), dimension(:) ::& residuum, state, aTol - if (dEq0(state)) then - converged = .true. ! ToDo: intended behavior? Not rely on absoluteTolerance - else - converged = abs(residuum) < aTol & - .or. abs(residuum/state) < rTol - endif + converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) end function converged @@ -2111,17 +2119,17 @@ subroutine integrateStateRKCK45() sizeDotState = plasticState(p)%sizeDotState - crystallite_todo(g,i,e) = all(converged(residuum_plastic(1:sizeDotState,g,i,e), & + crystallite_todo(g,i,e) = converged(residuum_plastic(1:sizeDotState,g,i,e), & plasticState(p)%state(1:sizeDotState,cc), & - plasticState(p)%aTolState(1:sizeDotState))) + plasticState(p)%aTolState(1:sizeDotState)) do s = 1_pInt, phase_Nsources(p) sizeDotState = sourceState(p)%p(s)%sizeDotState crystallite_todo(g,i,e) = crystallite_todo(g,i,e) .and.& - all(converged(residuum_source(1:sizeDotState,s,g,i,e), & + converged(residuum_source(1:sizeDotState,s,g,i,e), & sourceState(p)%p(s)%state(1:sizeDotState,cc), & - sourceState(p)%p(s)%aTolState(1:sizeDotState))) + sourceState(p)%p(s)%aTolState(1:sizeDotState)) enddo endif enddo; enddo; enddo @@ -2138,22 +2146,17 @@ subroutine integrateStateRKCK45() !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- - logical pure elemental function converged(residuum,state,aTol) + logical pure function converged(residuum,state,aTol) use prec, only: & dEq0 use numerics, only: & rTol => rTol_crystalliteState implicit none - real(pReal), intent(in) ::& + real(pReal), intent(in), dimension(:) ::& residuum, state, aTol - if (dEq0(state)) then - converged = .true. ! ToDo: intended behavior? Not rely on absoluteTolerance - else - converged = abs(residuum) < aTol & - .or. abs(residuum/state) < rTol - endif + converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) end function converged From aabd98bee9fe4d0a8eaec49bc545ebfe6f073b91 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 09:14:02 +0100 Subject: [PATCH 107/107] no need to repeat the same code --- src/crystallite.f90 | 73 +++++++++++---------------------------------- 1 file changed, 18 insertions(+), 55 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index f9ceab03c..45aca46d1 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1725,23 +1725,6 @@ subroutine integrateStateFPI() endif end function damper - - !-------------------------------------------------------------------------------------------------- - !> @brief determines whether a point is converged - !-------------------------------------------------------------------------------------------------- - logical pure function converged(residuum,state,aTol) - use prec, only: & - dEq0 - use numerics, only: & - rTol => rTol_crystalliteState - - implicit none - real(pReal), intent(in), dimension(:) ::& - residuum, state, aTol - - converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) - - end function converged end subroutine integrateStateFPI @@ -1870,25 +1853,6 @@ subroutine integrateStateAdaptiveEuler() if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief determines whether a point is converged - !-------------------------------------------------------------------------------------------------- - logical pure function converged(residuum,state,aTol) - use prec, only: & - dEq0 - use numerics, only: & - rTol => rTol_crystalliteState - - implicit none - real(pReal), intent(in), dimension(:) ::& - residuum, state, aTol - - converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) - - end function converged - end subroutine integrateStateAdaptiveEuler @@ -2141,25 +2105,6 @@ subroutine integrateStateRKCK45() call setConvergenceFlag if (any(plasticState(:)%nonlocal)) call nonlocalConvergenceCheck - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief determines whether a point is converged - !-------------------------------------------------------------------------------------------------- - logical pure function converged(residuum,state,aTol) - use prec, only: & - dEq0 - use numerics, only: & - rTol => rTol_crystalliteState - - implicit none - real(pReal), intent(in), dimension(:) ::& - residuum, state, aTol - - converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) - - end function converged - end subroutine integrateStateRKCK45 @@ -2201,6 +2146,24 @@ subroutine setConvergenceFlag() end subroutine setConvergenceFlag + !-------------------------------------------------------------------------------------------------- + !> @brief determines whether a point is converged + !-------------------------------------------------------------------------------------------------- + logical pure function converged(residuum,state,aTol) + use prec, only: & + dEq0 + use numerics, only: & + rTol => rTol_crystalliteState + + implicit none + real(pReal), intent(in), dimension(:) ::& + residuum, state, aTol + + converged = all(abs(residuum) <= max(aTol, rTol*abs(state))) + + end function converged + + !-------------------------------------------------------------------------------------------------- !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !--------------------------------------------------------------------------------------------------