From 49ae38d0f9a56598e142765c9a022a855490ab5b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 25 Aug 2018 11:03:43 +0200 Subject: [PATCH 01/50] 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 02/50] 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 03/50] 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 04/50] 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 05/50] 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 06/50] 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 07/50] 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 08/50] 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 09/50] 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 10/50] 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 11/50] 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 12/50] 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 13/50] 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 14/50] 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 15/50] 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 16/50] 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 17/50] 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 18/50] 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 19/50] 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 20/50] 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 21/50] 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 22/50] 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 23/50] 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 24/50] 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 25/50] 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 26/50] 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 27/50] 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 28/50] 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 29/50] 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 30/50] 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 31/50] 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 32/50] 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 33/50] 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 34/50] 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 35/50] 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 36/50] 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 37/50] 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 38/50] 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 39/50] 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 40/50] 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 41/50] 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 42/50] 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 43/50] 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 44/50] 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 45/50] 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 46/50] 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 47/50] 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 48/50] 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 49/50] 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 50/50] 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