From 47e0d83562810d8333f1b8dd9e147755a382ebaf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 13 Jun 2019 22:24:51 +0200 Subject: [PATCH 01/49] taking care of compiler hints --- src/element.f90 | 78 +++--- src/results.f90 | 3 +- src/source_damage_anisoDuctile.f90 | 405 +++++++++++++++-------------- 3 files changed, 244 insertions(+), 242 deletions(-) diff --git a/src/element.f90 b/src/element.f90 index 208f6e718..dca5cbd28 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -386,15 +386,15 @@ module element - real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = & - reshape(real([& + integer, dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = & + reshape([& 1, 0, 0, & 0, 1, 0, & 0, 0, 1 & - ],pReal),[nNode(1),NcellNode(geomType(1))]) ! 2D 3node 1ip + ],[nNode(1),NcellNode(geomType(1))]) !< 2D 3node 1ip - real(pReal), dimension(nNode(2),NcellNode(geomType(2))), parameter :: cellNodeParentNodeWeights2 = & - reshape(real([& + integer, dimension(nNode(2),NcellNode(geomType(2))), parameter :: cellNodeParentNodeWeights2 = & + reshape([& 1, 0, 0, 0, 0, 0, & 0, 1, 0, 0, 0, 0, & 0, 0, 1, 0, 0, 0, & @@ -402,10 +402,10 @@ module element 0, 0, 0, 0, 1, 0, & 0, 0, 0, 0, 0, 1, & 1, 1, 1, 2, 2, 2 & - ],pReal),[nNode(2),NcellNode(geomType(2))]) ! 2D 6node 3ip + ],[nNode(2),NcellNode(geomType(2))]) !< 2D 6node 3ip - real(pReal), dimension(nNode(3),NcellNode(geomType(3))), parameter :: cellNodeParentNodeWeights3 = & - reshape(real([& + integer, dimension(nNode(3),NcellNode(geomType(3))), parameter :: cellNodeParentNodeWeights3 = & + reshape([& 1, 0, 0, 0, & 0, 1, 0, 0, & 0, 0, 1, 0, & @@ -415,10 +415,10 @@ module element 0, 0, 1, 1, & 1, 0, 0, 1, & 1, 1, 1, 1 & - ],pReal),[nNode(3),NcellNode(geomType(3))]) ! 2D 6node 3ip + ],[nNode(3),NcellNode(geomType(3))]) !< 2D 6node 3ip - real(pReal), dimension(nNode(4),NcellNode(geomType(4))), parameter :: cellNodeParentNodeWeights4 = & - reshape(real([& + integer, dimension(nNode(4),NcellNode(geomType(4))), parameter :: cellNodeParentNodeWeights4 = & + reshape([& 1, 0, 0, 0, 0, 0, 0, 0, & 0, 1, 0, 0, 0, 0, 0, 0, & 0, 0, 1, 0, 0, 0, 0, 0, & @@ -435,10 +435,10 @@ module element 1, 4, 1, 1, 8, 8, 2, 2, & 1, 1, 4, 1, 2, 8, 8, 2, & 1, 1, 1, 4, 2, 2, 8, 8 & - ],pReal),[nNode(4),NcellNode(geomType(4))]) ! 2D 8node 9ip + ],[nNode(4),NcellNode(geomType(4))]) !< 2D 8node 9ip - real(pReal), dimension(nNode(5),NcellNode(geomType(5))), parameter :: cellNodeParentNodeWeights5 = & - reshape(real([& + integer, dimension(nNode(5),NcellNode(geomType(5))), parameter :: cellNodeParentNodeWeights5 = & + reshape([& 1, 0, 0, 0, 0, 0, 0, 0, & 0, 1, 0, 0, 0, 0, 0, 0, & 0, 0, 1, 0, 0, 0, 0, 0, & @@ -448,18 +448,18 @@ module element 0, 0, 0, 0, 0, 0, 1, 0, & 0, 0, 0, 0, 0, 0, 0, 1, & 1, 1, 1, 1, 2, 2, 2, 2 & - ],pReal),[nNode(5),NcellNode(geomType(5))]) ! 2D 8node 4ip + ],[nNode(5),NcellNode(geomType(5))]) !< 2D 8node 4ip - real(pReal), dimension(nNode(6),NcellNode(geomType(6))), parameter :: cellNodeParentNodeWeights6 = & - reshape(real([& + integer, dimension(nNode(6),NcellNode(geomType(6))), parameter :: cellNodeParentNodeWeights6 = & + reshape([& 1, 0, 0, 0, & 0, 1, 0, 0, & 0, 0, 1, 0, & 0, 0, 0, 1 & - ],pReal),[nNode(6),NcellNode(geomType(6))]) ! 3D 4node 1ip + ],[nNode(6),NcellNode(geomType(6))]) !< 3D 4node 1ip - real(pReal), dimension(nNode(7),NcellNode(geomType(7))), parameter :: cellNodeParentNodeWeights7 = & - reshape(real([& + integer, dimension(nNode(7),NcellNode(geomType(7))), parameter :: cellNodeParentNodeWeights7 = & + reshape([& 1, 0, 0, 0, 0, & 0, 1, 0, 0, 0, & 0, 0, 1, 0, 0, & @@ -475,10 +475,10 @@ module element 0, 1, 1, 1, 0, & 1, 0, 1, 1, 0, & 0, 0, 0, 0, 1 & - ],pReal),[nNode(7),NcellNode(geomType(7))]) ! 3D 5node 4ip + ],[nNode(7),NcellNode(geomType(7))]) !< 3D 5node 4ip - real(pReal), dimension(nNode(8),NcellNode(geomType(8))), parameter :: cellNodeParentNodeWeights8 = & - reshape(real([& + integer, dimension(nNode(8),NcellNode(geomType(8))), parameter :: cellNodeParentNodeWeights8 = & + reshape([& 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & @@ -494,10 +494,10 @@ module element 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & - ],pReal),[nNode(8),NcellNode(geomType(8))]) ! 3D 10node 4ip + ],[nNode(8),NcellNode(geomType(8))]) !< 3D 10node 4ip - real(pReal), dimension(nNode(9),NcellNode(geomType(9))), parameter :: cellNodeParentNodeWeights9 = & - reshape(real([& + integer, dimension(nNode(9),NcellNode(geomType(9))), parameter :: cellNodeParentNodeWeights9 = & + reshape([& 1, 0, 0, 0, 0, 0, & 0, 1, 0, 0, 0, 0, & 0, 0, 1, 0, 0, 0, & @@ -519,10 +519,10 @@ module element 1, 0, 1, 1, 0, 1, & 0, 0, 0, 1, 1, 1, & 1, 1, 1, 1, 1, 1 & - ],pReal),[nNode(9),NcellNode(geomType(9))]) ! 3D 6node 6ip + ],[nNode(9),NcellNode(geomType(9))]) !< 3D 6node 6ip - real(pReal), dimension(nNode(10),NcellNode(geomType(10))), parameter :: cellNodeParentNodeWeights10 = & - reshape(real([& + integer, dimension(nNode(10),NcellNode(geomType(10))), parameter :: cellNodeParentNodeWeights10 = & + reshape([& 1, 0, 0, 0, 0, 0, 0, 0, & 0, 1, 0, 0, 0, 0, 0, 0, & 0, 0, 1, 0, 0, 0, 0, 0, & @@ -531,10 +531,10 @@ module element 0, 0, 0, 0, 0, 1, 0, 0, & 0, 0, 0, 0, 0, 0, 1, 0, & 0, 0, 0, 0, 0, 0, 0, 1 & - ],pReal),[nNode(10),NcellNode(geomType(10))]) ! 3D 8node 1ip + ],[nNode(10),NcellNode(geomType(10))]) !< 3D 8node 1ip - real(pReal), dimension(nNode(11),NcellNode(geomType(11))), parameter :: cellNodeParentNodeWeights11 = & - reshape(real([& + integer, dimension(nNode(11),NcellNode(geomType(11))), parameter :: cellNodeParentNodeWeights11 = & + reshape([& 1, 0, 0, 0, 0, 0, 0, 0, & ! 0, 1, 0, 0, 0, 0, 0, 0, & ! 0, 0, 1, 0, 0, 0, 0, 0, & ! @@ -562,10 +562,10 @@ module element 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 0, 0, 0, 0, 1, 1, 1, 1, & ! 1, 1, 1, 1, 1, 1, 1, 1 & ! - ],pReal),[nNode(11),NcellNode(geomType(11))]) ! 3D 8node 8ip + ],[nNode(11),NcellNode(geomType(11))]) !< 3D 8node 8ip - real(pReal), dimension(nNode(12),NcellNode(geomType(12))), parameter :: cellNodeParentNodeWeights12 = & - reshape(real([& + integer, dimension(nNode(12),NcellNode(geomType(12))), parameter :: cellNodeParentNodeWeights12 = & + reshape([& 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! @@ -593,10 +593,10 @@ module element 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! - ],pReal),[nNode(12),NcellNode(geomType(12))]) ! 3D 20node 8ip + ],[nNode(12),NcellNode(geomType(12))]) !< 3D 20node 8ip - real(pReal), dimension(nNode(13),NcellNode(geomType(13))), parameter :: cellNodeParentNodeWeights13 = & - reshape(real([& + integer, dimension(nNode(13),NcellNode(geomType(13))), parameter :: cellNodeParentNodeWeights13 = & + reshape([& 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! @@ -661,7 +661,7 @@ module element 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! - ],pReal),[nNode(13),NcellNode(geomType(13))]) ! 3D 20node 27ip + ],[nNode(13),NcellNode(geomType(13))]) !< 3D 20node 27ip integer, dimension(NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)), parameter :: CELL1 = & diff --git a/src/results.f90 b/src/results.f90 index 0b9bec9f1..0304fd30b 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -17,8 +17,7 @@ module results private #if defined(PETSc) || defined(DAMASK_HDF5) - integer(HID_T), public, protected :: tempCoordinates, tempResults - integer(HID_T), private :: resultsFile, currentIncID, plist_id + integer(HID_T) :: resultsFile interface results_writeDataset diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index a4b4561e1..aa8c9b8fa 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -5,55 +5,55 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_damage_anisoDuctile - use prec - use debug - use IO - use math - use material - use config - - implicit none - private - - integer, dimension(:), allocatable, public, protected :: & - source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism? - source_damage_anisoDuctile_instance !< instance of damage source mechanism - - integer, dimension(:,:), allocatable, target, public :: & - source_damage_anisoDuctile_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - source_damage_anisoDuctile_output !< name of each post result output + use prec + use debug + use IO + use math + use material + use config + + implicit none + private - - enum, bind(c) - enumerator :: undefined_ID, & - damage_drivingforce_ID - end enum - - - type, private :: tParameters !< container type for internal constitutive parameters - real(pReal) :: & - aTol, & - N - real(pReal), dimension(:), allocatable :: & - critPlasticStrain - integer :: & - totalNslip - integer, dimension(:), allocatable :: & - Nslip - integer(kind(undefined_ID)), allocatable, dimension(:) :: & - outputID - end type tParameters - - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) - - - public :: & - source_damage_anisoDuctile_init, & - source_damage_anisoDuctile_dotState, & - source_damage_anisoDuctile_getRateAndItsTangent, & - source_damage_anisoDuctile_postResults + integer, dimension(:), allocatable, public, protected :: & + source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism? + source_damage_anisoDuctile_instance !< instance of damage source mechanism + + integer, dimension(:,:), allocatable, target, public :: & + source_damage_anisoDuctile_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + source_damage_anisoDuctile_output !< name of each post result output + + + enum, bind(c) + enumerator :: undefined_ID, & + damage_drivingforce_ID + end enum + + + type, private :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + aTol, & + N + real(pReal), dimension(:), allocatable :: & + critPlasticStrain + integer :: & + totalNslip + integer, dimension(:), allocatable :: & + Nslip + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID + end type tParameters + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + + + public :: & + source_damage_anisoDuctile_init, & + source_damage_anisoDuctile_dotState, & + source_damage_anisoDuctile_getRateAndItsTangent, & + source_damage_anisoDuctile_postResults contains @@ -64,193 +64,196 @@ contains !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoDuctile_init - integer :: Ninstance,phase,instance,source,sourceOffset - integer :: NofMyPhase,p ,i - - integer, dimension(0), parameter :: emptyIntArray = [integer::] - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - integer(kind(undefined_ID)) :: & - outputID - - character(len=pStringLen) :: & - extmsg = '' - character(len=65536), dimension(:), allocatable :: & - outputs - - write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>' - - Ninstance = count(phase_source == SOURCE_damage_anisoDuctile_ID) - if (Ninstance == 0) return + integer :: Ninstance,phase,instance,source,sourceOffset + integer :: NofMyPhase,p ,i - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + integer, dimension(0), parameter :: emptyIntArray = [integer::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID - allocate(source_damage_anisoDuctile_offset(size(config_phase)), source=0) - allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0) - do phase = 1, size(config_phase) - source_damage_anisoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoDuctile_ID) - do source = 1, phase_Nsources(phase) - if (phase_source(source,phase) == source_damage_anisoDuctile_ID) & - source_damage_anisoDuctile_offset(phase) = source - enddo - enddo - - allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0) - allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance)) - source_damage_anisoDuctile_output = '' - - - allocate(param(Ninstance)) + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs - do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISODUCTILE_ID)) cycle - associate(prm => param(source_damage_anisoDuctile_instance(p)), & - config => config_phase(p)) - - prm%aTol = config%getFloat('anisoductile_atol',defaultVal = 1.0e-3_pReal) - - prm%N = config%getFloat('anisoductile_ratesensitivity') - prm%totalNslip = sum(prm%Nslip) - ! sanity checks - if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_atol' - - if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_ratesensitivity' - - prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) - - prm%critPlasticStrain = config%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(prm%Nslip)) - - ! expand: family => system - prm%critPlasticStrain = math_expand(prm%critPlasticStrain, prm%Nslip) - - if (any(prm%critPlasticStrain < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_criticalplasticstrain' + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>' + + Ninstance = count(phase_source == SOURCE_damage_anisoDuctile_ID) + if (Ninstance == 0) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + + allocate(source_damage_anisoDuctile_offset(size(config_phase)), source=0) + allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0) + do phase = 1, size(config_phase) + source_damage_anisoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoDuctile_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == source_damage_anisoDuctile_ID) & + source_damage_anisoDuctile_offset(phase) = source + enddo + enddo + + allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0) + allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance)) + source_damage_anisoDuctile_output = '' + + + allocate(param(Ninstance)) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISODUCTILE_ID)) cycle + associate(prm => param(source_damage_anisoDuctile_instance(p)), & + config => config_phase(p)) + + prm%aTol = config%getFloat('anisoductile_atol',defaultVal = 1.0e-3_pReal) + + prm%N = config%getFloat('anisoductile_ratesensitivity') + prm%totalNslip = sum(prm%Nslip) + ! sanity checks + if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_atol' + + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_ratesensitivity' + + prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) + + prm%critPlasticStrain = config%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(prm%Nslip)) + + ! expand: family => system + prm%critPlasticStrain = math_expand(prm%critPlasticStrain, prm%Nslip) + + if (any(prm%critPlasticStrain < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_criticalplasticstrain' !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') & - call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')') !-------------------------------------------------------------------------------------------------- ! output pararameters - outputs = config%getStrings('(output)',defaultVal=emptyStringArray) - allocate(prm%outputID(0)) - do i=1, size(outputs) - outputID = undefined_ID - select case(outputs(i)) - - case ('anisoductile_drivingforce') - source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1 - source_damage_anisoDuctile_output(i,source_damage_anisoDuctile_instance(p)) = outputs(i) - prm%outputID = [prm%outputID, damage_drivingforce_ID] - - end select - - enddo - - end associate - - phase = p - - NofMyPhase=count(material_phase==phase) - instance = source_damage_anisoDuctile_instance(phase) - sourceOffset = source_damage_anisoDuctile_offset(phase) - - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) - sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance)) - sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - - enddo + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + + case ('anisoductile_drivingforce') + source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1 + source_damage_anisoDuctile_output(i,source_damage_anisoDuctile_instance(p)) = outputs(i) + prm%outputID = [prm%outputID, damage_drivingforce_ID] + + end select + + enddo + + end associate + + phase = p + + NofMyPhase=count(material_phase==phase) + instance = source_damage_anisoDuctile_instance(phase) + sourceOffset = source_damage_anisoDuctile_offset(phase) + + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) + sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance)) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + + enddo end subroutine source_damage_anisoDuctile_init + !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - integer :: & - phase, & - constituent, & - sourceOffset, & - homog, damageOffset, & - instance, & - f, i - - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) - instance = source_damage_anisoDuctile_instance(phase) - sourceOffset = source_damage_anisoDuctile_offset(phase) - homog = material_homogenizationAt(el) - damageOffset = damageMapping(homog)%p(ip,el) - - - do i = 1, param(instance)%totalNslip - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & - plasticState(phase)%slipRate(i,constituent)/ & - ((damage(homog)%p(damageOffset))**param(instance)%N)/param(instance)%critPlasticStrain(i) - enddo + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + integer :: & + phase, & + constituent, & + sourceOffset, & + homog, damageOffset, & + instance, & + i + + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_damage_anisoDuctile_instance(phase) + sourceOffset = source_damage_anisoDuctile_offset(phase) + homog = material_homogenizationAt(el) + damageOffset = damageMapping(homog)%p(ip,el) + + + do i = 1, param(instance)%totalNslip + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & + plasticState(phase)%slipRate(i,constituent)/ & + ((damage(homog)%p(damageOffset))**param(instance)%N)/param(instance)%critPlasticStrain(i) + enddo end subroutine source_damage_anisoDuctile_dotState + !-------------------------------------------------------------------------------------------------- !> @brief returns local part of nonlocal damage driving force !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - integer, intent(in) :: & - phase, & - constituent - real(pReal), intent(in) :: & - phi - real(pReal), intent(out) :: & - localphiDot, & - dLocalphiDot_dPhi - integer :: & - sourceOffset - - sourceOffset = source_damage_anisoDuctile_offset(phase) + integer, intent(in) :: & + phase, & + constituent + real(pReal), intent(in) :: & + phi + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + integer :: & + sourceOffset - localphiDot = 1.0_pReal & - - sourceState(phase)%p(sourceOffset)%state(1,constituent) * phi - - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + sourceOffset = source_damage_anisoDuctile_offset(phase) + + localphiDot = 1.0_pReal & + - sourceState(phase)%p(sourceOffset)%state(1,constituent) * phi + + dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) end subroutine source_damage_anisoDuctile_getRateAndItsTangent - + + !-------------------------------------------------------------------------------------------------- !> @brief return array of local damage results !-------------------------------------------------------------------------------------------------- function source_damage_anisoDuctile_postResults(phase, constituent) - integer, intent(in) :: & - phase, & - constituent - real(pReal), dimension(sum(source_damage_anisoDuctile_sizePostResult(:, & - source_damage_anisoDuctile_instance(phase)))) :: & - source_damage_anisoDuctile_postResults + integer, intent(in) :: & + phase, & + constituent + real(pReal), dimension(sum(source_damage_anisoDuctile_sizePostResult(:, & + source_damage_anisoDuctile_instance(phase)))) :: & + source_damage_anisoDuctile_postResults + + integer :: & + instance, sourceOffset, o, c + + instance = source_damage_anisoDuctile_instance(phase) + sourceOffset = source_damage_anisoDuctile_offset(phase) + + c = 0 + + do o = 1,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) + case (damage_drivingforce_ID) + source_damage_anisoDuctile_postResults(c+1) = & + sourceState(phase)%p(sourceOffset)%state(1,constituent) + c = c + 1 + + end select + enddo - integer :: & - instance, sourceOffset, o, c - - instance = source_damage_anisoDuctile_instance(phase) - sourceOffset = source_damage_anisoDuctile_offset(phase) - - c = 0 - - do o = 1,size(param(instance)%outputID) - select case(param(instance)%outputID(o)) - case (damage_drivingforce_ID) - source_damage_anisoDuctile_postResults(c+1) = & - sourceState(phase)%p(sourceOffset)%state(1,constituent) - c = c + 1 - - end select - enddo end function source_damage_anisoDuctile_postResults end module source_damage_anisoDuctile From 4ff3efb1a56b45ff73bca70cdd8fd92a87f6299f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 13 Jun 2019 23:14:40 +0200 Subject: [PATCH 02/49] to 'stack' tables --- processing/post/addTable.py | 8 +-- processing/post/concatenateTable.py | 79 +++++++++++++++++++++++++++++ 2 files changed, 84 insertions(+), 3 deletions(-) create mode 100755 processing/post/concatenateTable.py diff --git a/processing/post/addTable.py b/processing/post/addTable.py index eb61b43dc..7af1dcf35 100755 --- a/processing/post/addTable.py +++ b/processing/post/addTable.py @@ -1,19 +1,21 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys +import os +import sys from optparse import OptionParser + import damask scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ -Append data of ASCIItable(s). +Append data of ASCIItable(s) column-wise. """, version = scriptID) diff --git a/processing/post/concatenateTable.py b/processing/post/concatenateTable.py new file mode 100755 index 000000000..361ea5764 --- /dev/null +++ b/processing/post/concatenateTable.py @@ -0,0 +1,79 @@ +#!/usr/bin/env python3 + +import os +import sys +from optparse import OptionParser + +import numpy as np + +import damask + +scriptName = os.path.splitext(os.path.basename(__file__))[0] +scriptID = ' '.join([scriptName,damask.version]) + + +# -------------------------------------------------------------------- +# MAIN +# -------------------------------------------------------------------- + +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [ASCIItable(s)]', description = """ +Append data of ASCIItable(s) row-wise. + +""", version = scriptID) + +parser.add_option('-a', '--add','--table', + dest = 'table', + action = 'extend', metavar = '', + help = 'tables to add') + +(options,filenames) = parser.parse_args() + +if options.table is None: + parser.error('no table specified.') + + +# --- loop over input files ------------------------------------------------------------------------- + +if filenames == []: filenames = [None] + +for name in filenames: + try: table = damask.ASCIItable(name = name, + buffered = False) + except: continue + + damask.util.report(scriptName,name) + + tables = [] + for addTable in options.table: + try: tables.append(damask.ASCIItable(name = addTable, + buffered = False, + readonly = True) + ) + except: continue + +# ------------------------------------------ read headers ------------------------------------------ + + table.head_read() + for addTable in tables: addTable.head_read() + +# ------------------------------------------ assemble header -------------------------------------- + + table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) + + table.head_write() + +# ------------------------------------------ process data ------------------------------------------ + + table.data_readArray() + data = table.data + for addTable in tables: + addTable.data_readArray(table.labels(raw = True)) + data = np.vstack((data,addTable.data)) + table.data = data + table.data_writeArray() + +# ------------------------------------------ output finalization ----------------------------------- + + table.close() # close ASCII tables + for addTable in tables: + addTable.close() From 84c69e0f6e3ce62d71c9bdc63a8e0f014edf0962 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 13 Jun 2019 23:23:11 +0200 Subject: [PATCH 03/49] output names follow variable names --- src/plastic_dislotwin.f90 | 27 +++++++++------------------ 1 file changed, 9 insertions(+), 18 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 4d84b503e..f118b1dca 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -452,42 +452,33 @@ subroutine plastic_dislotwin_init do i= 1, size(outputs) outputID = undefined_ID select case(outputs(i)) - case ('edge_density') + case ('rho_mob') outputID = merge(rho_mob_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl - case ('dipole_density') + case ('rho_dip') outputID = merge(rho_dip_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl - case ('shear_rate_slip','shearrate_slip') - outputID = merge(dot_gamma_sl_ID,undefined_ID,prm%sum_N_sl > 0) - outputSize = prm%sum_N_sl - case ('accumulated_shear_slip') + case ('gamma_sl') outputID = merge(gamma_sl_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl - case ('mfp_slip') + case ('Lambda_sl') outputID = merge(Lambda_sl_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl - case ('resolved_stress_slip') - outputID = merge(resolved_stress_slip_ID,undefined_ID,prm%sum_N_sl > 0) - outputSize = prm%sum_N_sl - case ('threshold_stress_slip') + case ('tau_pass') outputID= merge(threshold_stress_slip_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl - case ('twin_fraction') + case ('f_tw') outputID = merge(f_tw_ID,undefined_ID,prm%sum_N_tw >0) outputSize = prm%sum_N_tw - case ('mfp_twin') + case ('Lambda_tw') outputID = merge(Lambda_tw_ID,undefined_ID,prm%sum_N_tw >0) outputSize = prm%sum_N_tw - case ('resolved_stress_twin') - outputID = merge(resolved_stress_twin_ID,undefined_ID,prm%sum_N_tw >0) - outputSize = prm%sum_N_tw - case ('threshold_stress_twin') + case ('tau_hat_tw') outputID = merge(tau_hat_tw_ID,undefined_ID,prm%sum_N_tw >0) outputSize = prm%sum_N_tw - case ('strain_trans_fraction') + case ('f_tr') outputID = f_tr_ID outputSize = prm%sum_N_tr From 0f531d5dee5eae151c4dc979d9c1cb17c2983c52 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 08:42:12 +0200 Subject: [PATCH 04/49] clearer name --- src/crystallite.f90 | 48 ++++++++++++++++++++++----------------------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 98070f0fa..3f07c852f 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -483,12 +483,12 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1,homogenization_Ngrains(material_homogenizationAt(e)) homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then - plasticState (phaseAt(c,i,e))%subState0( :,phasememberAt(c,i,e)) = & - plasticState (phaseAt(c,i,e))%partionedState0(:,phasememberAt(c,i,e)) + plasticState (phaseAt(c,i,e))%subState0( :,material_phaseMemberAt(c,i,e)) = & + plasticState (phaseAt(c,i,e))%partionedState0(:,material_phaseMemberAt(c,i,e)) do s = 1, phase_Nsources(phaseAt(c,i,e)) - sourceState(phaseAt(c,i,e))%p(s)%subState0( :,phasememberAt(c,i,e)) = & - sourceState(phaseAt(c,i,e))%p(s)%partionedState0(:,phasememberAt(c,i,e)) + sourceState(phaseAt(c,i,e))%p(s)%subState0( :,material_phaseMemberAt(c,i,e)) = & + sourceState(phaseAt(c,i,e))%p(s)%partionedState0(:,material_phaseMemberAt(c,i,e)) enddo crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_partionedFp0(1:3,1:3,c,i,e) crystallite_subLp0(1:3,1:3,c,i,e) = crystallite_partionedLp0(1:3,1:3,c,i,e) @@ -543,11 +543,11 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_Fi (1:3,1:3,c,i,e) crystallite_subS0 (1:3,1:3,c,i,e) = crystallite_S (1:3,1:3,c,i,e) !if abbrevation, make c and p private in omp - plasticState( phaseAt(c,i,e))%subState0(:,phasememberAt(c,i,e)) & - = plasticState(phaseAt(c,i,e))%state( :,phasememberAt(c,i,e)) + plasticState( phaseAt(c,i,e))%subState0(:,material_phaseMemberAt(c,i,e)) & + = plasticState(phaseAt(c,i,e))%state( :,material_phaseMemberAt(c,i,e)) do s = 1, phase_Nsources(phaseAt(c,i,e)) - sourceState( phaseAt(c,i,e))%p(s)%subState0(:,phasememberAt(c,i,e)) & - = sourceState(phaseAt(c,i,e))%p(s)%state( :,phasememberAt(c,i,e)) + sourceState( phaseAt(c,i,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) & + = sourceState(phaseAt(c,i,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) enddo #ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0 & @@ -572,11 +572,11 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) crystallite_Lp (1:3,1:3,c,i,e) = crystallite_subLp0(1:3,1:3,c,i,e) crystallite_Li (1:3,1:3,c,i,e) = crystallite_subLi0(1:3,1:3,c,i,e) endif - plasticState (phaseAt(c,i,e))%state( :,phasememberAt(c,i,e)) & - = plasticState(phaseAt(c,i,e))%subState0(:,phasememberAt(c,i,e)) + plasticState (phaseAt(c,i,e))%state( :,material_phaseMemberAt(c,i,e)) & + = plasticState(phaseAt(c,i,e))%subState0(:,material_phaseMemberAt(c,i,e)) do s = 1, phase_Nsources(phaseAt(c,i,e)) - sourceState( phaseAt(c,i,e))%p(s)%state( :,phasememberAt(c,i,e)) & - = sourceState(phaseAt(c,i,e))%p(s)%subState0(:,phasememberAt(c,i,e)) + sourceState( phaseAt(c,i,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) & + = sourceState(phaseAt(c,i,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) enddo ! cant restore dotState here, since not yet calculated in first cutback after initialization @@ -1555,7 +1555,7 @@ subroutine integrateStateFPI do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) plasticState(p)%previousDotState2(:,c) = merge(plasticState(p)%previousDotState(:,c),& 0.0_pReal,& @@ -1583,7 +1583,7 @@ subroutine integrateStateFPI do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState zeta = damper(plasticState(p)%dotState (:,c), & @@ -1746,7 +1746,7 @@ subroutine integrateStateAdaptiveEuler do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState residuum_plastic(1:sizeDotState,g,i,e) = plasticState(p)%dotstate(1:sizeDotState,c) & @@ -1775,7 +1775,7 @@ subroutine integrateStateAdaptiveEuler do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & @@ -1835,7 +1835,7 @@ subroutine integrateStateRK4 do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) plasticState(p)%RK4dotState(:,c) = WEIGHT(n)*plasticState(p)%dotState(:,c) & + merge(plasticState(p)%RK4dotState(:,c),0.0_pReal,n>1) @@ -1926,7 +1926,7 @@ subroutine integrateStateRKCK45 do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) + p = phaseAt(g,i,e); cc = material_phaseMemberAt(g,i,e) plasticState(p)%RKCK45dotState(stage,:,cc) = plasticState(p)%dotState(:,cc) plasticState(p)%dotState(:,cc) = A(1,stage) * plasticState(p)%RKCK45dotState(1,:,cc) @@ -1966,7 +1966,7 @@ subroutine integrateStateRKCK45 do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) + p = phaseAt(g,i,e); cc = material_phaseMemberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState @@ -2005,7 +2005,7 @@ subroutine integrateStateRKCK45 do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) + p = phaseAt(g,i,e); cc = material_phaseMemberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState @@ -2163,7 +2163,7 @@ subroutine update_state(timeFraction) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) mySize = plasticState(p)%sizeDotState plasticState(p)%state(1:mySize,c) = plasticState(p)%subState0(1:mySize,c) & @@ -2214,7 +2214,7 @@ subroutine update_dotState(timeFraction) crystallite_Fi(1:3,1:3,g,i,e), & crystallite_Fp, & crystallite_subdt(g,i,e)*timeFraction, g,i,e) - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) NaN = any(IEEE_is_NaN(plasticState(p)%dotState(:,c))) do s = 1, phase_Nsources(p) NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(s)%dotState(:,c))) @@ -2259,7 +2259,7 @@ subroutine update_deltaState crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fi(1:3,1:3,g,i,e), & g,i,e) - p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) myOffset = plasticState(p)%offsetDeltaState mySize = plasticState(p)%sizeDeltaState NaN = any(IEEE_is_NaN(plasticState(p)%deltaState(1:mySize,c))) @@ -2311,7 +2311,7 @@ logical function stateJump(ipc,ip,el) myOffset, & mySize - c = phasememberAt(ipc,ip,el) + c = material_phaseMemberAt(ipc,ip,el) p = phaseAt(ipc,ip,el) call constitutive_collectDeltaState(crystallite_S(1:3,1:3,ipc,ip,el), & From 7a76740c315407572b140af7dfd0176ab116c06f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 08:49:05 +0200 Subject: [PATCH 05/49] using new names --- src/crystallite.f90 | 68 ++++++++++++++++++++++----------------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 3f07c852f..e47eac4df 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -386,7 +386,7 @@ subroutine crystallite_init crystallite_Fp0(1:3,1:3,c,i,e) = math_EulerToR(material_EulerAngles(1:3,c,i,e)) ! plastic def gradient reflects init orientation crystallite_Fi0(1:3,1:3,c,i,e) = constitutive_initialFi(c,i,e) crystallite_F0(1:3,1:3,c,i,e) = math_I3 - crystallite_localPlasticity(c,i,e) = phase_localPlasticity(material_phase(c,i,e)) + crystallite_localPlasticity(c,i,e) = phase_localPlasticity(material_phaseAt(c,e)) crystallite_Fe(1:3,1:3,c,i,e) = math_inv33(matmul(crystallite_Fi0(1:3,1:3,c,i,e), & crystallite_Fp0(1:3,1:3,c,i,e))) ! assuming that euler angles are given in internal strain free configuration crystallite_Fp(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) @@ -483,12 +483,12 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1,homogenization_Ngrains(material_homogenizationAt(e)) homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then - plasticState (phaseAt(c,i,e))%subState0( :,material_phaseMemberAt(c,i,e)) = & - plasticState (phaseAt(c,i,e))%partionedState0(:,material_phaseMemberAt(c,i,e)) + plasticState (material_phaseAt(c,e))%subState0( :,material_phaseMemberAt(c,i,e)) = & + plasticState (material_phaseAt(c,e))%partionedState0(:,material_phaseMemberAt(c,i,e)) - do s = 1, phase_Nsources(phaseAt(c,i,e)) - sourceState(phaseAt(c,i,e))%p(s)%subState0( :,material_phaseMemberAt(c,i,e)) = & - sourceState(phaseAt(c,i,e))%p(s)%partionedState0(:,material_phaseMemberAt(c,i,e)) + do s = 1, phase_Nsources(material_phaseAt(c,e)) + sourceState(material_phaseAt(c,e))%p(s)%subState0( :,material_phaseMemberAt(c,i,e)) = & + sourceState(material_phaseAt(c,e))%p(s)%partionedState0(:,material_phaseMemberAt(c,i,e)) enddo crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_partionedFp0(1:3,1:3,c,i,e) crystallite_subLp0(1:3,1:3,c,i,e) = crystallite_partionedLp0(1:3,1:3,c,i,e) @@ -543,11 +543,11 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_Fi (1:3,1:3,c,i,e) crystallite_subS0 (1:3,1:3,c,i,e) = crystallite_S (1:3,1:3,c,i,e) !if abbrevation, make c and p private in omp - plasticState( phaseAt(c,i,e))%subState0(:,material_phaseMemberAt(c,i,e)) & - = plasticState(phaseAt(c,i,e))%state( :,material_phaseMemberAt(c,i,e)) - do s = 1, phase_Nsources(phaseAt(c,i,e)) - sourceState( phaseAt(c,i,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) & - = sourceState(phaseAt(c,i,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) + plasticState( material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) & + = plasticState(material_phaseAt(c,e))%state( :,material_phaseMemberAt(c,i,e)) + do s = 1, phase_Nsources(material_phaseAt(c,e)) + sourceState( material_phaseAt(c,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) & + = sourceState(material_phaseAt(c,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) enddo #ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0 & @@ -572,11 +572,11 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) crystallite_Lp (1:3,1:3,c,i,e) = crystallite_subLp0(1:3,1:3,c,i,e) crystallite_Li (1:3,1:3,c,i,e) = crystallite_subLi0(1:3,1:3,c,i,e) endif - plasticState (phaseAt(c,i,e))%state( :,material_phaseMemberAt(c,i,e)) & - = plasticState(phaseAt(c,i,e))%subState0(:,material_phaseMemberAt(c,i,e)) - do s = 1, phase_Nsources(phaseAt(c,i,e)) - sourceState( phaseAt(c,i,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) & - = sourceState(phaseAt(c,i,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) + plasticState (material_phaseAt(c,e))%state( :,material_phaseMemberAt(c,i,e)) & + = plasticState(material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) + do s = 1, phase_Nsources(material_phaseAt(c,e)) + sourceState( material_phaseAt(c,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) & + = sourceState(material_phaseAt(c,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) enddo ! cant restore dotState here, since not yet calculated in first cutback after initialization @@ -839,7 +839,7 @@ subroutine crystallite_orientations !$OMP PARALLEL DO do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - if (plasticState(material_phase(1,i,e))%nonLocal) & ! if nonlocal model + if (plasticState(material_phaseAt(1,e))%nonLocal) & ! if nonlocal model call plastic_nonlocal_updateCompatibility(crystallite_orientation,i,e) enddo; enddo !$OMP END PARALLEL DO @@ -879,8 +879,8 @@ function crystallite_postResults(ipc, ip, el) ipc !< grain index real(pReal), dimension(1+crystallite_sizePostResults(microstructure_crystallite(discretization_microstructureAt(el))) + & - 1+plasticState(material_phase(ipc,ip,el))%sizePostResults + & - sum(sourceState(material_phase(ipc,ip,el))%p(:)%sizePostResults)) :: & + 1+plasticState(material_phaseAt(ipc,el))%sizePostResults + & + sum(sourceState(material_phaseAt(ipc,el))%p(:)%sizePostResults)) :: & crystallite_postResults integer :: & o, & @@ -893,7 +893,7 @@ function crystallite_postResults(ipc, ip, el) crystID = microstructure_crystallite(discretization_microstructureAt(el)) crystallite_postResults = 0.0_pReal - crystallite_postResults(1) = real(crystallite_sizePostResults(crystID),pReal) ! header-like information (length) + crystallite_postResults(1) = real(crystallite_sizePostResults(crystID),pReal) ! header-like information (length) c = 1 do o = 1,crystallite_Noutput(crystID) @@ -901,7 +901,7 @@ function crystallite_postResults(ipc, ip, el) select case(crystallite_outputID(o,crystID)) case (phase_ID) mySize = 1 - crystallite_postResults(c+1) = real(material_phase(ipc,ip,el),pReal) ! phaseID of grain + crystallite_postResults(c+1) = real(material_phaseAt(ipc,el),pReal) ! phaseID of grain case (texture_ID) mySize = 1 crystallite_postResults(c+1) = real(material_texture(ipc,ip,el),pReal) ! textureID of grain @@ -967,7 +967,7 @@ function crystallite_postResults(ipc, ip, el) c = c + mySize enddo - crystallite_postResults(c+1) = real(plasticState(material_phase(ipc,ip,el))%sizePostResults,pReal) ! size of constitutive results + crystallite_postResults(c+1) = real(plasticState(material_phaseAt(ipc,el))%sizePostResults,pReal) ! size of constitutive results c = c + 1 if (size(crystallite_postResults)-c > 0) & crystallite_postResults(c+1:size(crystallite_postResults)) = & @@ -1555,7 +1555,7 @@ subroutine integrateStateFPI do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) + p = material_phaseAt(g,e); c = material_phaseMemberAt(g,i,e) plasticState(p)%previousDotState2(:,c) = merge(plasticState(p)%previousDotState(:,c),& 0.0_pReal,& @@ -1583,7 +1583,7 @@ subroutine integrateStateFPI do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) + p = material_phaseAt(g,e); c = material_phaseMemberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState zeta = damper(plasticState(p)%dotState (:,c), & @@ -1746,7 +1746,7 @@ subroutine integrateStateAdaptiveEuler do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) + p = material_phaseAt(g,e); c = material_phaseMemberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState residuum_plastic(1:sizeDotState,g,i,e) = plasticState(p)%dotstate(1:sizeDotState,c) & @@ -1775,7 +1775,7 @@ subroutine integrateStateAdaptiveEuler do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) + p = material_phaseAt(g,e); c = material_phaseMemberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState residuum_plastic(1:sizeDotState,g,i,e) = residuum_plastic(1:sizeDotState,g,i,e) & @@ -1835,7 +1835,7 @@ subroutine integrateStateRK4 do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) + p = material_phaseAt(g,e); c = material_phaseMemberAt(g,i,e) plasticState(p)%RK4dotState(:,c) = WEIGHT(n)*plasticState(p)%dotState(:,c) & + merge(plasticState(p)%RK4dotState(:,c),0.0_pReal,n>1) @@ -1926,7 +1926,7 @@ subroutine integrateStateRKCK45 do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); cc = material_phaseMemberAt(g,i,e) + p = material_phaseAt(g,e); cc = material_phaseMemberAt(g,i,e) plasticState(p)%RKCK45dotState(stage,:,cc) = plasticState(p)%dotState(:,cc) plasticState(p)%dotState(:,cc) = A(1,stage) * plasticState(p)%RKCK45dotState(1,:,cc) @@ -1966,7 +1966,7 @@ subroutine integrateStateRKCK45 do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); cc = material_phaseMemberAt(g,i,e) + p = material_phaseAt(g,e); cc = material_phaseMemberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState @@ -2005,7 +2005,7 @@ subroutine integrateStateRKCK45 do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e); cc = material_phaseMemberAt(g,i,e) + p = material_phaseAt(g,e); cc = material_phaseMemberAt(g,i,e) sizeDotState = plasticState(p)%sizeDotState @@ -2163,7 +2163,7 @@ subroutine update_state(timeFraction) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(material_homogenizationAt(e)) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) + p = material_phaseAt(g,e); c = material_phaseMemberAt(g,i,e) mySize = plasticState(p)%sizeDotState plasticState(p)%state(1:mySize,c) = plasticState(p)%subState0(1:mySize,c) & @@ -2214,7 +2214,7 @@ subroutine update_dotState(timeFraction) crystallite_Fi(1:3,1:3,g,i,e), & crystallite_Fp, & crystallite_subdt(g,i,e)*timeFraction, g,i,e) - p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) + p = material_phaseAt(g,e); c = material_phaseMemberAt(g,i,e) NaN = any(IEEE_is_NaN(plasticState(p)%dotState(:,c))) do s = 1, phase_Nsources(p) NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(s)%dotState(:,c))) @@ -2259,7 +2259,7 @@ subroutine update_deltaState crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fi(1:3,1:3,g,i,e), & g,i,e) - p = phaseAt(g,i,e); c = material_phaseMemberAt(g,i,e) + p = material_phaseAt(g,e); c = material_phaseMemberAt(g,i,e) myOffset = plasticState(p)%offsetDeltaState mySize = plasticState(p)%sizeDeltaState NaN = any(IEEE_is_NaN(plasticState(p)%deltaState(1:mySize,c))) @@ -2312,7 +2312,7 @@ logical function stateJump(ipc,ip,el) mySize c = material_phaseMemberAt(ipc,ip,el) - p = phaseAt(ipc,ip,el) + p = material_phaseAt(ipc,el) call constitutive_collectDeltaState(crystallite_S(1:3,1:3,ipc,ip,el), & crystallite_Fe(1:3,1:3,ipc,ip,el), & From 7a878cab3ad43baa965ac9f8f2fda12aaeb51559 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 09:02:28 +0200 Subject: [PATCH 06/49] phaseAt(c,i,e) substituted by material_phaseAt(c,e) --- src/CPFEM.f90 | 2 +- src/damage_local.f90 | 2 +- src/damage_nonlocal.f90 | 2 +- src/homogenization.f90 | 30 +++++++++++++++--------------- src/material.f90 | 3 --- src/plastic_nonlocal.f90 | 20 ++++++++++---------- src/source_damage_anisoBrittle.f90 | 2 +- src/source_damage_anisoDuctile.f90 | 2 +- src/source_damage_isoBrittle.f90 | 2 +- src/source_damage_isoDuctile.f90 | 2 +- src/thermal_adiabatic.f90 | 4 ++-- src/thermal_conduction.f90 | 4 ++-- 12 files changed, 36 insertions(+), 39 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index dfa8dd09d..be11c0107 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -262,7 +262,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt if (debug_e <= discretization_nElem .and. debug_i <=discretization_nIP) then write(6,'(a,1x,i8,1x,i2,1x,i4,/,(12x,6(e20.8,1x)),/)') & '<< CPFEM >> aged state of elFE ip grain',debug_e, debug_i, 1, & - plasticState(phaseAt(1,debug_i,debug_e))%state(:,phasememberAt(1,debug_i,debug_e)) + plasticState(material_phaseAt(1,debug_e))%state(:,material_phasememberAt(1,debug_i,debug_e)) endif endif diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 2764bfcb0..966c9e7f0 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -178,7 +178,7 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el phiDot = 0.0_pReal dPhiDot_dPhi = 0.0_pReal do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) - phase = phaseAt(grain,ip,el) + phase = material_phaseAt(grain,el) constituent = phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index d8ab8bf1b..1c9763cfe 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -144,7 +144,7 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, phiDot = 0.0_pReal dPhiDot_dPhi = 0.0_pReal do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) - phase = phaseAt(grain,ip,el) + phase = material_phaseAt(grain,el) constituent = phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 35e2e9e03..33d169c52 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -326,11 +326,11 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do g = 1,myNgrains - plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & - plasticState (phaseAt(g,i,e))%state0( :,phasememberAt(g,i,e)) - do mySource = 1, phase_Nsources(phaseAt(g,i,e)) - sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & - sourceState(phaseAt(g,i,e))%p(mySource)%state0( :,phasememberAt(g,i,e)) + plasticState (material_phaseAt(g,e))%partionedState0(:,phasememberAt(g,i,e)) = & + plasticState (material_phaseAt(g,e))%state0( :,phasememberAt(g,i,e)) + do mySource = 1, phase_Nsources(material_phaseAt(g,e)) + sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & + sourceState(material_phaseAt(g,e))%p(mySource)%state0( :,phasememberAt(g,i,e)) enddo crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) @@ -412,11 +412,11 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_S (1:3,1:3,1:myNgrains,i,e) do g = 1,myNgrains - plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = & - plasticState (phaseAt(g,i,e))%state (:,phasememberAt(g,i,e)) - do mySource = 1, phase_Nsources(phaseAt(g,i,e)) - sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & - sourceState(phaseAt(g,i,e))%p(mySource)%state (:,phasememberAt(g,i,e)) + plasticState (material_phaseAt(g,e))%partionedState0(:,phasememberAt(g,i,e)) = & + plasticState (material_phaseAt(g,e))%state (:,phasememberAt(g,i,e)) + do mySource = 1, phase_Nsources(material_phaseAt(g,e)) + sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & + sourceState(material_phaseAt(g,e))%p(mySource)%state (:,phasememberAt(g,i,e)) enddo enddo @@ -475,11 +475,11 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_S(1:3,1:3,1:myNgrains,i,e) = & crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) do g = 1, myNgrains - plasticState (phaseAt(g,i,e))%state( :,phasememberAt(g,i,e)) = & - plasticState (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) - do mySource = 1, phase_Nsources(phaseAt(g,i,e)) - sourceState(phaseAt(g,i,e))%p(mySource)%state( :,phasememberAt(g,i,e)) = & - sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) + plasticState (material_phaseAt(g,e))%state( :,phasememberAt(g,i,e)) = & + plasticState (material_phaseAt(g,e))%partionedState0(:,phasememberAt(g,i,e)) + do mySource = 1, phase_Nsources(material_phaseAt(g,e)) + sourceState(material_phaseAt(g,e))%p(mySource)%state( :,phasememberAt(g,i,e)) = & + sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) enddo enddo if(homogState(material_homogenizationAt(e))%sizeState > 0) & diff --git a/src/material.f90 b/src/material.f90 index f4a700229..9f3215551 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -180,7 +180,6 @@ module material homogenization_active ! BEGIN DEPRECATED - integer, dimension(:,:,:), allocatable, public :: phaseAt !< phase ID of every material point (ipc,ip,el) integer, dimension(:,:,:), allocatable, public :: phasememberAt !< memberID of given phase at every material point (ipc,ip,el) integer, dimension(:,:,:), allocatable, public, target :: mappingHomogenization !< mapping from material points to offset in heterogenous state/field @@ -375,7 +374,6 @@ subroutine material_init !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BEGIN DEPRECATED - allocate(phaseAt ( homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0) allocate(phasememberAt ( homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0) allocate(mappingHomogenization (2, discretization_nIP,discretization_nElem),source=0) allocate(mappingHomogenizationConst( discretization_nIP,discretization_nElem),source=1) @@ -392,7 +390,6 @@ subroutine material_init do g = 1,homogenization_Ngrains(myHomog) myPhase = material_phase(g,i,e) CounterPhase(myPhase) = CounterPhase(myPhase)+1 ! not distinguishing between instances of same phase - phaseAt(g,i,e) = myPhase phasememberAt(g,i,e) = CounterPhase(myPhase) enddo enddo diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index baed5a066..dd58e60be 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -875,8 +875,8 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el) real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & m ! direction of dislocation motion - ph = phaseAt(1,ip,el) - of = phasememberAt(1,ip,el) + ph = material_phaseAt(1,el) + of = material_phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) associate(prm => param(instance),dst => microstructure(instance), stt => state(instance)) @@ -1216,8 +1216,8 @@ subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, & gdotTotal !< shear rate !*** shortcut for mapping - ph = phaseAt(1,ip,el) - of = phasememberAt(1,ip,el) + ph = material_phaseAt(1,el) + of = material_phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) associate(prm => param(instance),dst=>microstructure(instance)) @@ -1338,8 +1338,8 @@ subroutine plastic_nonlocal_deltaState(Mp,ip,el) dUpperOld, & ! old maximum stable dipole distance for edges and screws deltaDUpper ! change in maximum stable dipole distance for edges and screws - ph = phaseAt(1,ip,el) - of = phasememberAt(1,ip,el) + ph = material_phaseAt(1,el) + of = material_phasememberAt(1,ip,el) instance = phase_plasticityInstance(ph) associate(prm => param(instance),dst => microstructure(instance),del => deltaState(instance)) @@ -1507,8 +1507,8 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & considerEnteringFlux, & considerLeavingFlux - p = phaseAt(1,ip,el) - o = phasememberAt(1,ip,el) + p = material_phaseAt(1,el) + o = material_phasememberAt(1,ip,el) if (timestep <= 0.0_pReal) then plasticState(p)%dotState = 0.0_pReal @@ -1630,8 +1630,8 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & neighbor_el = IPneighborhood(1,n,ip,el) neighbor_ip = IPneighborhood(2,n,ip,el) neighbor_n = IPneighborhood(3,n,ip,el) - np = phaseAt(1,neighbor_ip,neighbor_el) - no = phasememberAt(1,neighbor_ip,neighbor_el) + np = material_phaseAt(1,neighbor_el) + no = material_phasememberAt(1,neighbor_ip,neighbor_el) opposite_neighbor = n + mod(n,2) - mod(n+1,2) opposite_el = IPneighborhood(1,opposite_neighbor,ip,el) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index ccad7c6b0..b84b23558 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -202,7 +202,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) real(pReal) :: & traction_d, traction_t, traction_n, traction_crit - phase = phaseAt(ipc,ip,el) + phase = material_phaseAt(ipc,el) constituent = phasememberAt(ipc,ip,el) instance = source_damage_anisoBrittle_instance(phase) sourceOffset = source_damage_anisoBrittle_offset(phase) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index aa8c9b8fa..6b5514c86 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -180,7 +180,7 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) instance, & i - phase = phaseAt(ipc,ip,el) + phase = material_phaseAt(ipc,el) constituent = phasememberAt(ipc,ip,el) instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index cf43fdfb8..70e4bbcd1 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -164,7 +164,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) strain(6), & strainenergy - phase = phaseAt(ipc,ip,el) !< phase ID at ipc,ip,el + phase = material_phaseAt(ipc,el) !< phase ID at ipc,ip,el constituent = phasememberAt(ipc,ip,el) !< state array offset for phase ID at ipc,ip,el ! ToDo: capability for multiple instances of SAME source within given phase. Needs Ninstance loop from here on! instance = source_damage_isoBrittle_instance(phase) !< instance of damage_isoBrittle source diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 524936077..69284db9a 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -157,7 +157,7 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el) integer :: & phase, constituent, instance, homog, sourceOffset, damageOffset - phase = phaseAt(ipc,ip,el) + phase = material_phaseAt(ipc,el) constituent = phasememberAt(ipc,ip,el) instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index 526c98904..76f519913 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -167,8 +167,8 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) Tdot = 0.0_pReal dTdot_dT = 0.0_pReal do grain = 1, homogenization_Ngrains(homog) - phase = phaseAt(grain,ip,el) - constituent = phasememberAt(grain,ip,el) + phase = material_phaseAt(grain,el) + constituent = material_phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_thermal_dissipation_ID) diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index a31961dc7..c70c59b60 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -132,8 +132,8 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) Tdot = 0.0_pReal dTdot_dT = 0.0_pReal do grain = 1, homogenization_Ngrains(homog) - phase = phaseAt(grain,ip,el) - constituent = phasememberAt(grain,ip,el) + phase = material_phaseAt(grain,el) + constituent = material_phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_thermal_dissipation_ID) From 9c4f92a01c9c8375a4870311100dc37a641137dd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 09:09:16 +0200 Subject: [PATCH 07/49] substitute phasememberAt with material_phaseMemberAt need to be clear where a global variable is defined --- src/constitutive.f90 | 34 +++++++++++++++--------------- src/damage_local.f90 | 2 +- src/damage_nonlocal.f90 | 2 +- src/homogenization.f90 | 24 ++++++++++----------- src/source_damage_anisoBrittle.f90 | 2 +- src/source_damage_anisoDuctile.f90 | 2 +- src/source_damage_isoBrittle.f90 | 2 +- src/source_damage_isoDuctile.f90 | 2 +- 8 files changed, 35 insertions(+), 35 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index cc70e8f22..2c1a873eb 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -282,11 +282,11 @@ subroutine constitutive_microstructure(Fe, Fp, ipc, ip, el) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_DISLOTWIN_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_disloUCLA_dependentState(instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType @@ -338,17 +338,17 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & dLp_dMp = 0.0_pReal case (PLASTICITY_ISOTROPIC_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) case (PLASTICITY_KINEHARDENING_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp, Mp,instance,of) @@ -357,12 +357,12 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & temperature(ho)%p(tme),geometry_plastic_nonlocal_IPvolume0(ip,el),ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_dislotwin_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) @@ -416,7 +416,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_isotropic_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) case default plasticityType @@ -600,27 +600,27 @@ subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip, plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_ISOTROPIC_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_isotropic_dotState (Mp,instance,of) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_phenopowerlaw_dotState(Mp,instance,of) case (PLASTICITY_KINEHARDENING_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_kinehardening_dotState(Mp,instance,of) case (PLASTICITY_DISLOTWIN_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_dislotwin_dotState (Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of) @@ -643,7 +643,7 @@ subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip, call source_damage_anisoDuctile_dotState ( ipc, ip, el) case (SOURCE_thermal_externalheat_ID) sourceType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) call source_thermal_externalheat_dotState(material_phase(ipc,ip,el),of) end select sourceType @@ -677,7 +677,7 @@ subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_KINEHARDENING_ID) plasticityType - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) call plastic_kinehardening_deltaState(Mp,instance,of) @@ -736,7 +736,7 @@ function constitutive_postResults(S, Fi, ipc, ip, el) startPos = 1 endPos = plasticState(material_phase(ipc,ip,el))%sizePostResults - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) @@ -769,7 +769,7 @@ function constitutive_postResults(S, Fi, ipc, ip, el) SourceLoop: do i = 1, phase_Nsources(material_phase(ipc,ip,el)) startPos = endPos + 1 endPos = endPos + sourceState(material_phase(ipc,ip,el))%p(i)%sizePostResults - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) sourceType: select case (phase_source(i,material_phase(ipc,ip,el))) case (SOURCE_damage_isoBrittle_ID) sourceType constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(material_phase(ipc,ip,el),of) diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 966c9e7f0..74ad47c9b 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -179,7 +179,7 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el dPhiDot_dPhi = 0.0_pReal do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) phase = material_phaseAt(grain,el) - constituent = phasememberAt(grain,ip,el) + constituent = material_phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_damage_isoBrittle_ID) diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 1c9763cfe..dce88bc61 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -145,7 +145,7 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, dPhiDot_dPhi = 0.0_pReal do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) phase = material_phaseAt(grain,el) - constituent = phasememberAt(grain,ip,el) + constituent = material_phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_damage_isoBrittle_ID) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 33d169c52..9f7890131 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -326,11 +326,11 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do g = 1,myNgrains - plasticState (material_phaseAt(g,e))%partionedState0(:,phasememberAt(g,i,e)) = & - plasticState (material_phaseAt(g,e))%state0( :,phasememberAt(g,i,e)) + plasticState (material_phaseAt(g,e))%partionedState0(:,material_phasememberAt(g,i,e)) = & + plasticState (material_phaseAt(g,e))%state0( :,material_phasememberAt(g,i,e)) do mySource = 1, phase_Nsources(material_phaseAt(g,e)) - sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & - sourceState(material_phaseAt(g,e))%p(mySource)%state0( :,phasememberAt(g,i,e)) + sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,material_phasememberAt(g,i,e)) = & + sourceState(material_phaseAt(g,e))%p(mySource)%state0( :,material_phasememberAt(g,i,e)) enddo crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) @@ -412,11 +412,11 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_S (1:3,1:3,1:myNgrains,i,e) do g = 1,myNgrains - plasticState (material_phaseAt(g,e))%partionedState0(:,phasememberAt(g,i,e)) = & - plasticState (material_phaseAt(g,e))%state (:,phasememberAt(g,i,e)) + plasticState (material_phaseAt(g,e))%partionedState0(:,material_phasememberAt(g,i,e)) = & + plasticState (material_phaseAt(g,e))%state (:,material_phasememberAt(g,i,e)) do mySource = 1, phase_Nsources(material_phaseAt(g,e)) - sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = & - sourceState(material_phaseAt(g,e))%p(mySource)%state (:,phasememberAt(g,i,e)) + sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,material_phasememberAt(g,i,e)) = & + sourceState(material_phaseAt(g,e))%p(mySource)%state (:,material_phasememberAt(g,i,e)) enddo enddo @@ -475,11 +475,11 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_S(1:3,1:3,1:myNgrains,i,e) = & crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) do g = 1, myNgrains - plasticState (material_phaseAt(g,e))%state( :,phasememberAt(g,i,e)) = & - plasticState (material_phaseAt(g,e))%partionedState0(:,phasememberAt(g,i,e)) + plasticState (material_phaseAt(g,e))%state( :,material_phasememberAt(g,i,e)) = & + plasticState (material_phaseAt(g,e))%partionedState0(:,material_phasememberAt(g,i,e)) do mySource = 1, phase_Nsources(material_phaseAt(g,e)) - sourceState(material_phaseAt(g,e))%p(mySource)%state( :,phasememberAt(g,i,e)) = & - sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) + sourceState(material_phaseAt(g,e))%p(mySource)%state( :,material_phasememberAt(g,i,e)) = & + sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,material_phasememberAt(g,i,e)) enddo enddo if(homogState(material_homogenizationAt(e))%sizeState > 0) & diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index b84b23558..9a82fc6c7 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -203,7 +203,7 @@ subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) traction_d, traction_t, traction_n, traction_crit phase = material_phaseAt(ipc,el) - constituent = phasememberAt(ipc,ip,el) + constituent = material_phasememberAt(ipc,ip,el) instance = source_damage_anisoBrittle_instance(phase) sourceOffset = source_damage_anisoBrittle_offset(phase) homog = material_homogenizationAt(el) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 6b5514c86..ddb985188 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -181,7 +181,7 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) i phase = material_phaseAt(ipc,el) - constituent = phasememberAt(ipc,ip,el) + constituent = material_phasememberAt(ipc,ip,el) instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) homog = material_homogenizationAt(el) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 70e4bbcd1..21724ad8a 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -165,7 +165,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) strainenergy phase = material_phaseAt(ipc,el) !< phase ID at ipc,ip,el - constituent = phasememberAt(ipc,ip,el) !< state array offset for phase ID at ipc,ip,el + constituent = material_phasememberAt(ipc,ip,el) !< state array offset for phase ID at ipc,ip,el ! ToDo: capability for multiple instances of SAME source within given phase. Needs Ninstance loop from here on! instance = source_damage_isoBrittle_instance(phase) !< instance of damage_isoBrittle source sourceOffset = source_damage_isoBrittle_offset(phase) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 69284db9a..d477342c6 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -158,7 +158,7 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el) phase, constituent, instance, homog, sourceOffset, damageOffset phase = material_phaseAt(ipc,el) - constituent = phasememberAt(ipc,ip,el) + constituent = material_phasememberAt(ipc,ip,el) instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) homog = material_homogenizationAt(el) From 59cb70198e874703fc93670aec9f4c391df28355 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 09:17:05 +0200 Subject: [PATCH 08/49] phasememberAt not needed anymore --- src/material.f90 | 19 ++----------------- src/plastic_dislotwin.f90 | 2 +- src/plastic_isotropic.f90 | 2 +- src/plastic_kinematichardening.f90 | 2 +- src/plastic_nonlocal.f90 | 4 ++-- 5 files changed, 7 insertions(+), 22 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 9f3215551..f4014ec84 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -180,8 +180,6 @@ module material homogenization_active ! BEGIN DEPRECATED - integer, dimension(:,:,:), allocatable, public :: phasememberAt !< memberID of given phase at every material point (ipc,ip,el) - integer, dimension(:,:,:), allocatable, public, target :: mappingHomogenization !< mapping from material points to offset in heterogenous state/field integer, dimension(:,:), allocatable, private, target :: mappingHomogenizationConst !< mapping from material points to offset in constant state/field ! END DEPRECATED @@ -246,11 +244,7 @@ contains subroutine material_init integer, parameter :: FILEUNIT = 210 - integer :: m,c,h, myDebug, myPhase, myHomog - integer :: & - g, & !< grain number - i, & !< integration point number - e !< element number + integer :: i,e,m,c,h, myDebug, myPhase, myHomog integer, dimension(:), allocatable :: & CounterPhase, & CounterHomogenization @@ -374,24 +368,15 @@ subroutine material_init !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! BEGIN DEPRECATED - allocate(phasememberAt ( homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0) allocate(mappingHomogenization (2, discretization_nIP,discretization_nElem),source=0) allocate(mappingHomogenizationConst( discretization_nIP,discretization_nElem),source=1) CounterHomogenization=0 - CounterPhase =0 - - do e = 1,discretization_nElem - myHomog = discretization_homogenizationAt(e) + myHomog = discretization_homogenizationAt(e) do i = 1, discretization_nIP CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1 mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),huge(1)] - do g = 1,homogenization_Ngrains(myHomog) - myPhase = material_phase(g,i,e) - CounterPhase(myPhase) = CounterPhase(myPhase)+1 ! not distinguishing between instances of same phase - phasememberAt(g,i,e) = CounterPhase(myPhase) - enddo enddo enddo ! END DEPRECATED diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 4d84b503e..f82a6e711 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -590,7 +590,7 @@ function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) of real(pReal) :: f_unrotated - of = phasememberAt(ipc,ip,el) + of = material_phasememberAt(ipc,ip,el) associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))),& stt => state(phase_plasticityInstance(material_phase(ipc,ip,el)))) diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 46d0905dc..a658f17d6 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -128,7 +128,7 @@ subroutine plastic_isotropic_init #ifdef DEBUG if (p==material_phase(debug_g,debug_i,debug_e)) & - prm%of_debug = phasememberAt(debug_g,debug_i,debug_e) + prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e) #endif prm%xi_0 = config%getFloat('tau0') diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index ab68eb176..c27c100fd 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -147,7 +147,7 @@ subroutine plastic_kinehardening_init #ifdef DEBUG if (p==material_phase(debug_g,debug_i,debug_e)) then - prm%of_debug = phasememberAt(debug_g,debug_i,debug_e) + prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e) endif #endif diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index dd58e60be..88f71496b 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -766,7 +766,7 @@ subroutine plastic_nonlocal_init ! get the total volume of the instance do e = 1,discretization_nElem do i = 1,discretization_nIP - if (material_phase(1,i,e) == phase) volume(phasememberAt(1,i,e)) = IPvolume(i,e) + if (material_phase(1,i,e) == phase) volume(material_phasememberAt(1,i,e)) = IPvolume(i,e) enddo enddo totalVolume = sum(volume) @@ -935,7 +935,7 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el) do n = 1,nIPneighbors neighbor_el = IPneighborhood(1,n,ip,el) neighbor_ip = IPneighborhood(2,n,ip,el) - no = phasememberAt(1,neighbor_ip,neighbor_el) + no = material_phasememberAt(1,neighbor_ip,neighbor_el) if (neighbor_el > 0 .and. neighbor_ip > 0) then neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) if (neighbor_instance == instance) then From 083fdb13b4109b169af0dc99d94eb9471913857d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 09:37:01 +0200 Subject: [PATCH 09/49] material_phaseAt and material_phaseMemberAt substitute material_phase --- src/constitutive.f90 | 86 ++++++++++++++-------------- src/kinematics_cleavage_opening.f90 | 2 +- src/kinematics_slipplane_opening.f90 | 2 +- src/kinematics_thermal_expansion.f90 | 2 +- src/plastic_disloUCLA.f90 | 2 +- src/plastic_dislotwin.f90 | 6 +- src/plastic_isotropic.f90 | 4 +- src/plastic_kinematichardening.f90 | 4 +- src/plastic_none.f90 | 2 +- src/plastic_nonlocal.f90 | 72 +++++++++++------------ src/plastic_phenopowerlaw.f90 | 2 +- src/source_damage_anisoBrittle.f90 | 2 +- src/source_damage_anisoDuctile.f90 | 2 +- src/source_damage_isoBrittle.f90 | 2 +- src/source_damage_isoDuctile.f90 | 2 +- src/source_thermal_dissipation.f90 | 2 +- src/source_thermal_externalheat.f90 | 2 +- 17 files changed, 98 insertions(+), 98 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 2c1a873eb..ec66ab126 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -251,7 +251,7 @@ function constitutive_homogenizedC(ipc,ip,el) ip, & !< integration point el !< element - plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) case (PLASTICITY_DISLOTWIN_ID) plasticityType constitutive_homogenizedC = plastic_dislotwin_homogenizedC(ipc,ip,el) case default plasticityType @@ -280,14 +280,14 @@ subroutine constitutive_microstructure(Fe, Fp, ipc, ip, el) ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) - plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) case (PLASTICITY_DISLOTWIN_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_disloUCLA_dependentState(instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_dependentState (Fe,Fp,ip,el) @@ -331,7 +331,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & Mp = matmul(matmul(transpose(Fi),Fi),S) - plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) case (PLASTICITY_NONE_ID) plasticityType Lp = 0.0_pReal @@ -339,17 +339,17 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & case (PLASTICITY_ISOTROPIC_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) case (PLASTICITY_KINEHARDENING_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp, Mp,instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType @@ -358,12 +358,12 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & case (PLASTICITY_DISLOTWIN_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_dislotwin_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) end select plasticityType @@ -414,10 +414,10 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & dLi_dS = 0.0_pReal dLi_dFi = 0.0_pReal - plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) case (PLASTICITY_isotropic_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) case default plasticityType my_Li = 0.0_pReal @@ -427,8 +427,8 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & Li = Li + my_Li dLi_dS = dLi_dS + my_dLi_dS - KinematicsLoop: do k = 1, phase_Nkinematics(material_phase(ipc,ip,el)) - kinematicsType: select case (phase_kinematics(k,material_phase(ipc,ip,el))) + KinematicsLoop: do k = 1, phase_Nkinematics(material_phaseAt(ipc,el)) + kinematicsType: select case (phase_kinematics(k,material_phaseAt(ipc,el))) case (KINEMATICS_cleavage_opening_ID) kinematicsType call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, ipc, ip, el) case (KINEMATICS_slipplane_opening_ID) kinematicsType @@ -475,7 +475,7 @@ pure function constitutive_initialFi(ipc, ip, el) homog, offset constitutive_initialFi = math_I3 - phase = material_phase(ipc,ip,el) + phase = material_phaseAt(ipc,el) KinematicsLoop: do k = 1, phase_Nkinematics(phase) !< Warning: small initial strain assumption kinematicsType: select case (phase_kinematics(k,phase)) @@ -546,8 +546,8 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & ho = material_homogenizationAt(el) C = math_66toSym3333(constitutive_homogenizedC(ipc,ip,el)) - DegradationLoop: do d = 1, phase_NstiffnessDegradations(material_phase(ipc,ip,el)) - degradationType: select case(phase_stiffnessDegradation(d,material_phase(ipc,ip,el))) + DegradationLoop: do d = 1, phase_NstiffnessDegradations(material_phaseAt(ipc,el)) + degradationType: select case(phase_stiffnessDegradation(d,material_phaseAt(ipc,el))) case (STIFFNESS_DEGRADATION_damage_ID) degradationType C = C * damage(ho)%p(damageMapping(ho)%p(ip,el))**2 end select degradationType @@ -597,31 +597,31 @@ subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip, Mp = matmul(matmul(transpose(Fi),Fi),S) - plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) case (PLASTICITY_ISOTROPIC_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_isotropic_dotState (Mp,instance,of) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_phenopowerlaw_dotState(Mp,instance,of) case (PLASTICITY_KINEHARDENING_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_kinehardening_dotState(Mp,instance,of) case (PLASTICITY_DISLOTWIN_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_dislotwin_dotState (Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType @@ -629,9 +629,9 @@ subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip, subdt,ip,el) end select plasticityType - SourceLoop: do i = 1, phase_Nsources(material_phase(ipc,ip,el)) + SourceLoop: do i = 1, phase_Nsources(material_phaseAt(ipc,el)) - sourceType: select case (phase_source(i,material_phase(ipc,ip,el))) + sourceType: select case (phase_source(i,material_phaseAt(ipc,el))) case (SOURCE_damage_anisoBrittle_ID) sourceType call source_damage_anisoBrittle_dotState (S, ipc, ip, el) !< correct stress? @@ -644,7 +644,7 @@ subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip, case (SOURCE_thermal_externalheat_ID) sourceType of = material_phasememberAt(ipc,ip,el) - call source_thermal_externalheat_dotState(material_phase(ipc,ip,el),of) + call source_thermal_externalheat_dotState(material_phaseAt(ipc,el),of) end select sourceType @@ -674,11 +674,11 @@ subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el) Mp = matmul(matmul(transpose(Fi),Fi),S) - plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) case (PLASTICITY_KINEHARDENING_ID) plasticityType of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) call plastic_kinehardening_deltaState(Mp,instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType @@ -686,9 +686,9 @@ subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el) end select plasticityType - sourceLoop: do i = 1, phase_Nsources(material_phase(ipc,ip,el)) + sourceLoop: do i = 1, phase_Nsources(material_phaseAt(ipc,el)) - sourceType: select case (phase_source(i,material_phase(ipc,ip,el))) + sourceType: select case (phase_source(i,material_phaseAt(ipc,el))) case (SOURCE_damage_isoBrittle_ID) sourceType call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(ipc,ip,el), Fe, & @@ -710,8 +710,8 @@ function constitutive_postResults(S, Fi, ipc, ip, el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults + & - sum(sourceState(material_phase(ipc,ip,el))%p(:)%sizePostResults)) :: & + real(pReal), dimension(plasticState(material_phaseAt(ipc,el))%sizePostResults + & + sum(sourceState(material_phaseAt(ipc,el))%p(:)%sizePostResults)) :: & constitutive_postResults real(pReal), intent(in), dimension(3,3) :: & Fi !< intermediate deformation gradient @@ -734,12 +734,12 @@ function constitutive_postResults(S, Fi, ipc, ip, el) tme = thermalMapping(ho)%p(ip,el) startPos = 1 - endPos = plasticState(material_phase(ipc,ip,el))%sizePostResults + endPos = plasticState(material_phaseAt(ipc,el))%sizePostResults of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) case (PLASTICITY_ISOTROPIC_ID) plasticityType constitutive_postResults(startPos:endPos) = & plastic_isotropic_postResults(Mp,instance,of) @@ -762,23 +762,23 @@ function constitutive_postResults(S, Fi, ipc, ip, el) case (PLASTICITY_NONLOCAL_ID) plasticityType constitutive_postResults(startPos:endPos) = & - plastic_nonlocal_postResults (material_phase(ipc,ip,el),instance,of) + plastic_nonlocal_postResults (material_phaseAt(ipc,el),instance,of) end select plasticityType - SourceLoop: do i = 1, phase_Nsources(material_phase(ipc,ip,el)) + SourceLoop: do i = 1, phase_Nsources(material_phaseAt(ipc,el)) startPos = endPos + 1 - endPos = endPos + sourceState(material_phase(ipc,ip,el))%p(i)%sizePostResults + endPos = endPos + sourceState(material_phaseAt(ipc,el))%p(i)%sizePostResults of = material_phasememberAt(ipc,ip,el) - sourceType: select case (phase_source(i,material_phase(ipc,ip,el))) + sourceType: select case (phase_source(i,material_phaseAt(ipc,el))) case (SOURCE_damage_isoBrittle_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(material_phase(ipc,ip,el),of) + constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(material_phaseAt(ipc,el),of) case (SOURCE_damage_isoDuctile_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_isoDuctile_postResults(material_phase(ipc,ip,el),of) + constitutive_postResults(startPos:endPos) = source_damage_isoDuctile_postResults(material_phaseAt(ipc,el),of) case (SOURCE_damage_anisoBrittle_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_anisoBrittle_postResults(material_phase(ipc,ip,el),of) + constitutive_postResults(startPos:endPos) = source_damage_anisoBrittle_postResults(material_phaseAt(ipc,el),of) case (SOURCE_damage_anisoDuctile_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_anisoDuctile_postResults(material_phase(ipc,ip,el),of) + constitutive_postResults(startPos:endPos) = source_damage_anisoDuctile_postResults(material_phaseAt(ipc,el),of) end select sourceType enddo SourceLoop diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 39bfbf340..42761f8df 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -138,7 +138,7 @@ subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, i traction_d, traction_t, traction_n, traction_crit, & udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt - phase = material_phase(ipc,ip,el) + phase = material_phaseAt(ipc,el) instance = kinematics_cleavage_opening_instance(phase) homog = material_homogenizationAt(el) damageOffset = damageMapping(homog)%p(ip,el) diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index 3e37e4c0d..a8aaa0e82 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -124,7 +124,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, traction_d, traction_t, traction_n, traction_crit, & udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt - phase = material_phase(ipc,ip,el) + phase = material_phaseAt(ipc,el) instance = kinematics_slipplane_opening_instance(phase) homog = material_homogenizationAt(el) damageOffset = damageMapping(homog)%p(ip,el) diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index b4f23dfa7..4294321a5 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -112,7 +112,7 @@ subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, real(pReal) :: & T, TRef, TDot - phase = material_phase(ipc,ip,el) + phase = material_phaseAt(ipc,el) homog = material_homogenizationAt(el) offset = thermalMapping(homog)%p(ip,el) T = temperature(homog)%p(offset) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index c8ef6fa15..a2658e8c4 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -295,7 +295,7 @@ subroutine plastic_disloUCLA_init() !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == p) + NipcMyPhase = count(material_phaseMemberAt == p) sizeDotState = size(['rho_mob ','rho_dip ','gamma_sl']) * prm%sum_N_sl sizeState = sizeDotState diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index f82a6e711..e5fe58202 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -503,7 +503,7 @@ subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == p) + NipcMyPhase = count(material_phaseMemberAt == p) sizeDotState = size(['rho_mob ','rho_dip ','gamma_sl']) * prm%sum_N_sl & + size(['f_tw']) * prm%sum_N_tw & + size(['f_tr']) * prm%sum_N_tr @@ -591,8 +591,8 @@ function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) real(pReal) :: f_unrotated of = material_phasememberAt(ipc,ip,el) - associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))),& - stt => state(phase_plasticityInstance(material_phase(ipc,ip,el)))) + associate(prm => param(phase_plasticityInstance(material_phaseAt(ipc,el))),& + stt => state(phase_plasticityInstance(material_phaseAT(ipc,el)))) f_unrotated = 1.0_pReal & - sum(stt%f_tw(1:prm%sum_N_tw,of)) & diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index a658f17d6..99518668d 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -127,7 +127,7 @@ subroutine plastic_isotropic_init config => config_phase(p)) #ifdef DEBUG - if (p==material_phase(debug_g,debug_i,debug_e)) & + if (p==material_phaseAt(debug_g,debug_e)) & prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e) #endif @@ -190,7 +190,7 @@ subroutine plastic_isotropic_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == p) + NipcMyPhase = count(material_phaseMemberAt == p) sizeDotState = size(['xi ','accumulated_shear']) sizeState = sizeDotState diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index c27c100fd..b6173e2e8 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -146,7 +146,7 @@ subroutine plastic_kinehardening_init config => config_phase(p)) #ifdef DEBUG - if (p==material_phase(debug_g,debug_i,debug_e)) then + if (p==material_phaseAt(debug_g,debug_e)) then prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e) endif #endif @@ -257,7 +257,7 @@ subroutine plastic_kinehardening_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == p) + NipcMyPhase = count(material_phaseMemberAt == p) sizeDotState = size(['crss ','crss_back', 'accshear ']) * prm%totalNslip sizeDeltaState = size(['sense ', 'chi0 ', 'gamma0' ]) * prm%totalNslip sizeState = sizeDotState + sizeDeltaState diff --git a/src/plastic_none.f90 b/src/plastic_none.f90 index 894cc9a40..d362e7a77 100644 --- a/src/plastic_none.f90 +++ b/src/plastic_none.f90 @@ -36,7 +36,7 @@ subroutine plastic_none_init do p = 1, size(phase_plasticity) if (phase_plasticity(p) /= PLASTICITY_NONE_ID) cycle - NipcMyPhase = count(material_phase == p) + NipcMyPhase = count(material_phaseMemberAt == p) call material_allocatePlasticState(p,NipcMyPhase,0,0,0, & 0,0,0) plasticState(p)%sizePostResults = 0 diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 88f71496b..d8a7fb4b7 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -556,7 +556,7 @@ subroutine plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NofMyPhase=count(material_phase==p) + NofMyPhase=count(material_phaseMemberAt==p) sizeDotState = size([ 'rhoSglEdgePosMobile ','rhoSglEdgeNegMobile ', & 'rhoSglScrewPosMobile ','rhoSglScrewNegMobile ', & 'rhoSglEdgePosImmobile ','rhoSglEdgeNegImmobile ', & @@ -677,7 +677,7 @@ subroutine plastic_nonlocal_init allocate(iD(maxval(totalNslip),2,maxNinstances), source=0) initializeInstances: do p = 1, size(phase_plasticity) - NofMyPhase=count(material_phase==p) + NofMyPhase=count(material_phaseMemberAt==p) myPhase2: if (phase_plasticity(p) == PLASTICITY_NONLOCAL_ID) then !*** determine indices to state array @@ -766,7 +766,7 @@ subroutine plastic_nonlocal_init ! get the total volume of the instance do e = 1,discretization_nElem do i = 1,discretization_nIP - if (material_phase(1,i,e) == phase) volume(material_phasememberAt(1,i,e)) = IPvolume(i,e) + if (material_phaseAt(1,e) == phase) volume(material_phasememberAt(1,i,e)) = IPvolume(i,e) enddo enddo totalVolume = sum(volume) @@ -854,25 +854,25 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el) invConnections real(pReal), dimension(3,nIPneighbors) :: & connection_latticeConf - real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phaseAt(1,el)))) :: & rhoExcess - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el)))) :: & rho_edg_delta, & rho_scr_delta - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),10) :: & rho, & rho_neighbor - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))), & - totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))), & + totalNslip(phase_plasticityInstance(material_phaseAt(1,el)))) :: & myInteractionMatrix ! corrected slip interaction matrix - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),nIPneighbors) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),nIPneighbors) :: & rho_edg_delta_neighbor, & rho_scr_delta_neighbor real(pReal), dimension(2,maxval(totalNslip),nIPneighbors) :: & neighbor_rhoExcess, & ! excess density at neighboring material point neighbor_rhoTotal ! total density at neighboring material point - real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & + real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),2) :: & m ! direction of dislocation motion ph = material_phaseAt(1,el) @@ -937,7 +937,7 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el) neighbor_ip = IPneighborhood(2,n,ip,el) no = material_phasememberAt(1,neighbor_ip,neighbor_el) if (neighbor_el > 0 .and. neighbor_ip > 0) then - neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) + neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el)) if (neighbor_instance == instance) then nRealNeighbors = nRealNeighbors + 1.0_pReal @@ -1202,16 +1202,16 @@ subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, & of, & !offset t, & !< dislocation type s !< index of my current slip system - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),8) :: & rhoSgl !< single dislocation densities (including blocked) - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),10) :: & rho - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),4) :: & v, & !< velocity tauNS, & !< resolved shear stress including non Schmid and backstress terms dv_dtau, & !< velocity derivative with respect to the shear stress dv_dtauNS !< velocity derivative with respect to the shear stress - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el)))) :: & tau, & !< resolved shear stress including backstress terms gdotTotal !< shear rate @@ -1323,16 +1323,16 @@ subroutine plastic_nonlocal_deltaState(Mp,ip,el) c, & ! character of dislocation t, & ! type of dislocation s ! index of my current slip system - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),10) :: & deltaRhoRemobilization, & ! density increment by remobilization deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change) - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),10) :: & rho ! current dislocation densities - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),4) :: & v ! dislocation glide velocity - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el)))) :: & tau ! current resolved shear stress - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),2) :: & rhoDip, & ! current dipole dislocation densities (screw and edge dipoles) dUpper, & ! current maximum stable dipole distance for edges and screws dUpperOld, & ! old maximum stable dipole distance for edges and screws @@ -1459,7 +1459,7 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & np,& !< neighbour phase shortcut topp, & !< type of dislocation with opposite sign to t s !< index of my current slip system - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),10) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),10) :: & rho, & rhoDot, & !< density evolution rhoDotMultiplication, & !< density evolution by multiplication @@ -1467,24 +1467,24 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & rhoDotSingle2DipoleGlide, & !< density evolution by dipole formation (by glide) rhoDotAthermalAnnihilation, & !< density evolution by athermal annihilation rhoDotThermalAnnihilation !< density evolution by thermal annihilation - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),8) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),8) :: & rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) neighbor_rhoSgl, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles) my_rhoSgl !< single dislocation densities of central ip (positive/negative screw and edge without dipoles) - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),4) :: & v, & !< current dislocation glide velocity my_v, & !< dislocation glide velocity of central ip neighbor_v, & !< dislocation glide velocity of enighboring ip gdot !< shear rates - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el)))) :: & tau, & !< current resolved shear stress vClimb !< climb velocity of edge dipoles - real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: & + real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),2) :: & rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) dLower, & !< minimum stable dipole distance for edges and screws dUpper !< current maximum stable dipole distance for edges and screws - real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),4) :: & + real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phaseAt(1,el))),4) :: & m !< direction of dislocation motion real(pReal), dimension(3,3) :: & my_F, & !< my total deformation gradient @@ -1515,7 +1515,7 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & return endif - ph = material_phase(1,ip,el) + ph = material_phaseAt(1,el) instance = phase_plasticityInstance(ph) associate(prm => param(instance),dst => microstructure(instance),dot => dotState(instance),stt => state(instance)) ns = totalNslip(instance) @@ -1592,7 +1592,7 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & !**************************************************************************** !*** calculate dislocation fluxes (only for nonlocal plasticity) rhoDotFlux = 0.0_pReal - if (.not. phase_localPlasticity(material_phase(1,ip,el))) then + if (.not. phase_localPlasticity(material_phaseAt(1,el))) then !*** check CFL (Courant-Friedrichs-Lewy) condition for flux if (any( abs(gdot) > 0.0_pReal & ! any active slip system ... @@ -1639,7 +1639,7 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & opposite_n = IPneighborhood(3,opposite_neighbor,ip,el) if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient - neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) + neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el)) neighbor_Fe = Fe(1:3,1:3,1,neighbor_ip,neighbor_el) neighbor_F = matmul(neighbor_Fe, Fp(1:3,1:3,1,neighbor_ip,neighbor_el)) Favg = 0.5_pReal * (my_F + neighbor_F) @@ -1661,7 +1661,7 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & neighbor_v = 0.0_pReal ! needed for check of sign change in flux density below neighbor_rhoSgl = 0.0_pReal if (neighbor_n > 0) then - if (phase_plasticity(material_phase(1,neighbor_ip,neighbor_el)) == PLASTICITY_NONLOCAL_ID & + if (phase_plasticity(material_phaseAt(1,neighbor_el)) == PLASTICITY_NONLOCAL_ID & .and. any(compatibility(:,:,:,n,ip,el) > 0.0_pReal)) & considerEnteringFlux = .true. endif @@ -1714,7 +1714,7 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & considerLeavingFlux = .true. if (opposite_n > 0) then - if (phase_plasticity(material_phase(1,opposite_ip,opposite_el)) /= PLASTICITY_NONLOCAL_ID) & + if (phase_plasticity(material_phaseAt(1,opposite_el)) /= PLASTICITY_NONLOCAL_ID) & considerLeavingFlux = .false. endif @@ -1905,20 +1905,20 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) s2 ! slip system index (my neighbor) real(pReal), dimension(4) :: & absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor - real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& - totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& + real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phaseAt(1,e))),& + totalNslip(phase_plasticityInstance(material_phaseAt(1,e))),& nIPneighbors) :: & my_compatibility ! my_compatibility for current element and ip real(pReal) :: & my_compatibilitySum, & thresholdValue, & nThresholdValues - logical, dimension(totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & + logical, dimension(totalNslip(phase_plasticityInstance(material_phaseAt(1,e)))) :: & belowThreshold type(rotation) :: rot Nneighbors = nIPneighbors - ph = material_phase(1,i,e) + ph = material_phaseAt(1,e) textureID = material_texture(1,i,e) instance = phase_plasticityInstance(ph) ns = totalNslip(instance) @@ -1950,7 +1950,7 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) !* we consider this to be a real "physical" phase boundary, so completely incompatible. !* If one of the two phases has a local plasticity law, !* we do not consider this to be a phase boundary, so completely compatible. - neighbor_phase = material_phase(1,neighbor_i,neighbor_e) + neighbor_phase = material_phaseAt(1,neighbor_e) if (neighbor_phase /= ph) then if (.not. phase_localPlasticity(neighbor_phase) .and. .not. phase_localPlasticity(ph))& forall(s1 = 1:ns) my_compatibility(1:2,s1,s1,n) = 0.0_pReal diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index a31891573..ce244a203 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -314,7 +314,7 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == p) + NipcMyPhase = count(material_phaseMemberAt == p) sizeDotState = size(['tau_slip ','gamma_slip']) * prm%totalNslip & + size(['tau_twin ','gamma_twin']) * prm%totalNtwin sizeState = sizeDotState diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 9a82fc6c7..7019fcc11 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -164,7 +164,7 @@ subroutine source_damage_anisoBrittle_init end associate phase = p - NofMyPhase=count(material_phase==phase) + NofMyPhase=count(material_phaseMemberAt==phase) instance = source_damage_anisoBrittle_instance(phase) sourceOffset = source_damage_anisoBrittle_offset(phase) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index ddb985188..27c768ffb 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -150,7 +150,7 @@ subroutine source_damage_anisoDuctile_init phase = p - NofMyPhase=count(material_phase==phase) + NofMyPhase=count(material_phaseMemberAt==phase) instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 21724ad8a..6d7893154 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -133,7 +133,7 @@ subroutine source_damage_isoBrittle_init phase = p - NofMyPhase=count(material_phase==phase) + NofMyPhase=count(material_phaseMemberAt==phase) instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index d477342c6..b1d2ace28 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -132,7 +132,7 @@ subroutine source_damage_isoDuctile_init end associate phase = p - NofMyPhase=count(material_phase==phase) + NofMyPhase=count(material_phaseMemberAt==phase) instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index e8464edd0..58bb11c84 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -75,7 +75,7 @@ subroutine source_thermal_dissipation_init if (all(phase_source(:,p) /= SOURCE_THERMAL_DISSIPATION_ID)) cycle instance = source_thermal_dissipation_instance(p) param(instance)%kappa = config_phase(p)%getFloat('dissipation_coldworkcoeff') - NofMyPhase=count(material_phase==p) + NofMyPhase=count(material_phaseMemberAt==p) sourceOffset = source_thermal_dissipation_offset(p) call material_allocateSourceState(p,sourceOffset,NofMyPhase,0,0,0) diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 99d9a6f1f..14684278f 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -83,7 +83,7 @@ subroutine source_thermal_externalheat_init if (all(phase_source(:,p) /= SOURCE_thermal_externalheat_ID)) cycle instance = source_thermal_externalheat_instance(p) sourceOffset = source_thermal_externalheat_offset(p) - NofMyPhase=count(material_phase==p) + NofMyPhase=count(material_phaseMemberAt==p) param(instance)%time = config_phase(p)%getFloats('externalheat_time') param(instance)%nIntervals = size(param(instance)%time) - 1 From 3f87a87a4e9476b69c14c1c4292d67d1359f096b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 10:05:39 +0200 Subject: [PATCH 10/49] wrong counting currently quite ugly, but planned changes for state structure will give overcome this --- src/plastic_disloUCLA.f90 | 3 ++- src/plastic_dislotwin.f90 | 3 ++- src/plastic_isotropic.f90 | 5 ++--- src/plastic_kinematichardening.f90 | 5 ++--- src/plastic_none.f90 | 3 ++- src/plastic_nonlocal.f90 | 4 ++-- src/plastic_phenopowerlaw.f90 | 5 ++--- src/source_damage_anisoBrittle.f90 | 3 ++- src/source_damage_anisoDuctile.f90 | 3 ++- src/source_damage_isoBrittle.f90 | 3 ++- src/source_damage_isoDuctile.f90 | 3 ++- src/source_thermal_dissipation.f90 | 3 ++- src/source_thermal_externalheat.f90 | 3 ++- 13 files changed, 26 insertions(+), 20 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index a2658e8c4..28e1227aa 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -13,6 +13,7 @@ module plastic_disloUCLA use material use config use lattice + use discretization use results implicit none @@ -295,7 +296,7 @@ subroutine plastic_disloUCLA_init() !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phaseMemberAt == p) + NipcMyPhase = count(material_phaseAt == p) * discretization_nIP sizeDotState = size(['rho_mob ','rho_dip ','gamma_sl']) * prm%sum_N_sl sizeState = sizeDotState diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index e5fe58202..7847720ac 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -15,6 +15,7 @@ module plastic_dislotwin use material use config use lattice + use discretization #if defined(PETSc) || defined(DAMASK_HDF5) use results #endif @@ -503,7 +504,7 @@ subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phaseMemberAt == p) + NipcMyPhase = count(material_phaseAt == p) * discretization_nIP sizeDotState = size(['rho_mob ','rho_dip ','gamma_sl']) * prm%sum_N_sl & + size(['f_tw']) * prm%sum_N_tw & + size(['f_tr']) * prm%sum_N_tr diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 99518668d..3b5ec6e5a 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -14,9 +14,8 @@ module plastic_isotropic use IO use material use config -#if defined(PETSc) || defined(DAMASK_HDF5) + use discretization use results -#endif implicit none private @@ -190,7 +189,7 @@ subroutine plastic_isotropic_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phaseMemberAt == p) + NipcMyPhase = count(material_phaseAt == p) * discretization_nIP sizeDotState = size(['xi ','accumulated_shear']) sizeState = sizeDotState diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index b6173e2e8..f2183327c 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -13,9 +13,8 @@ module plastic_kinehardening use material use config use lattice -#if defined(PETSc) || defined(DAMASK_HDF5) + use discretization use results -#endif implicit none private @@ -257,7 +256,7 @@ subroutine plastic_kinehardening_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phaseMemberAt == p) + NipcMyPhase = count(material_phaseAt == p) * discretization_nIP sizeDotState = size(['crss ','crss_back', 'accshear ']) * prm%totalNslip sizeDeltaState = size(['sense ', 'chi0 ', 'gamma0' ]) * prm%totalNslip sizeState = sizeDotState + sizeDeltaState diff --git a/src/plastic_none.f90 b/src/plastic_none.f90 index d362e7a77..fa913df4c 100644 --- a/src/plastic_none.f90 +++ b/src/plastic_none.f90 @@ -6,6 +6,7 @@ !-------------------------------------------------------------------------------------------------- module plastic_none use material + use discretization use debug implicit none @@ -36,7 +37,7 @@ subroutine plastic_none_init do p = 1, size(phase_plasticity) if (phase_plasticity(p) /= PLASTICITY_NONE_ID) cycle - NipcMyPhase = count(material_phaseMemberAt == p) + NipcMyPhase = count(material_phaseAt == p) * discretization_nIP call material_allocatePlasticState(p,NipcMyPhase,0,0,0, & 0,0,0) plasticState(p)%sizePostResults = 0 diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index d8a7fb4b7..854fc9177 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -556,7 +556,7 @@ subroutine plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NofMyPhase=count(material_phaseMemberAt==p) + NofMyPhase = count(material_phaseAt==p) * discretization_nIP sizeDotState = size([ 'rhoSglEdgePosMobile ','rhoSglEdgeNegMobile ', & 'rhoSglScrewPosMobile ','rhoSglScrewNegMobile ', & 'rhoSglEdgePosImmobile ','rhoSglEdgeNegImmobile ', & @@ -677,7 +677,7 @@ subroutine plastic_nonlocal_init allocate(iD(maxval(totalNslip),2,maxNinstances), source=0) initializeInstances: do p = 1, size(phase_plasticity) - NofMyPhase=count(material_phaseMemberAt==p) + NofMyPhase = count(material_phaseAt==p) * discretization_nIP myPhase2: if (phase_plasticity(p) == PLASTICITY_NONLOCAL_ID) then !*** determine indices to state array diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index ce244a203..0a0052dfb 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -12,9 +12,8 @@ module plastic_phenopowerlaw use material use config use lattice -#if defined(PETSc) || defined(DAMASK_HDF5) + use discretization use results -#endif implicit none private @@ -314,7 +313,7 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phaseMemberAt == p) + NipcMyPhase = count(material_phaseAt == p) * discretization_nIP sizeDotState = size(['tau_slip ','gamma_slip']) * prm%totalNslip & + size(['tau_twin ','gamma_twin']) * prm%totalNtwin sizeState = sizeDotState diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 7019fcc11..9997f81e5 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -10,6 +10,7 @@ module source_damage_anisoBrittle use IO use math use material + use discretization use config use lattice @@ -164,7 +165,7 @@ subroutine source_damage_anisoBrittle_init end associate phase = p - NofMyPhase=count(material_phaseMemberAt==phase) + NofMyPhase=count(material_phaseAt==phase) * discretization_nIP instance = source_damage_anisoBrittle_instance(phase) sourceOffset = source_damage_anisoBrittle_offset(phase) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 27c768ffb..409466e48 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -9,6 +9,7 @@ module source_damage_anisoDuctile use debug use IO use math + use discretization use material use config @@ -150,7 +151,7 @@ subroutine source_damage_anisoDuctile_init phase = p - NofMyPhase=count(material_phaseMemberAt==phase) + NofMyPhase=count(material_phaseAt==phase) * discretization_nIP instance = source_damage_anisoDuctile_instance(phase) sourceOffset = source_damage_anisoDuctile_offset(phase) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 6d7893154..89f5a038c 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -9,6 +9,7 @@ module source_damage_isoBrittle use debug use IO use math + use discretization use material use config @@ -133,7 +134,7 @@ subroutine source_damage_isoBrittle_init phase = p - NofMyPhase=count(material_phaseMemberAt==phase) + NofMyPhase = count(material_phaseAt==phase) * discretization_nIP instance = source_damage_isoBrittle_instance(phase) sourceOffset = source_damage_isoBrittle_offset(phase) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index b1d2ace28..65930cd07 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -8,6 +8,7 @@ module source_damage_isoDuctile use prec use debug use IO + use discretization use material use config @@ -132,7 +133,7 @@ subroutine source_damage_isoDuctile_init end associate phase = p - NofMyPhase=count(material_phaseMemberAt==phase) + NofMyPhase=count(material_phaseAt==phase) * discretization_nIP instance = source_damage_isoDuctile_instance(phase) sourceOffset = source_damage_isoDuctile_offset(phase) diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 58bb11c84..9b18efef5 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -7,6 +7,7 @@ module source_thermal_dissipation use prec use debug + use discretization use material use config @@ -75,7 +76,7 @@ subroutine source_thermal_dissipation_init if (all(phase_source(:,p) /= SOURCE_THERMAL_DISSIPATION_ID)) cycle instance = source_thermal_dissipation_instance(p) param(instance)%kappa = config_phase(p)%getFloat('dissipation_coldworkcoeff') - NofMyPhase=count(material_phaseMemberAt==p) + NofMyPhase = count(material_phaseAt==p) * discretization_nIP sourceOffset = source_thermal_dissipation_offset(p) call material_allocateSourceState(p,sourceOffset,NofMyPhase,0,0,0) diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 14684278f..1b9d03529 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -7,6 +7,7 @@ module source_thermal_externalheat use prec use debug + use discretization use material use config @@ -83,7 +84,7 @@ subroutine source_thermal_externalheat_init if (all(phase_source(:,p) /= SOURCE_thermal_externalheat_ID)) cycle instance = source_thermal_externalheat_instance(p) sourceOffset = source_thermal_externalheat_offset(p) - NofMyPhase=count(material_phaseMemberAt==p) + NofMyPhase = count(material_phaseAt==p) * discretization_nIP param(instance)%time = config_phase(p)%getFloats('externalheat_time') param(instance)%nIntervals = size(param(instance)%time) - 1 From 84b60259bfb6f713fec659361312f34f950e8612 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 10:08:04 +0200 Subject: [PATCH 11/49] apparently not needed --- src/CPFEM2.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 51d9af152..c9b497f9d 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -89,7 +89,6 @@ subroutine CPFEM_init fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5') - call HDF5_read(fileHandle,material_phase, 'recordedPhase') call HDF5_read(fileHandle,crystallite_F0, 'convergedF') call HDF5_read(fileHandle,crystallite_Fp0, 'convergedFp') call HDF5_read(fileHandle,crystallite_Fi0, 'convergedFi') @@ -158,7 +157,6 @@ subroutine CPFEM_age write(rankStr,'(a1,i0)')'_',worldrank fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','a') - call HDF5_write(fileHandle,material_phase, 'recordedPhase') call HDF5_write(fileHandle,crystallite_F0, 'convergedF') call HDF5_write(fileHandle,crystallite_Fp0, 'convergedFp') call HDF5_write(fileHandle,crystallite_Fi0, 'convergedFi') From 1cf9c5985026948b8d1eb96ce58a4d25c80dec90 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 13:03:30 +0200 Subject: [PATCH 12/49] standardizing import follows PEP style guide, encoding not needed for python3 --- processing/post/addAPS34IDEstrainCoords.py | 9 ++++++--- processing/post/addCalculation.py | 15 +++++++++++---- processing/post/addCauchy.py | 10 +++++++--- processing/post/addCompatibilityMismatch.py | 6 ++++-- processing/post/addCumulative.py | 10 +++++++--- processing/post/addCurl.py | 11 +++++++---- processing/post/addDerivative.py | 12 ++++++++---- processing/post/addDeterminant.py | 7 +++++-- processing/post/addDeviator.py | 6 ++++-- processing/post/addDisplacement.py | 11 +++++++---- processing/post/addDivergence.py | 11 +++++++---- processing/post/addEhkl.py | 10 +++++++--- processing/post/addEuclideanDistance.py | 11 ++++++++--- processing/post/addGaussian.py | 9 ++++++--- processing/post/addGradient.py | 11 +++++++---- processing/post/addIPFcolor.py | 9 ++++++--- processing/post/addIndexed.py | 9 ++++++--- processing/post/addInfo.py | 3 ++- processing/post/addLinked.py | 9 ++++++--- processing/post/addMises.py | 11 +++++++---- processing/post/addNorm.py | 9 ++++++--- processing/post/addOrientations.py | 9 ++++++--- processing/post/addPK2.py | 9 ++++++--- processing/post/addPole.py | 10 +++++++--- processing/post/addSchmidfactors.py | 11 +++++++---- processing/post/addSpectralDecomposition.py | 10 +++++++--- processing/post/addStrainTensors.py | 9 ++++++--- processing/post/averageDown.py | 10 +++++++--- processing/post/binXY.py | 10 +++++++--- processing/post/blowUp.py | 10 +++++++--- processing/post/filterTable.py | 13 +++++++++---- processing/post/groupTable.py | 11 +++++++---- processing/post/histogram.py | 10 +++++++--- processing/post/imageData.py | 10 +++++++--- processing/post/imageDataDeformed.py | 10 +++++++--- processing/post/imageDataRGB.py | 10 +++++++--- processing/post/mentat_colorMap.py | 7 +++++-- processing/post/perceptualUniformColorMap.py | 9 ++++++--- processing/post/permuteData.py | 10 +++++++--- processing/post/postResults.py | 12 +++++++++--- processing/post/reLabel.py | 10 +++++++--- processing/post/rotateData.py | 10 +++++++--- processing/post/scaleData.py | 10 +++++++--- processing/post/shiftData.py | 10 +++++++--- processing/post/sortTable.py | 10 +++++++--- processing/post/viewTable.py | 4 +++- processing/post/vtk2ang.py | 11 ++++++++--- processing/post/vtk_addGridData.py | 14 +++++++++----- processing/post/vtk_addPointCloudData.py | 12 ++++++++---- processing/post/vtk_addRectilinearGridData.py | 15 ++++++++++----- processing/post/vtk_pointCloud.py | 13 +++++++++---- processing/post/vtk_rectilinearGrid.py | 13 +++++++++---- 52 files changed, 356 insertions(+), 165 deletions(-) diff --git a/processing/post/addAPS34IDEstrainCoords.py b/processing/post/addAPS34IDEstrainCoords.py index 67231a368..fe834cf38 100755 --- a/processing/post/addAPS34IDEstrainCoords.py +++ b/processing/post/addAPS34IDEstrainCoords.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/addCalculation.py b/processing/post/addCalculation.py index 73edde9e8..db0428753 100755 --- a/processing/post/addCalculation.py +++ b/processing/post/addCalculation.py @@ -1,12 +1,19 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,re,sys,collections -import math,scipy,scipy.linalg # noqa -import numpy as np +import os +import sys from optparse import OptionParser +import re +import collections +import math # noqa + +import scipy # noqa +import scipy.linalg # noqa +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/addCauchy.py b/processing/post/addCauchy.py index c7b95f562..18c4ec215 100755 --- a/processing/post/addCauchy.py +++ b/processing/post/addCauchy.py @@ -1,14 +1,18 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/addCompatibilityMismatch.py b/processing/post/addCompatibilityMismatch.py index 1fe84bf2b..7556cb863 100755 --- a/processing/post/addCompatibilityMismatch.py +++ b/processing/post/addCompatibilityMismatch.py @@ -1,13 +1,15 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- import os import math +from optparse import OptionParser + import numpy as np import scipy.ndimage -from optparse import OptionParser + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/addCumulative.py b/processing/post/addCumulative.py index 392cbd69e..5f54456f1 100755 --- a/processing/post/addCumulative.py +++ b/processing/post/addCumulative.py @@ -1,14 +1,18 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/addCurl.py b/processing/post/addCurl.py index 5c9d46e2f..484af9677 100755 --- a/processing/post/addCurl.py +++ b/processing/post/addCurl.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,math -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) @@ -27,7 +30,7 @@ def curlFFT(geomdim,field): curl_fourier = np.empty(field_fourier.shape,'c16') # differentiation in Fourier space - TWOPIIMG = 2.0j*math.pi + TWOPIIMG = 2.0j*np.pi einsums = { 3:'slm,ijkl,ijkm->ijks', # vector, 3 -> 3 9:'slm,ijkl,ijknm->ijksn', # tensor, 3x3 -> 3x3 diff --git a/processing/post/addDerivative.py b/processing/post/addDerivative.py index 7967af4b2..8ebfdf2da 100755 --- a/processing/post/addDerivative.py +++ b/processing/post/addDerivative.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) @@ -29,7 +32,8 @@ def derivative(coordinates,what): (coordinates[-1] - coordinates[-2]) return result - + + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/addDeterminant.py b/processing/post/addDeterminant.py index 897f2364b..14f0321be 100755 --- a/processing/post/addDeterminant.py +++ b/processing/post/addDeterminant.py @@ -1,10 +1,12 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys +import os +import sys from optparse import OptionParser + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) @@ -16,6 +18,7 @@ def determinant(m): -m[1]*m[3]*m[8] \ -m[0]*m[5]*m[7] + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/addDeviator.py b/processing/post/addDeviator.py index 220b29ec8..c9aeaacfd 100755 --- a/processing/post/addDeviator.py +++ b/processing/post/addDeviator.py @@ -1,8 +1,9 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys +import os +import sys from optparse import OptionParser + import damask scriptName = os.path.splitext(os.path.basename(__file__))[0] @@ -19,6 +20,7 @@ def deviator(m,spherical = False): ] return dev,sph if spherical else dev + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/addDisplacement.py b/processing/post/addDisplacement.py index 53311ce9e..99d07fd18 100755 --- a/processing/post/addDisplacement.py +++ b/processing/post/addDisplacement.py @@ -1,12 +1,15 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,math +import os +import sys +from optparse import OptionParser + import numpy as np import scipy.ndimage -from optparse import OptionParser + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) @@ -57,7 +60,7 @@ def displacementAvgFFT(F,grid,size,nodal=False,transformed=False): #-------------------------------------------------------------------------------------------------- def displacementFluctFFT(F,grid,size,nodal=False,transformed=False): """Calculate cell center (or nodal) displacement for deformation gradient field specified in each grid cell""" - integrator = 0.5j * size / math.pi + integrator = 0.5j * size / np.pi kk, kj, ki = np.meshgrid(np.where(np.arange(grid[2])>grid[2]//2,np.arange(grid[2])-grid[2],np.arange(grid[2])), np.where(np.arange(grid[1])>grid[1]//2,np.arange(grid[1])-grid[1],np.arange(grid[1])), diff --git a/processing/post/addDivergence.py b/processing/post/addDivergence.py index f579a0a49..31a18f8e1 100755 --- a/processing/post/addDivergence.py +++ b/processing/post/addDivergence.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,math -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) @@ -27,7 +30,7 @@ def divFFT(geomdim,field): div_fourier = np.empty(field_fourier.shape[0:len(np.shape(field))-1],'c16') # differentiation in Fourier space - TWOPIIMG = 2.0j*math.pi + TWOPIIMG = 2.0j*np.pi einsums = { 3:'ijkl,ijkl->ijk', # vector, 3 -> 1 9:'ijkm,ijklm->ijkl', # tensor, 3x3 -> 3 diff --git a/processing/post/addEhkl.py b/processing/post/addEhkl.py index 573484617..4cf846814 100755 --- a/processing/post/addEhkl.py +++ b/processing/post/addEhkl.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) @@ -26,6 +29,7 @@ def E_hkl(stiffness,vec): # stiffness = (c11,c12,c44) return 1.0/invE + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/addEuclideanDistance.py b/processing/post/addEuclideanDistance.py index b11f46fd8..1ca2169f6 100755 --- a/processing/post/addEuclideanDistance.py +++ b/processing/post/addEuclideanDistance.py @@ -1,12 +1,16 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,itertools +import os +import sys +from optparse import OptionParser +import itertools + import numpy as np from scipy import ndimage -from optparse import OptionParser + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) @@ -31,6 +35,7 @@ def periodic_3Dpad(array, rimdim=(1,1,1)): padded[p[0],p[1],p[2]] = array[spot[0],spot[1],spot[2]] return padded + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/addGaussian.py b/processing/post/addGaussian.py index 3f237a3e6..9b601a1dc 100755 --- a/processing/post/addGaussian.py +++ b/processing/post/addGaussian.py @@ -1,12 +1,15 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np from scipy import ndimage + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/addGradient.py b/processing/post/addGradient.py index 080ec0bcd..bfadb578e 100755 --- a/processing/post/addGradient.py +++ b/processing/post/addGradient.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,math -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) @@ -27,7 +30,7 @@ def gradFFT(geomdim,field): grad_fourier = np.empty(field_fourier.shape+(3,),'c16') # differentiation in Fourier space - TWOPIIMG = 2.0j*math.pi + TWOPIIMG = 2.0j*np.pi einsums = { 1:'ijkl,ijkm->ijkm', # scalar, 1 -> 3 3:'ijkl,ijkm->ijklm', # vector, 3 -> 3x3 diff --git a/processing/post/addIPFcolor.py b/processing/post/addIPFcolor.py index c5e4d8704..0149dd078 100755 --- a/processing/post/addIPFcolor.py +++ b/processing/post/addIPFcolor.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/addIndexed.py b/processing/post/addIndexed.py index 9a73f5572..1d9c3cfb2 100755 --- a/processing/post/addIndexed.py +++ b/processing/post/addIndexed.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/addInfo.py b/processing/post/addInfo.py index fbfa8c3dd..2d8192cc1 100755 --- a/processing/post/addInfo.py +++ b/processing/post/addInfo.py @@ -1,10 +1,11 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- import os from optparse import OptionParser + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/addLinked.py b/processing/post/addLinked.py index bed3da30a..f13f3c632 100755 --- a/processing/post/addLinked.py +++ b/processing/post/addLinked.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/addMises.py b/processing/post/addMises.py index 6593eeef8..be11b0f1c 100755 --- a/processing/post/addMises.py +++ b/processing/post/addMises.py @@ -1,12 +1,15 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,math -import numpy as np +import os +import sys from optparse import OptionParser from collections import OrderedDict + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) @@ -14,7 +17,7 @@ def Mises(what,tensor): dev = tensor - np.trace(tensor)/3.0*np.eye(3) symdev = 0.5*(dev+dev.T) - return math.sqrt(np.sum(symdev*symdev.T)* + return np.sqrt(np.sum(symdev*symdev.T)* { 'stress': 3.0/2.0, 'strain': 2.0/3.0, diff --git a/processing/post/addNorm.py b/processing/post/addNorm.py index efadc0f52..ff8b4956a 100755 --- a/processing/post/addNorm.py +++ b/processing/post/addNorm.py @@ -1,10 +1,12 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,math +import os +import sys from optparse import OptionParser + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) @@ -16,12 +18,13 @@ def norm(which,object): if which == 'Abs': # p = 1 return sum(map(abs, object)) elif which == 'Frobenius': # p = 2 - return math.sqrt(sum([x*x for x in object])) + return np.sqrt(sum([x*x for x in object])) elif which == 'Max': # p = inf return max(map(abs, object)) else: return -1 + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index 47c30c132..ee2c5f433 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/addPK2.py b/processing/post/addPK2.py index cddcd7002..f38753619 100755 --- a/processing/post/addPK2.py +++ b/processing/post/addPK2.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/addPole.py b/processing/post/addPole.py index 5116589b4..c8b83b106 100755 --- a/processing/post/addPole.py +++ b/processing/post/addPole.py @@ -1,14 +1,18 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/addSchmidfactors.py b/processing/post/addSchmidfactors.py index b4033a035..30610213e 100755 --- a/processing/post/addSchmidfactors.py +++ b/processing/post/addSchmidfactors.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,math -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) @@ -136,7 +139,7 @@ parser.set_defaults(force = (0.0,0.0,1.0), quaternion='orientation', normal = None, lattice = latticeChoices[0], - CoverA = math.sqrt(8./3.), + CoverA = np.sqrt(8./3.), ) (options, filenames) = parser.parse_args() diff --git a/processing/post/addSpectralDecomposition.py b/processing/post/addSpectralDecomposition.py index f3c25b117..c711c6a45 100755 --- a/processing/post/addSpectralDecomposition.py +++ b/processing/post/addSpectralDecomposition.py @@ -1,14 +1,18 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/addStrainTensors.py b/processing/post/addStrainTensors.py index 375b0b5e8..2d62c31ae 100755 --- a/processing/post/addStrainTensors.py +++ b/processing/post/addStrainTensors.py @@ -1,11 +1,14 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/averageDown.py b/processing/post/averageDown.py index 3a70cf314..d94bc8dbd 100755 --- a/processing/post/averageDown.py +++ b/processing/post/averageDown.py @@ -1,15 +1,19 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys +import os +import sys +from optparse import OptionParser + import numpy as np import scipy.ndimage -from optparse import OptionParser + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/binXY.py b/processing/post/binXY.py index dc286b7ac..baa054dec 100755 --- a/processing/post/binXY.py +++ b/processing/post/binXY.py @@ -1,14 +1,18 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/blowUp.py b/processing/post/blowUp.py index d596bb751..3dccb1aaf 100755 --- a/processing/post/blowUp.py +++ b/processing/post/blowUp.py @@ -1,14 +1,18 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/filterTable.py b/processing/post/filterTable.py index 2703ea274..2788ccefb 100755 --- a/processing/post/filterTable.py +++ b/processing/post/filterTable.py @@ -1,12 +1,17 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,re,sys,fnmatch -import math # noqa -import numpy as np +import os +import sys from optparse import OptionParser +import re +import fnmatch +import math # noqa + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/groupTable.py b/processing/post/groupTable.py index d97861495..33c2298b9 100755 --- a/processing/post/groupTable.py +++ b/processing/post/groupTable.py @@ -1,12 +1,15 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import math # noqa -import numpy as np +import os +import sys from optparse import OptionParser, OptionGroup +import math # noqa + +import numpy as np + import damask + def periodicAverage(coords, limits): """Centroid in periodic domain, see https://en.wikipedia.org/wiki/Center_of_mass#Systems_with_periodic_boundary_conditions""" theta = 2.0*np.pi * (coords - limits[0])/(limits[1] - limits[0]) diff --git a/processing/post/histogram.py b/processing/post/histogram.py index 0f7d73fdc..1f1c52d4c 100755 --- a/processing/post/histogram.py +++ b/processing/post/histogram.py @@ -1,14 +1,18 @@ #!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/imageData.py b/processing/post/imageData.py index 41996a3c6..61935514b 100755 --- a/processing/post/imageData.py +++ b/processing/post/imageData.py @@ -1,15 +1,19 @@ #!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np from PIL import Image + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/imageDataDeformed.py b/processing/post/imageDataDeformed.py index 5436e1fbd..d871f2af9 100755 --- a/processing/post/imageDataDeformed.py +++ b/processing/post/imageDataDeformed.py @@ -1,15 +1,19 @@ #!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np from PIL import Image, ImageDraw + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/imageDataRGB.py b/processing/post/imageDataRGB.py index 4f124507e..d80c61e0f 100755 --- a/processing/post/imageDataRGB.py +++ b/processing/post/imageDataRGB.py @@ -1,15 +1,19 @@ #!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np from PIL import Image + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/mentat_colorMap.py b/processing/post/mentat_colorMap.py index 4fad5cd8f..7f5c67123 100755 --- a/processing/post/mentat_colorMap.py +++ b/processing/post/mentat_colorMap.py @@ -1,10 +1,13 @@ #!/usr/bin/env python2.7 # -*- coding: UTF-8 no BOM -*- -import os,sys -import damask +import os +import sys from optparse import OptionParser +import damask + + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/perceptualUniformColorMap.py b/processing/post/perceptualUniformColorMap.py index b9f31d492..8e432536d 100755 --- a/processing/post/perceptualUniformColorMap.py +++ b/processing/post/perceptualUniformColorMap.py @@ -1,13 +1,16 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import sys,os -import damask +import os +import sys from optparse import OptionParser +import damask + + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/permuteData.py b/processing/post/permuteData.py index d263e42b8..c0fee3694 100755 --- a/processing/post/permuteData.py +++ b/processing/post/permuteData.py @@ -1,14 +1,18 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/postResults.py b/processing/post/postResults.py index c1703efda..31a78440b 100755 --- a/processing/post/postResults.py +++ b/processing/post/postResults.py @@ -1,9 +1,15 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,math,re,time,struct -import damask +import os +import sys from optparse import OptionParser, OptionGroup +import math +import re +import time +import struct + +import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/reLabel.py b/processing/post/reLabel.py index a8d0e1556..e7ad1f1e9 100755 --- a/processing/post/reLabel.py +++ b/processing/post/reLabel.py @@ -1,13 +1,17 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,re -import damask +import os +import sys from optparse import OptionParser +import re + +import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 84e796450..aa7c32f79 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -1,14 +1,18 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/scaleData.py b/processing/post/scaleData.py index 368180f93..5b03f8e07 100755 --- a/processing/post/scaleData.py +++ b/processing/post/scaleData.py @@ -1,14 +1,18 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/shiftData.py b/processing/post/shiftData.py index f490ee66e..69a9696fa 100755 --- a/processing/post/shiftData.py +++ b/processing/post/shiftData.py @@ -1,14 +1,18 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/sortTable.py b/processing/post/sortTable.py index 1af1b787a..53a357226 100755 --- a/processing/post/sortTable.py +++ b/processing/post/sortTable.py @@ -1,14 +1,18 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys -import numpy as np +import os +import sys from optparse import OptionParser + +import numpy as np + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/viewTable.py b/processing/post/viewTable.py index 514ea40d9..87880d15d 100755 --- a/processing/post/viewTable.py +++ b/processing/post/viewTable.py @@ -1,13 +1,15 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- import os from optparse import OptionParser + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/vtk2ang.py b/processing/post/vtk2ang.py index 123dc5b98..eb94f7d8a 100755 --- a/processing/post/vtk2ang.py +++ b/processing/post/vtk2ang.py @@ -1,11 +1,16 @@ #!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- -import os,string,math,sys -import numpy as np +import os +import sys from optparse import OptionParser +import string +import math + +import numpy as np import vtk + import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py index 5ed50b60e..b9beb6abe 100755 --- a/processing/post/vtk_addGridData.py +++ b/processing/post/vtk_addGridData.py @@ -1,15 +1,19 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,vtk -import damask -from vtk.util import numpy_support -from collections import defaultdict +import os from optparse import OptionParser +from collections import defaultdict + +import vtk +from vtk.util import numpy_support + +import damask + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/vtk_addPointCloudData.py b/processing/post/vtk_addPointCloudData.py index f37def80a..96bacae8a 100755 --- a/processing/post/vtk_addPointCloudData.py +++ b/processing/post/vtk_addPointCloudData.py @@ -1,15 +1,19 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,vtk -import damask -from collections import defaultdict +import os from optparse import OptionParser +from collections import defaultdict + +import vtk from vtk.util import numpy_support +import damask + + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/vtk_addRectilinearGridData.py b/processing/post/vtk_addRectilinearGridData.py index 890b28fa8..6f5e44e35 100755 --- a/processing/post/vtk_addRectilinearGridData.py +++ b/processing/post/vtk_addRectilinearGridData.py @@ -1,15 +1,20 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,vtk -import damask -from vtk.util import numpy_support -from collections import defaultdict +import os from optparse import OptionParser +from collections import defaultdict + +import vtk +from vtk.util import numpy_support + +import damask + + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/vtk_pointCloud.py b/processing/post/vtk_pointCloud.py index 93b4f61bf..06aad0aca 100755 --- a/processing/post/vtk_pointCloud.py +++ b/processing/post/vtk_pointCloud.py @@ -1,14 +1,19 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,vtk -import numpy as np -import damask +import os +import sys from optparse import OptionParser +import vtk +import numpy as np + +import damask + + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- diff --git a/processing/post/vtk_rectilinearGrid.py b/processing/post/vtk_rectilinearGrid.py index 295df2714..bb29a5d4c 100755 --- a/processing/post/vtk_rectilinearGrid.py +++ b/processing/post/vtk_rectilinearGrid.py @@ -1,14 +1,19 @@ #!/usr/bin/env python3 -# -*- coding: UTF-8 no BOM -*- -import os,sys,vtk -import numpy as np -import damask +import os +import sys from optparse import OptionParser +import vtk +import numpy as np + +import damask + + scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) + # -------------------------------------------------------------------- # MAIN # -------------------------------------------------------------------- From b720d2b2d787ca98075559940ea61b4a4858b901 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 17:24:26 +0200 Subject: [PATCH 13/49] all keys are small letters --- src/plastic_dislotwin.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index f118b1dca..ad0ba41b6 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -461,7 +461,7 @@ subroutine plastic_dislotwin_init case ('gamma_sl') outputID = merge(gamma_sl_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl - case ('Lambda_sl') + case ('lambda_sl') outputID = merge(Lambda_sl_ID,undefined_ID,prm%sum_N_sl > 0) outputSize = prm%sum_N_sl case ('tau_pass') @@ -471,7 +471,7 @@ subroutine plastic_dislotwin_init case ('f_tw') outputID = merge(f_tw_ID,undefined_ID,prm%sum_N_tw >0) outputSize = prm%sum_N_tw - case ('Lambda_tw') + case ('lambda_tw') outputID = merge(Lambda_tw_ID,undefined_ID,prm%sum_N_tw >0) outputSize = prm%sum_N_tw case ('tau_hat_tw') From 4ee17e747fc4aac90343a7b9c8ccbb5ed509714b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 17:25:00 +0200 Subject: [PATCH 14/49] tests with correct names for dislotwin --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 93bc0c8a1..372d3746b 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 93bc0c8a1de2944add043b58159bf9b6e4193752 +Subproject commit 372d3746b2e4863e83fa34fe9a32082237cb63de From eb8be13203c95fb578dc5e83f6e51283c4e2162a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Jun 2019 17:27:00 +0200 Subject: [PATCH 15/49] missing import --- processing/post/addNorm.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/processing/post/addNorm.py b/processing/post/addNorm.py index ff8b4956a..c8c0b05bf 100755 --- a/processing/post/addNorm.py +++ b/processing/post/addNorm.py @@ -4,6 +4,8 @@ import os import sys from optparse import OptionParser +import numpy as np + import damask From a8ed982706eaaa20c799e490fb42859449da8b4a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 07:31:30 +0200 Subject: [PATCH 16/49] [skip ci] better name --- processing/post/{concatenateTable.py => growTable.py} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename processing/post/{concatenateTable.py => growTable.py} (100%) diff --git a/processing/post/concatenateTable.py b/processing/post/growTable.py similarity index 100% rename from processing/post/concatenateTable.py rename to processing/post/growTable.py From 937a84231f6e5fbf9e721a0fb7982bfafb28bd7e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 13:57:24 +0200 Subject: [PATCH 17/49] material_phase is deprecated --- src/CPFEM.f90 | 9 --------- src/constitutive.f90 | 4 ++-- src/damage_nonlocal.f90 | 4 ++-- src/homogenization.f90 | 4 ++-- src/thermal_adiabatic.f90 | 4 ++-- src/thermal_conduction.f90 | 6 +++--- 6 files changed, 11 insertions(+), 20 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index be11c0107..1e33d87c1 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -125,11 +125,6 @@ subroutine CPFEM_init ! flush(6) ! endif - - ! call IO_read_intFile(777,'recordedPhase'//trim(rankStr),modelName,size(material_phase)) - ! read (777,rec=1) material_phase - ! close (777) - ! call IO_read_realFile(777,'convergedF'//trim(rankStr),modelName,size(crystallite_F0)) ! read (777,rec=1) crystallite_F0 ! close (777) @@ -280,10 +275,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt ! write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files' ! - ! call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase)) - ! write (777,rec=1) material_phase - ! close (777) - ! call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0)) ! write (777,rec=1) crystallite_F0 ! close (777) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index ec66ab126..72798e399 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -114,7 +114,7 @@ subroutine constitutive_init ! write description file for constitutive output call IO_write_jobFile(FILEUNIT,'outputConstitutive') PhaseLoop: do ph = 1,material_Nphase - activePhase: if (any(material_phase == ph)) then + activePhase: if (any(material_phaseAt == ph)) then ins = phase_plasticityInstance(ph) knownPlasticity = .true. ! assume valid plasticityType: select case(phase_plasticity(ph)) @@ -255,7 +255,7 @@ function constitutive_homogenizedC(ipc,ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType constitutive_homogenizedC = plastic_dislotwin_homogenizedC(ipc,ip,el) case default plasticityType - constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phase (ipc,ip,el)) + constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phaseAt(ipc,el)) end select plasticityType end function constitutive_homogenizedC diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index dce88bc61..73056d3c9 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -194,7 +194,7 @@ function damage_nonlocal_getDiffusion33(ip,el) damage_nonlocal_getDiffusion33 = 0.0_pReal do grain = 1, homogenization_Ngrains(homog) damage_nonlocal_getDiffusion33 = damage_nonlocal_getDiffusion33 + & - crystallite_push33ToRef(grain,ip,el,lattice_DamageDiffusion33(1:3,1:3,material_phase(grain,ip,el))) + crystallite_push33ToRef(grain,ip,el,lattice_DamageDiffusion33(1:3,1:3,material_phaseAt(grain,el))) enddo damage_nonlocal_getDiffusion33 = & @@ -217,7 +217,7 @@ real(pReal) function damage_nonlocal_getMobility(ip,el) damage_nonlocal_getMobility = 0.0_pReal do ipc = 1, homogenization_Ngrains(material_homogenizationAt(el)) - damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el)) + damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phaseAt(ipc,el)) enddo damage_nonlocal_getMobility = damage_nonlocal_getMobility/& diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 9f7890131..4c90f1c38 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -621,8 +621,8 @@ subroutine materialpoint_postResults grainLooping :do g = 1,myNgrains theSize = 1 + crystallite_sizePostResults(myCrystallite) + & - 1 + plasticState (material_phase(g,i,e))%sizePostResults + & !ToDo - sum(sourceState(material_phase(g,i,e))%p(:)%sizePostResults) + 1 + plasticState (material_phaseAt(g,e))%sizePostResults + & !ToDo + sum(sourceState(material_phaseAt(g,e))%p(:)%sizePostResults) materialpoint_results(thePos+1:thePos+theSize,i,e) = crystallite_postResults(g,i,e) ! tell crystallite results thePos = thePos + theSize enddo grainLooping diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index 76f519913..2aa69bec5 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -215,7 +215,7 @@ function thermal_adiabatic_getSpecificHeat(ip,el) do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat + & - lattice_specificHeat(material_phase(grain,ip,el)) + lattice_specificHeat(material_phaseAt(grain,el)) enddo thermal_adiabatic_getSpecificHeat = & @@ -242,7 +242,7 @@ function thermal_adiabatic_getMassDensity(ip,el) do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity + & - lattice_massDensity(material_phase(grain,ip,el)) + lattice_massDensity(material_phaseAt(grain,el)) enddo thermal_adiabatic_getMassDensity = & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index c70c59b60..e513d709f 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -179,7 +179,7 @@ function thermal_conduction_getConductivity33(ip,el) thermal_conduction_getConductivity33 = 0.0_pReal do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) thermal_conduction_getConductivity33 = thermal_conduction_getConductivity33 + & - crystallite_push33ToRef(grain,ip,el,lattice_thermalConductivity33(:,:,material_phase(grain,ip,el))) + crystallite_push33ToRef(grain,ip,el,lattice_thermalConductivity33(:,:,material_phaseAt(grain,el))) enddo thermal_conduction_getConductivity33 = & @@ -206,7 +206,7 @@ function thermal_conduction_getSpecificHeat(ip,el) do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat + & - lattice_specificHeat(material_phase(grain,ip,el)) + lattice_specificHeat(material_phaseAt(grain,el)) enddo thermal_conduction_getSpecificHeat = & @@ -232,7 +232,7 @@ function thermal_conduction_getMassDensity(ip,el) do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) thermal_conduction_getMassDensity = thermal_conduction_getMassDensity & - + lattice_massDensity(material_phase(grain,ip,el)) + + lattice_massDensity(material_phaseAt(grain,el)) enddo thermal_conduction_getMassDensity = & From 8c5d0a5591c3544182a6b5fb8c6172862c0cfcf7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 14:10:45 +0200 Subject: [PATCH 18/49] populateGrains and material_phase not needed --- src/material.f90 | 65 ++++++++++++++++-------------------------------- 1 file changed, 21 insertions(+), 44 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index f4014ec84..be2985fff 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -138,10 +138,6 @@ module material integer, dimension(:,:,:), allocatable, public, protected :: & ! (constituent,ip,elem) material_phaseMemberAt !< position of the element within its phase instance ! END NEW MAPPINGS - -! DEPRECATED: use material_phaseAt - integer, dimension(:,:,:), allocatable, public :: & - material_phase !< phase (index) of each grain,IP,element type(tPlasticState), allocatable, dimension(:), public :: & plasticState @@ -230,21 +226,18 @@ module material material_parseMicrostructure, & material_parseCrystallite, & material_parsePhase, & - material_parseTexture, & - material_populateGrains + material_parseTexture contains !-------------------------------------------------------------------------------------------------- !> @brief parses material configuration file -!> @details figures out if solverJobName.materialConfig is present, if not looks for -!> material.config !-------------------------------------------------------------------------------------------------- subroutine material_init integer, parameter :: FILEUNIT = 210 - integer :: i,e,m,c,h, myDebug, myPhase, myHomog + integer :: i,e,m,c,h, myDebug, myPhase, myHomog, myMicro integer, dimension(:), allocatable :: & CounterPhase, & CounterHomogenization @@ -322,10 +315,27 @@ subroutine material_init enddo endif debugOut - call material_populateGrains - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! new mappings + allocate(material_phaseAt(homogenization_maxNgrains,discretization_nElem), source=0) + allocate(material_texture(homogenization_maxNgrains,discretization_nIP,discretization_nElem), source=0) !this is only needed by plasticity nonlocal + allocate(material_EulerAngles(3,homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0.0_pReal) + + do e = 1, discretization_nElem + do i = 1, discretization_nIP + myMicro = discretization_microstructureAt(e) + do c = 1, homogenization_Ngrains(discretization_homogenizationAt(e)) + material_phaseAt(c,e) = microstructure_phase(c,myMicro) + material_texture(c,i,e) = microstructure_texture(c,myMicro) + material_EulerAngles(1:3,c,i,e) = texture_Gauss(1:3,material_texture(c,i,e)) ! this is a copy of crystallite_orientation0 + enddo + enddo + enddo + + deallocate(microstructure_phase) + deallocate(microstructure_texture) + + allocate(material_homogenizationAt,source=discretization_homogenizationAt) allocate(material_homogenizationMemberAt(discretization_nIP,discretization_nElem),source=0) @@ -338,8 +348,6 @@ subroutine material_init enddo enddo - - allocate(material_phaseAt(homogenization_maxNgrains,discretization_nElem), source=material_phase(:,1,:)) allocate(material_phaseMemberAt(homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0) allocate(CounterPhase(size(config_phase)),source=0) @@ -834,35 +842,4 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,& end subroutine material_allocateSourceState - -!-------------------------------------------------------------------------------------------------- -!> @brief populates the grains -!> @details populates the grains by identifying active microstructure/homogenization pairs, -!! calculates the volume of the grains and deals with texture components -!-------------------------------------------------------------------------------------------------- -subroutine material_populateGrains - - integer :: e,i,c,homog,micro - - allocate(material_phase(homogenization_maxNgrains,discretization_nIP,discretization_nElem), source=0) - allocate(material_texture(homogenization_maxNgrains,discretization_nIP,discretization_nElem), source=0) - allocate(material_EulerAngles(3,homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0.0_pReal) - - do e = 1, discretization_nElem - do i = 1, discretization_nIP - homog = discretization_homogenizationAt(e) - micro = discretization_microstructureAt(e) - do c = 1, homogenization_Ngrains(homog) - material_phase(c,i,e) = microstructure_phase(c,micro) - material_texture(c,i,e) = microstructure_texture(c,micro) - material_EulerAngles(1:3,c,i,e) = texture_Gauss(1:3,material_texture(c,i,e)) - enddo - enddo - enddo - - deallocate(microstructure_phase) - deallocate(microstructure_texture) - -end subroutine material_populateGrains - end module material From 57a0d3329318eb2172ebbb8b087ba1993117f16c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 14:26:32 +0200 Subject: [PATCH 19/49] consistent names --- src/config.f90 | 19 +++++++++---------- src/constitutive.f90 | 6 +++--- src/crystallite.f90 | 5 +---- src/homogenization.f90 | 4 +--- src/material.f90 | 14 +++++++------- 5 files changed, 21 insertions(+), 27 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index cd67c4641..bb4d82bb9 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -26,13 +26,12 @@ module config config_numerics, & config_debug - !ToDo: bad names (how should one know that those variables are defined in config?) character(len=64), dimension(:), allocatable, public, protected :: & - phase_name, & !< name of each phase - homogenization_name, & !< name of each homogenization - crystallite_name, & !< name of each crystallite setting - microstructure_name, & !< name of each microstructure - texture_name !< name of each texture + config_name_phase, & !< name of each phase + config_name_homogenization, & !< name of each homogenization + config_name_crystallite, & !< name of each crystallite setting + config_name_microstructure, & !< name of each microstructure + config_name_texture !< name of each texture ! ToDo: Remove, use size(config_phase) etc @@ -81,19 +80,19 @@ subroutine config_init select case (trim(part)) case (trim('phase')) - call parse_materialConfig(phase_name,config_phase,line,fileContent(i+1:)) + call parse_materialConfig(config_name_phase,config_phase,line,fileContent(i+1:)) if (verbose) write(6,'(a)') ' Phase parsed'; flush(6) case (trim('microstructure')) - call parse_materialConfig(microstructure_name,config_microstructure,line,fileContent(i+1:)) + call parse_materialConfig(config_name_microstructure,config_microstructure,line,fileContent(i+1:)) if (verbose) write(6,'(a)') ' Microstructure parsed'; flush(6) case (trim('crystallite')) - call parse_materialConfig(crystallite_name,config_crystallite,line,fileContent(i+1:)) + call parse_materialConfig(config_name_crystallite,config_crystallite,line,fileContent(i+1:)) if (verbose) write(6,'(a)') ' Crystallite parsed'; flush(6) case (trim('homogenization')) - call parse_materialConfig(homogenization_name,config_homogenization,line,fileContent(i+1:)) + call parse_materialConfig(config_name_homogenization,config_homogenization,line,fileContent(i+1:)) if (verbose) write(6,'(a)') ' Homogenization parsed'; flush(6) case (trim('texture')) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 72798e399..cf4f3706b 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -149,7 +149,7 @@ subroutine constitutive_init case default plasticityType knownPlasticity = .false. end select plasticityType - write(FILEUNIT,'(/,a,/)') '['//trim(phase_name(ph))//']' + write(FILEUNIT,'(/,a,/)') '['//trim(config_name_phase(ph))//']' if (knownPlasticity) then write(FILEUNIT,'(a)') '(plasticity)'//char(9)//trim(outputName) if (phase_plasticity(ph) /= PLASTICITY_NONE_ID) then @@ -794,8 +794,8 @@ subroutine constitutive_results integer :: p character(len=256) :: group #if defined(PETSc) || defined(DAMASK_HDF5) - do p=1,size(phase_name) - group = trim('current/constituent')//'/'//trim(phase_name(p)) + do p=1,size(config_name_phase) + group = trim('current/constituent')//'/'//trim(config_name_phase(p)) call HDF5_closeGroup(results_addGroup(group)) group = trim(group)//'/plastic' diff --git a/src/crystallite.f90 b/src/crystallite.f90 index e47eac4df..a779c3223 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -364,7 +364,7 @@ subroutine crystallite_init do r = 1,size(config_crystallite) if (any(microstructure_crystallite(discretization_microstructureAt) == r)) then - write(FILEUNIT,'(/,a,/)') '['//trim(crystallite_name(r))//']' + write(FILEUNIT,'(/,a,/)') '['//trim(config_name_crystallite(r))//']' do o = 1,crystallite_Noutput(r) write(FILEUNIT,'(a,i4)') trim(crystallite_output(o,r))//char(9),crystallite_sizePostResult(o,r) enddo @@ -982,9 +982,6 @@ end function crystallite_postResults !-------------------------------------------------------------------------------------------------- subroutine crystallite_results #if defined(PETSc) || defined(DAMASK_HDF5) - use config, only: & - config_name_phase => phase_name ! anticipate logical name - integer :: p,o real(pReal), allocatable, dimension(:,:,:) :: selected_tensors type(rotation), allocatable, dimension(:) :: selected_rotations diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 4c90f1c38..93227bf6b 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -164,7 +164,7 @@ subroutine homogenization_init call IO_write_jobFile(FILEUNIT,'outputHomogenization') do p = 1,size(config_homogenization) if (any(material_homogenizationAt == p)) then - write(FILEUNIT,'(/,a,/)') '['//trim(homogenization_name(p))//']' + write(FILEUNIT,'(/,a,/)') '['//trim(config_name_homogenization(p))//']' write(FILEUNIT,'(a)') '(type) n/a' write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) @@ -797,8 +797,6 @@ end function postResults !-------------------------------------------------------------------------------------------------- subroutine homogenization_results #if defined(PETSc) || defined(DAMASK_HDF5) - use config, only: & - config_name_homogenization => homogenization_name ! anticipate logical name use material, only: & material_homogenization_type => homogenization_type diff --git a/src/material.f90 b/src/material.f90 index be2985fff..e01735b05 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -297,17 +297,17 @@ subroutine material_init write(6,'(/,a,/)') ' MATERIAL configuration' write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' do h = 1,size(config_homogenization) - write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h) + write(6,'(1x,a32,1x,a16,1x,i6)') config_name_homogenization(h),homogenization_type(h),homogenization_Ngrains(h) enddo write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents' do m = 1,size(config_microstructure) - write(6,'(1x,a32,1x,i11,1x,i12)') microstructure_name(m), & + write(6,'(1x,a32,1x,i11,1x,i12)') config_name_microstructure(m), & microstructure_crystallite(m), & microstructure_Nconstituents(m) if (microstructure_Nconstituents(m) > 0) then do c = 1,microstructure_Nconstituents(m) - write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(c,m)),& - texture_name(microstructure_texture(c,m)),& + write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',config_name_phase(microstructure_phase(c,m)),& + config_name_texture(microstructure_texture(c,m)),& microstructure_fraction(c,m) enddo write(6,*) @@ -366,8 +366,8 @@ subroutine material_init #if defined(PETSc) || defined(DAMASK_HDF5) call results_openJobFile - call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,phase_name) - call results_mapping_materialpoint(material_homogenizationAt,material_homogenizationMemberAt,homogenization_name) + call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,config_name_phase) + call results_mapping_materialpoint(material_homogenizationAt,material_homogenizationMemberAt,config_name_homogenization) call results_closeJobFile #endif @@ -545,7 +545,7 @@ subroutine material_parseMicrostructure enddo enddo - if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) call IO_error(153,ext_msg=microstructure_name(m)) + if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) call IO_error(153,ext_msg=config_name_microstructure(m)) enddo From 856ef1518454be61c85f2b8343fd7cc2f220d47f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 15:30:41 +0200 Subject: [PATCH 20/49] moved (back) to a better place --- src/config.f90 | 15 +++------------ src/material.f90 | 30 +++++++++++++++++++----------- 2 files changed, 22 insertions(+), 23 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index bb4d82bb9..85efcb82f 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -33,12 +33,6 @@ module config config_name_microstructure, & !< name of each microstructure config_name_texture !< name of each texture - -! ToDo: Remove, use size(config_phase) etc - integer, public, protected :: & - material_Nphase, & !< number of phases - material_Nhomogenization !< number of homogenizations - public :: & config_init, & config_deallocate @@ -96,20 +90,17 @@ subroutine config_init if (verbose) write(6,'(a)') ' Homogenization parsed'; flush(6) case (trim('texture')) - call parse_materialConfig(texture_name,config_texture,line,fileContent(i+1:)) + call parse_materialConfig(config_name_texture,config_texture,line,fileContent(i+1:)) if (verbose) write(6,'(a)') ' Texture parsed'; flush(6) end select enddo - material_Nhomogenization = size(config_homogenization) - material_Nphase = size(config_phase) - - if (material_Nhomogenization < 1) call IO_error(160,ext_msg='') + if (size(config_homogenization) < 1) call IO_error(160,ext_msg='') if (size(config_microstructure) < 1) call IO_error(160,ext_msg='') if (size(config_crystallite) < 1) call IO_error(160,ext_msg='') - if (material_Nphase < 1) call IO_error(160,ext_msg='') + if (size(config_phase) < 1) call IO_error(160,ext_msg='') if (size(config_texture) < 1) call IO_error(160,ext_msg='') diff --git a/src/material.f90 b/src/material.f90 index e01735b05..4163812ee 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -98,6 +98,10 @@ module material integer(kind(DAMAGE_none_ID)), dimension(:), allocatable, public, protected :: & damage_type !< nonlocal damage model + integer, public, protected :: & + material_Nphase, & !< number of phases + material_Nhomogenization !< number of homogenizations + integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable, public, protected :: & phase_source, & !< active sources mechanisms of each phase phase_kinematics, & !< active kinematic mechanisms of each phase @@ -260,24 +264,28 @@ subroutine material_init call material_parseTexture() if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture parsed'; flush(6) + + material_Nphase = size(config_phase) + material_Nhomogenization = size(config_homogenization) - allocate(plasticState (size(config_phase))) - allocate(sourceState (size(config_phase))) - do myPhase = 1,size(config_phase) + + allocate(plasticState(material_Nphase)) + allocate(sourceState (material_Nphase)) + do myPhase = 1,material_Nphase allocate(sourceState(myPhase)%p(phase_Nsources(myPhase))) enddo - allocate(homogState (size(config_homogenization))) - allocate(thermalState (size(config_homogenization))) - allocate(damageState (size(config_homogenization))) + allocate(homogState (material_Nhomogenization)) + allocate(thermalState (material_Nhomogenization)) + allocate(damageState (material_Nhomogenization)) - allocate(thermalMapping (size(config_homogenization))) - allocate(damageMapping (size(config_homogenization))) + allocate(thermalMapping (material_Nhomogenization)) + allocate(damageMapping (material_Nhomogenization)) - allocate(temperature (size(config_homogenization))) - allocate(damage (size(config_homogenization))) + allocate(temperature (material_Nhomogenization)) + allocate(damage (material_Nhomogenization)) - allocate(temperatureRate (size(config_homogenization))) + allocate(temperatureRate (material_Nhomogenization)) do m = 1,size(config_microstructure) if(microstructure_crystallite(m) < 1 .or. & From 82bb887cdf91317714b5e170fae1844ff39c21d4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 15:40:22 +0200 Subject: [PATCH 21/49] white space adjustments --- src/constitutive.f90 | 1226 +++++++++++++++++++++--------------------- 1 file changed, 610 insertions(+), 616 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index cf4f3706b..4458cd6de 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -4,60 +4,57 @@ !> @brief elasticity, plasticity, internal microstructure state !-------------------------------------------------------------------------------------------------- module constitutive - use math - use debug - use numerics - use IO - use config - use material - use results - use HDF5_utilities - use lattice - use mesh - use discretization - use plastic_none - use plastic_isotropic - use plastic_phenopowerlaw - use plastic_kinehardening - use plastic_dislotwin - use plastic_disloucla - use plastic_nonlocal - use geometry_plastic_nonlocal - use source_thermal_dissipation - use source_thermal_externalheat - use source_damage_isoBrittle - use source_damage_isoDuctile - use source_damage_anisoBrittle - use source_damage_anisoDuctile - use kinematics_cleavage_opening - use kinematics_slipplane_opening - use kinematics_thermal_expansion - - implicit none - private + use math + use debug + use numerics + use IO + use config + use material + use results + use HDF5_utilities + use lattice + use mesh + use discretization + use plastic_none + use plastic_isotropic + use plastic_phenopowerlaw + use plastic_kinehardening + use plastic_dislotwin + use plastic_disloucla + use plastic_nonlocal + use geometry_plastic_nonlocal + use source_thermal_dissipation + use source_thermal_externalheat + use source_damage_isoBrittle + use source_damage_isoDuctile + use source_damage_anisoBrittle + use source_damage_anisoDuctile + use kinematics_cleavage_opening + use kinematics_slipplane_opening + use kinematics_thermal_expansion + + implicit none + private + + integer, public, protected :: & + constitutive_plasticity_maxSizePostResults, & + constitutive_plasticity_maxSizeDotState, & + constitutive_source_maxSizePostResults, & + constitutive_source_maxSizeDotState + + public :: & + constitutive_init, & + constitutive_homogenizedC, & + constitutive_microstructure, & + constitutive_LpAndItsTangents, & + constitutive_LiAndItsTangents, & + constitutive_initialFi, & + constitutive_SandItsTangents, & + constitutive_collectDotState, & + constitutive_collectDeltaState, & + constitutive_postResults, & + constitutive_results - integer, public, protected :: & - constitutive_plasticity_maxSizePostResults, & - constitutive_plasticity_maxSizeDotState, & - constitutive_source_maxSizePostResults, & - constitutive_source_maxSizeDotState - - public :: & - constitutive_init, & - constitutive_homogenizedC, & - constitutive_microstructure, & - constitutive_LpAndItsTangents, & - constitutive_LiAndItsTangents, & - constitutive_initialFi, & - constitutive_SandItsTangents, & - constitutive_collectDotState, & - constitutive_collectDeltaState, & - constitutive_postResults, & - constitutive_results - - private :: & - constitutive_hooke_SandItsTangents - contains @@ -66,174 +63,174 @@ contains !-------------------------------------------------------------------------------------------------- subroutine constitutive_init - integer, parameter :: FILEUNIT = 204 - integer :: & - o, & !< counter in output loop - ph, & !< counter in phase loop - s, & !< counter in source loop - ins !< instance of plasticity/source - - integer, dimension(:,:), pointer :: thisSize - character(len=64), dimension(:,:), pointer :: thisOutput - character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready - logical :: knownPlasticity, knownSource, nonlocalConstitutionPresent - nonlocalConstitutionPresent = .false. + integer, parameter :: FILEUNIT = 204 + integer :: & + o, & !< counter in output loop + ph, & !< counter in phase loop + s, & !< counter in source loop + ins !< instance of plasticity/source + + integer, dimension(:,:), pointer :: thisSize + character(len=64), dimension(:,:), pointer :: thisOutput + character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready + logical :: knownPlasticity, knownSource, nonlocalConstitutionPresent + nonlocalConstitutionPresent = .false. !-------------------------------------------------------------------------------------------------- ! initialized plasticity - if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init - if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init - if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init - if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init - if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init - if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init - if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then - call plastic_nonlocal_init - else - call geometry_plastic_nonlocal_disable - endif + if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init + if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init + if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init + if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init + if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init + if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init + if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then + call plastic_nonlocal_init + else + call geometry_plastic_nonlocal_disable + endif !-------------------------------------------------------------------------------------------------- ! initialize source mechanisms - if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init - if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init - if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init - if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init - if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init - if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init + if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init + if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init + if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init + if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init + if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init + if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init !-------------------------------------------------------------------------------------------------- ! initialize kinematic mechanisms - if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init - if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init - if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init - - write(6,'(/,a)') ' <<<+- constitutive init -+>>>' - - mainProcess: if (worldrank == 0) then + if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init + if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init + if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init + + write(6,'(/,a)') ' <<<+- constitutive init -+>>>' + + mainProcess: if (worldrank == 0) then !-------------------------------------------------------------------------------------------------- ! write description file for constitutive output - call IO_write_jobFile(FILEUNIT,'outputConstitutive') - PhaseLoop: do ph = 1,material_Nphase - activePhase: if (any(material_phaseAt == ph)) then - ins = phase_plasticityInstance(ph) - knownPlasticity = .true. ! assume valid - plasticityType: select case(phase_plasticity(ph)) - case (PLASTICITY_NONE_ID) plasticityType - outputName = PLASTICITY_NONE_label - thisOutput => null() - thisSize => null() - case (PLASTICITY_ISOTROPIC_ID) plasticityType - outputName = PLASTICITY_ISOTROPIC_label - thisOutput => plastic_isotropic_output - thisSize => plastic_isotropic_sizePostResult - case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - outputName = PLASTICITY_PHENOPOWERLAW_label - thisOutput => plastic_phenopowerlaw_output - thisSize => plastic_phenopowerlaw_sizePostResult - case (PLASTICITY_KINEHARDENING_ID) plasticityType - outputName = PLASTICITY_KINEHARDENING_label - thisOutput => plastic_kinehardening_output - thisSize => plastic_kinehardening_sizePostResult - case (PLASTICITY_DISLOTWIN_ID) plasticityType - outputName = PLASTICITY_DISLOTWIN_label - thisOutput => plastic_dislotwin_output - thisSize => plastic_dislotwin_sizePostResult - case (PLASTICITY_DISLOUCLA_ID) plasticityType - outputName = PLASTICITY_DISLOUCLA_label - thisOutput => plastic_disloucla_output - thisSize => plastic_disloucla_sizePostResult - case (PLASTICITY_NONLOCAL_ID) plasticityType - outputName = PLASTICITY_NONLOCAL_label - thisOutput => plastic_nonlocal_output - thisSize => plastic_nonlocal_sizePostResult - case default plasticityType - knownPlasticity = .false. - end select plasticityType - write(FILEUNIT,'(/,a,/)') '['//trim(config_name_phase(ph))//']' - if (knownPlasticity) then - write(FILEUNIT,'(a)') '(plasticity)'//char(9)//trim(outputName) - if (phase_plasticity(ph) /= PLASTICITY_NONE_ID) then - OutputPlasticityLoop: do o = 1,size(thisOutput(:,ins)) - if(len(trim(thisOutput(o,ins))) > 0) & - write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins) - enddo OutputPlasticityLoop - endif - endif - - SourceLoop: do s = 1, phase_Nsources(ph) - knownSource = .true. ! assume valid - sourceType: select case (phase_source(s,ph)) - case (SOURCE_thermal_dissipation_ID) sourceType - ins = source_thermal_dissipation_instance(ph) - outputName = SOURCE_thermal_dissipation_label - thisOutput => source_thermal_dissipation_output - thisSize => source_thermal_dissipation_sizePostResult - case (SOURCE_thermal_externalheat_ID) sourceType - ins = source_thermal_externalheat_instance(ph) - outputName = SOURCE_thermal_externalheat_label - thisOutput => source_thermal_externalheat_output - thisSize => source_thermal_externalheat_sizePostResult - case (SOURCE_damage_isoBrittle_ID) sourceType - ins = source_damage_isoBrittle_instance(ph) - outputName = SOURCE_damage_isoBrittle_label - thisOutput => source_damage_isoBrittle_output - thisSize => source_damage_isoBrittle_sizePostResult - case (SOURCE_damage_isoDuctile_ID) sourceType - ins = source_damage_isoDuctile_instance(ph) - outputName = SOURCE_damage_isoDuctile_label - thisOutput => source_damage_isoDuctile_output - thisSize => source_damage_isoDuctile_sizePostResult - case (SOURCE_damage_anisoBrittle_ID) sourceType - ins = source_damage_anisoBrittle_instance(ph) - outputName = SOURCE_damage_anisoBrittle_label - thisOutput => source_damage_anisoBrittle_output - thisSize => source_damage_anisoBrittle_sizePostResult - case (SOURCE_damage_anisoDuctile_ID) sourceType - ins = source_damage_anisoDuctile_instance(ph) - outputName = SOURCE_damage_anisoDuctile_label - thisOutput => source_damage_anisoDuctile_output - thisSize => source_damage_anisoDuctile_sizePostResult - case default sourceType - knownSource = .false. - end select sourceType - if (knownSource) then - write(FILEUNIT,'(a)') '(source)'//char(9)//trim(outputName) - OutputSourceLoop: do o = 1,size(thisOutput(:,ins)) - if(len(trim(thisOutput(o,ins))) > 0) & - write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins) - enddo OutputSourceLoop - endif - enddo SourceLoop - endif activePhase - enddo PhaseLoop - close(FILEUNIT) - endif mainProcess - - constitutive_plasticity_maxSizeDotState = 0 - constitutive_plasticity_maxSizePostResults = 0 - constitutive_source_maxSizeDotState = 0 - constitutive_source_maxSizePostResults = 0 - - PhaseLoop2:do ph = 1,material_Nphase + call IO_write_jobFile(FILEUNIT,'outputConstitutive') + PhaseLoop: do ph = 1,material_Nphase + activePhase: if (any(material_phaseAt == ph)) then + ins = phase_plasticityInstance(ph) + knownPlasticity = .true. ! assume valid + plasticityType: select case(phase_plasticity(ph)) + case (PLASTICITY_NONE_ID) plasticityType + outputName = PLASTICITY_NONE_label + thisOutput => null() + thisSize => null() + case (PLASTICITY_ISOTROPIC_ID) plasticityType + outputName = PLASTICITY_ISOTROPIC_label + thisOutput => plastic_isotropic_output + thisSize => plastic_isotropic_sizePostResult + case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType + outputName = PLASTICITY_PHENOPOWERLAW_label + thisOutput => plastic_phenopowerlaw_output + thisSize => plastic_phenopowerlaw_sizePostResult + case (PLASTICITY_KINEHARDENING_ID) plasticityType + outputName = PLASTICITY_KINEHARDENING_label + thisOutput => plastic_kinehardening_output + thisSize => plastic_kinehardening_sizePostResult + case (PLASTICITY_DISLOTWIN_ID) plasticityType + outputName = PLASTICITY_DISLOTWIN_label + thisOutput => plastic_dislotwin_output + thisSize => plastic_dislotwin_sizePostResult + case (PLASTICITY_DISLOUCLA_ID) plasticityType + outputName = PLASTICITY_DISLOUCLA_label + thisOutput => plastic_disloucla_output + thisSize => plastic_disloucla_sizePostResult + case (PLASTICITY_NONLOCAL_ID) plasticityType + outputName = PLASTICITY_NONLOCAL_label + thisOutput => plastic_nonlocal_output + thisSize => plastic_nonlocal_sizePostResult + case default plasticityType + knownPlasticity = .false. + end select plasticityType + write(FILEUNIT,'(/,a,/)') '['//trim(config_name_phase(ph))//']' + if (knownPlasticity) then + write(FILEUNIT,'(a)') '(plasticity)'//char(9)//trim(outputName) + if (phase_plasticity(ph) /= PLASTICITY_NONE_ID) then + OutputPlasticityLoop: do o = 1,size(thisOutput(:,ins)) + if(len(trim(thisOutput(o,ins))) > 0) & + write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins) + enddo OutputPlasticityLoop + endif + endif + + SourceLoop: do s = 1, phase_Nsources(ph) + knownSource = .true. ! assume valid + sourceType: select case (phase_source(s,ph)) + case (SOURCE_thermal_dissipation_ID) sourceType + ins = source_thermal_dissipation_instance(ph) + outputName = SOURCE_thermal_dissipation_label + thisOutput => source_thermal_dissipation_output + thisSize => source_thermal_dissipation_sizePostResult + case (SOURCE_thermal_externalheat_ID) sourceType + ins = source_thermal_externalheat_instance(ph) + outputName = SOURCE_thermal_externalheat_label + thisOutput => source_thermal_externalheat_output + thisSize => source_thermal_externalheat_sizePostResult + case (SOURCE_damage_isoBrittle_ID) sourceType + ins = source_damage_isoBrittle_instance(ph) + outputName = SOURCE_damage_isoBrittle_label + thisOutput => source_damage_isoBrittle_output + thisSize => source_damage_isoBrittle_sizePostResult + case (SOURCE_damage_isoDuctile_ID) sourceType + ins = source_damage_isoDuctile_instance(ph) + outputName = SOURCE_damage_isoDuctile_label + thisOutput => source_damage_isoDuctile_output + thisSize => source_damage_isoDuctile_sizePostResult + case (SOURCE_damage_anisoBrittle_ID) sourceType + ins = source_damage_anisoBrittle_instance(ph) + outputName = SOURCE_damage_anisoBrittle_label + thisOutput => source_damage_anisoBrittle_output + thisSize => source_damage_anisoBrittle_sizePostResult + case (SOURCE_damage_anisoDuctile_ID) sourceType + ins = source_damage_anisoDuctile_instance(ph) + outputName = SOURCE_damage_anisoDuctile_label + thisOutput => source_damage_anisoDuctile_output + thisSize => source_damage_anisoDuctile_sizePostResult + case default sourceType + knownSource = .false. + end select sourceType + if (knownSource) then + write(FILEUNIT,'(a)') '(source)'//char(9)//trim(outputName) + OutputSourceLoop: do o = 1,size(thisOutput(:,ins)) + if(len(trim(thisOutput(o,ins))) > 0) & + write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins) + enddo OutputSourceLoop + endif + enddo SourceLoop + endif activePhase + enddo PhaseLoop + close(FILEUNIT) + endif mainProcess + + constitutive_plasticity_maxSizeDotState = 0 + constitutive_plasticity_maxSizePostResults = 0 + constitutive_source_maxSizeDotState = 0 + constitutive_source_maxSizePostResults = 0 + + PhaseLoop2:do ph = 1,material_Nphase !-------------------------------------------------------------------------------------------------- ! partition and inititalize state - plasticState(ph)%partionedState0 = plasticState(ph)%state0 - plasticState(ph)%state = plasticState(ph)%partionedState0 - forall(s = 1:phase_Nsources(ph)) - sourceState(ph)%p(s)%partionedState0 = sourceState(ph)%p(s)%state0 - sourceState(ph)%p(s)%state = sourceState(ph)%p(s)%partionedState0 - end forall + plasticState(ph)%partionedState0 = plasticState(ph)%state0 + plasticState(ph)%state = plasticState(ph)%partionedState0 + forall(s = 1:phase_Nsources(ph)) + sourceState(ph)%p(s)%partionedState0 = sourceState(ph)%p(s)%state0 + sourceState(ph)%p(s)%state = sourceState(ph)%p(s)%partionedState0 + end forall !-------------------------------------------------------------------------------------------------- ! determine max size of state and output - constitutive_plasticity_maxSizeDotState = max(constitutive_plasticity_maxSizeDotState, & - plasticState(ph)%sizeDotState) - constitutive_plasticity_maxSizePostResults = max(constitutive_plasticity_maxSizePostResults, & - plasticState(ph)%sizePostResults) - constitutive_source_maxSizeDotState = max(constitutive_source_maxSizeDotState, & - maxval(sourceState(ph)%p(:)%sizeDotState)) - constitutive_source_maxSizePostResults = max(constitutive_source_maxSizePostResults, & - maxval(sourceState(ph)%p(:)%sizePostResults)) - enddo PhaseLoop2 + constitutive_plasticity_maxSizeDotState = max(constitutive_plasticity_maxSizeDotState, & + plasticState(ph)%sizeDotState) + constitutive_plasticity_maxSizePostResults = max(constitutive_plasticity_maxSizePostResults, & + plasticState(ph)%sizePostResults) + constitutive_source_maxSizeDotState = max(constitutive_source_maxSizeDotState, & + maxval(sourceState(ph)%p(:)%sizeDotState)) + constitutive_source_maxSizePostResults = max(constitutive_source_maxSizePostResults, & + maxval(sourceState(ph)%p(:)%sizePostResults)) + enddo PhaseLoop2 end subroutine constitutive_init @@ -245,53 +242,54 @@ end subroutine constitutive_init !-------------------------------------------------------------------------------------------------- function constitutive_homogenizedC(ipc,ip,el) - real(pReal), dimension(6,6) :: constitutive_homogenizedC - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - - plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) - case (PLASTICITY_DISLOTWIN_ID) plasticityType - constitutive_homogenizedC = plastic_dislotwin_homogenizedC(ipc,ip,el) - case default plasticityType - constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phaseAt(ipc,el)) - end select plasticityType + real(pReal), dimension(6,6) :: constitutive_homogenizedC + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) + case (PLASTICITY_DISLOTWIN_ID) plasticityType + constitutive_homogenizedC = plastic_dislotwin_homogenizedC(ipc,ip,el) + case default plasticityType + constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phaseAt(ipc,el)) + end select plasticityType end function constitutive_homogenizedC + !-------------------------------------------------------------------------------------------------- !> @brief calls microstructure function of the different constitutive models !-------------------------------------------------------------------------------------------------- subroutine constitutive_microstructure(Fe, Fp, ipc, ip, el) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - Fe, & !< elastic deformation gradient - Fp !< plastic deformation gradient - integer :: & - ho, & !< homogenization - tme, & !< thermal member position - instance, of - - ho = material_homogenizationAt(el) - tme = thermalMapping(ho)%p(ip,el) - - plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) - case (PLASTICITY_DISLOTWIN_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of) - case (PLASTICITY_DISLOUCLA_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_disloUCLA_dependentState(instance,of) - case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dependentState (Fe,Fp,ip,el) - end select plasticityType + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(3,3) :: & + Fe, & !< elastic deformation gradient + Fp !< plastic deformation gradient + integer :: & + ho, & !< homogenization + tme, & !< thermal member position + instance, of + + ho = material_homogenizationAt(el) + tme = thermalMapping(ho)%p(ip,el) + + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) + case (PLASTICITY_DISLOTWIN_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of) + case (PLASTICITY_DISLOUCLA_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_disloUCLA_dependentState(instance,of) + case (PLASTICITY_NONLOCAL_ID) plasticityType + call plastic_nonlocal_dependentState (Fe,Fp,ip,el) + end select plasticityType end subroutine constitutive_microstructure @@ -304,75 +302,75 @@ end subroutine constitutive_microstructure subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & S, Fi, ipc, ip, el) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola-Kirchhoff stress - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - Lp !< plastic velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLp_dS, & - dLp_dFi !< derivative of Lp with respect to Fi - real(pReal), dimension(3,3,3,3) :: & - dLp_dMp !< derivative of Lp with respect to Mandel stress - real(pReal), dimension(3,3) :: & - Mp !< Mandel stress work conjugate with Lp - integer :: & - ho, & !< homogenization - tme !< thermal member position - integer :: & - i, j, instance, of - - ho = material_homogenizationAt(el) - tme = thermalMapping(ho)%p(ip,el) - - Mp = matmul(matmul(transpose(Fi),Fi),S) - - plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) - - case (PLASTICITY_NONE_ID) plasticityType - Lp = 0.0_pReal - dLp_dMp = 0.0_pReal - - case (PLASTICITY_ISOTROPIC_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) - - case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) - - case (PLASTICITY_KINEHARDENING_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp, Mp,instance,of) - - case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp,Mp, & - temperature(ho)%p(tme),geometry_plastic_nonlocal_IPvolume0(ip,el),ip,el) - - case (PLASTICITY_DISLOTWIN_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_dislotwin_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) - - case (PLASTICITY_DISLOUCLA_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) - - end select plasticityType - - do i=1,3; do j=1,3 - dLp_dFi(i,j,1:3,1:3) = matmul(matmul(Fi,S),transpose(dLp_dMp(i,j,1:3,1:3))) + & - matmul(matmul(Fi,dLp_dMp(i,j,1:3,1:3)),S) - dLp_dS(i,j,1:3,1:3) = matmul(matmul(transpose(Fi),Fi),dLp_dMp(i,j,1:3,1:3)) ! ToDo: @PS: why not: dLp_dMp:(FiT Fi) - enddo; enddo + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(3,3) :: & + S, & !< 2nd Piola-Kirchhoff stress + Fi !< intermediate deformation gradient + real(pReal), intent(out), dimension(3,3) :: & + Lp !< plastic velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLp_dS, & + dLp_dFi !< derivative of Lp with respect to Fi + real(pReal), dimension(3,3,3,3) :: & + dLp_dMp !< derivative of Lp with respect to Mandel stress + real(pReal), dimension(3,3) :: & + Mp !< Mandel stress work conjugate with Lp + integer :: & + ho, & !< homogenization + tme !< thermal member position + integer :: & + i, j, instance, of + + ho = material_homogenizationAt(el) + tme = thermalMapping(ho)%p(ip,el) + + Mp = matmul(matmul(transpose(Fi),Fi),S) + + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) + + case (PLASTICITY_NONE_ID) plasticityType + Lp = 0.0_pReal + dLp_dMp = 0.0_pReal + + case (PLASTICITY_ISOTROPIC_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) + + case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) + + case (PLASTICITY_KINEHARDENING_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp, Mp,instance,of) + + case (PLASTICITY_NONLOCAL_ID) plasticityType + call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp,Mp, & + temperature(ho)%p(tme),geometry_plastic_nonlocal_IPvolume0(ip,el),ip,el) + + case (PLASTICITY_DISLOTWIN_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_dislotwin_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) + + case (PLASTICITY_DISLOUCLA_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) + + end select plasticityType + + do i=1,3; do j=1,3 + dLp_dFi(i,j,1:3,1:3) = matmul(matmul(Fi,S),transpose(dLp_dMp(i,j,1:3,1:3))) + & + matmul(matmul(Fi,dLp_dMp(i,j,1:3,1:3)),S) + dLp_dS(i,j,1:3,1:3) = matmul(matmul(transpose(Fi),Fi),dLp_dMp(i,j,1:3,1:3)) ! ToDo: @PS: why not: dLp_dMp:(FiT Fi) + enddo; enddo end subroutine constitutive_LpAndItsTangents @@ -384,75 +382,75 @@ end subroutine constitutive_LpAndItsTangents subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & S, Fi, ipc, ip, el) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola-Kirchhoff stress - real(pReal), intent(in), dimension(3,3) :: & - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - Li !< intermediate velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLi_dS, & !< derivative of Li with respect to S - dLi_dFi + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola-Kirchhoff stress + real(pReal), intent(in), dimension(3,3) :: & + Fi !< intermediate deformation gradient + real(pReal), intent(out), dimension(3,3) :: & + Li !< intermediate velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLi_dS, & !< derivative of Li with respect to S + dLi_dFi + + real(pReal), dimension(3,3) :: & + my_Li, & !< intermediate velocity gradient + FiInv, & + temp_33 + real(pReal), dimension(3,3,3,3) :: & + my_dLi_dS + real(pReal) :: & + detFi + integer :: & + k, i, j, & + instance, of - real(pReal), dimension(3,3) :: & - my_Li, & !< intermediate velocity gradient - FiInv, & - temp_33 - real(pReal), dimension(3,3,3,3) :: & - my_dLi_dS - real(pReal) :: & - detFi - integer :: & - k, i, j, & - instance, of - - Li = 0.0_pReal - dLi_dS = 0.0_pReal - dLi_dFi = 0.0_pReal - - plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) - case (PLASTICITY_isotropic_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) - case default plasticityType - my_Li = 0.0_pReal - my_dLi_dS = 0.0_pReal - end select plasticityType - - Li = Li + my_Li - dLi_dS = dLi_dS + my_dLi_dS - - KinematicsLoop: do k = 1, phase_Nkinematics(material_phaseAt(ipc,el)) - kinematicsType: select case (phase_kinematics(k,material_phaseAt(ipc,el))) - case (KINEMATICS_cleavage_opening_ID) kinematicsType - call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, ipc, ip, el) - case (KINEMATICS_slipplane_opening_ID) kinematicsType - call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, ipc, ip, el) - case (KINEMATICS_thermal_expansion_ID) kinematicsType - call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el) - case default kinematicsType - my_Li = 0.0_pReal - my_dLi_dS = 0.0_pReal - end select kinematicsType - Li = Li + my_Li - dLi_dS = dLi_dS + my_dLi_dS - enddo KinematicsLoop - - FiInv = math_inv33(Fi) - detFi = math_det33(Fi) - Li = matmul(matmul(Fi,Li),FiInv)*detFi !< push forward to intermediate configuration - temp_33 = matmul(FiInv,Li) - - do i = 1,3; do j = 1,3 - dLi_dS(1:3,1:3,i,j) = matmul(matmul(Fi,dLi_dS(1:3,1:3,i,j)),FiInv)*detFi - dLi_dFi(1:3,1:3,i,j) = dLi_dFi(1:3,1:3,i,j) + Li*FiInv(j,i) - dLi_dFi(1:3,i,1:3,j) = dLi_dFi(1:3,i,1:3,j) + math_I3*temp_33(j,i) + Li*FiInv(j,i) - end do; end do + Li = 0.0_pReal + dLi_dS = 0.0_pReal + dLi_dFi = 0.0_pReal + + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) + case (PLASTICITY_isotropic_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) + case default plasticityType + my_Li = 0.0_pReal + my_dLi_dS = 0.0_pReal + end select plasticityType + + Li = Li + my_Li + dLi_dS = dLi_dS + my_dLi_dS + + KinematicsLoop: do k = 1, phase_Nkinematics(material_phaseAt(ipc,el)) + kinematicsType: select case (phase_kinematics(k,material_phaseAt(ipc,el))) + case (KINEMATICS_cleavage_opening_ID) kinematicsType + call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, ipc, ip, el) + case (KINEMATICS_slipplane_opening_ID) kinematicsType + call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, ipc, ip, el) + case (KINEMATICS_thermal_expansion_ID) kinematicsType + call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el) + case default kinematicsType + my_Li = 0.0_pReal + my_dLi_dS = 0.0_pReal + end select kinematicsType + Li = Li + my_Li + dLi_dS = dLi_dS + my_dLi_dS + enddo KinematicsLoop + + FiInv = math_inv33(Fi) + detFi = math_det33(Fi) + Li = matmul(matmul(Fi,Li),FiInv)*detFi !< push forward to intermediate configuration + temp_33 = matmul(FiInv,Li) + + do i = 1,3; do j = 1,3 + dLi_dS(1:3,1:3,i,j) = matmul(matmul(Fi,dLi_dS(1:3,1:3,i,j)),FiInv)*detFi + dLi_dFi(1:3,1:3,i,j) = dLi_dFi(1:3,1:3,i,j) + Li*FiInv(j,i) + dLi_dFi(1:3,i,1:3,j) = dLi_dFi(1:3,i,1:3,j) + math_I3*temp_33(j,i) + Li*FiInv(j,i) + end do; end do end subroutine constitutive_LiAndItsTangents @@ -462,30 +460,30 @@ end subroutine constitutive_LiAndItsTangents !-------------------------------------------------------------------------------------------------- pure function constitutive_initialFi(ipc, ip, el) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(3,3) :: & - constitutive_initialFi !< composite initial intermediate deformation gradient - integer :: & - k !< counter in kinematics loop - integer :: & - phase, & - homog, offset - - constitutive_initialFi = math_I3 - phase = material_phaseAt(ipc,el) - - KinematicsLoop: do k = 1, phase_Nkinematics(phase) !< Warning: small initial strain assumption - kinematicsType: select case (phase_kinematics(k,phase)) - case (KINEMATICS_thermal_expansion_ID) kinematicsType - homog = material_homogenizationAt(el) - offset = thermalMapping(homog)%p(ip,el) - constitutive_initialFi = & - constitutive_initialFi + kinematics_thermal_expansion_initialStrain(homog,phase,offset) - end select kinematicsType - enddo KinematicsLoop + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(3,3) :: & + constitutive_initialFi !< composite initial intermediate deformation gradient + integer :: & + k !< counter in kinematics loop + integer :: & + phase, & + homog, offset + + constitutive_initialFi = math_I3 + phase = material_phaseAt(ipc,el) + + KinematicsLoop: do k = 1, phase_Nkinematics(phase) !< Warning: small initial strain assumption + kinematicsType: select case (phase_kinematics(k,phase)) + case (KINEMATICS_thermal_expansion_ID) kinematicsType + homog = material_homogenizationAt(el) + offset = thermalMapping(homog)%p(ip,el) + constitutive_initialFi = & + constitutive_initialFi + kinematics_thermal_expansion_initialStrain(homog,phase,offset) + end select kinematicsType + enddo KinematicsLoop end function constitutive_initialFi @@ -497,20 +495,20 @@ end function constitutive_initialFi !-------------------------------------------------------------------------------------------------- subroutine constitutive_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip, el) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - Fe, & !< elastic deformation gradient - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - S !< 2nd Piola-Kirchhoff stress tensor - real(pReal), intent(out), dimension(3,3,3,3) :: & - dS_dFe, & !< derivative of 2nd P-K stress with respect to elastic deformation gradient - dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(3,3) :: & + Fe, & !< elastic deformation gradient + Fi !< intermediate deformation gradient + real(pReal), intent(out), dimension(3,3) :: & + S !< 2nd Piola-Kirchhoff stress tensor + real(pReal), intent(out), dimension(3,3,3,3) :: & + dS_dFe, & !< derivative of 2nd P-K stress with respect to elastic deformation gradient + dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient - call constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip, el) + call constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip, el) end subroutine constitutive_SandItsTangents @@ -523,45 +521,44 @@ end subroutine constitutive_SandItsTangents subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & Fe, Fi, ipc, ip, el) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - Fe, & !< elastic deformation gradient - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - S !< 2nd Piola-Kirchhoff stress tensor in lattice configuration - real(pReal), intent(out), dimension(3,3,3,3) :: & - dS_dFe, & !< derivative of 2nd P-K stress with respect to elastic deformation gradient - dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient - real(pReal), dimension(3,3) :: E - real(pReal), dimension(3,3,3,3) :: C - integer :: & - ho, & !< homogenization - d !< counter in degradation loop - integer :: & - i, j - - ho = material_homogenizationAt(el) - C = math_66toSym3333(constitutive_homogenizedC(ipc,ip,el)) - - DegradationLoop: do d = 1, phase_NstiffnessDegradations(material_phaseAt(ipc,el)) - degradationType: select case(phase_stiffnessDegradation(d,material_phaseAt(ipc,el))) - case (STIFFNESS_DEGRADATION_damage_ID) degradationType - C = C * damage(ho)%p(damageMapping(ho)%p(ip,el))**2 - end select degradationType - enddo DegradationLoop - - E = 0.5_pReal*(matmul(transpose(Fe),Fe)-math_I3) !< Green-Lagrange strain in unloaded configuration - S = math_mul3333xx33(C,matmul(matmul(transpose(Fi),E),Fi)) !< 2PK stress in lattice configuration in work conjugate with GL strain pulled back to lattice configuration - - dS_dFe = 0.0_pReal - forall (i=1:3, j=1:3) - dS_dFe(i,j,1:3,1:3) = & - matmul(Fe,matmul(matmul(Fi,C(i,j,1:3,1:3)),transpose(Fi))) !< dS_ij/dFe_kl = C_ijmn * Fi_lm * Fi_on * Fe_ko - dS_dFi(i,j,1:3,1:3) = 2.0_pReal*matmul(matmul(E,Fi),C(i,j,1:3,1:3)) !< dS_ij/dFi_kl = C_ijln * E_km * Fe_mn - end forall + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(3,3) :: & + Fe, & !< elastic deformation gradient + Fi !< intermediate deformation gradient + real(pReal), intent(out), dimension(3,3) :: & + S !< 2nd Piola-Kirchhoff stress tensor in lattice configuration + real(pReal), intent(out), dimension(3,3,3,3) :: & + dS_dFe, & !< derivative of 2nd P-K stress with respect to elastic deformation gradient + dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient + real(pReal), dimension(3,3) :: E + real(pReal), dimension(3,3,3,3) :: C + integer :: & + ho, & !< homogenization + d !< counter in degradation loop + integer :: & + i, j + + ho = material_homogenizationAt(el) + C = math_66toSym3333(constitutive_homogenizedC(ipc,ip,el)) + + DegradationLoop: do d = 1, phase_NstiffnessDegradations(material_phaseAt(ipc,el)) + degradationType: select case(phase_stiffnessDegradation(d,material_phaseAt(ipc,el))) + case (STIFFNESS_DEGRADATION_damage_ID) degradationType + C = C * damage(ho)%p(damageMapping(ho)%p(ip,el))**2 + end select degradationType + enddo DegradationLoop + + E = 0.5_pReal*(matmul(transpose(Fe),Fe)-math_I3) !< Green-Lagrange strain in unloaded configuration + S = math_mul3333xx33(C,matmul(matmul(transpose(Fi),E),Fi)) !< 2PK stress in lattice configuration in work conjugate with GL strain pulled back to lattice configuration + + dS_dFe = 0.0_pReal + forall (i=1:3, j=1:3) + dS_dFe(i,j,1:3,1:3) = matmul(Fe,matmul(matmul(Fi,C(i,j,1:3,1:3)),transpose(Fi))) !< dS_ij/dFe_kl = C_ijmn * Fi_lm * Fi_on * Fe_ko + dS_dFi(i,j,1:3,1:3) = 2.0_pReal*matmul(matmul(E,Fi),C(i,j,1:3,1:3)) !< dS_ij/dFi_kl = C_ijln * E_km * Fe_mn + end forall end subroutine constitutive_hooke_SandItsTangents @@ -571,132 +568,133 @@ end subroutine constitutive_hooke_SandItsTangents !-------------------------------------------------------------------------------------------------- subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip, el) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in) :: & - subdt !< timestep - real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: & - FeArray, & !< elastic deformation gradient - FpArray !< plastic deformation gradient - real(pReal), intent(in), dimension(3,3) :: & - Fi !< intermediate deformation gradient - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola Kirchhoff stress (vector notation) - real(pReal), dimension(3,3) :: & - Mp - integer :: & - ho, & !< homogenization - tme, & !< thermal member position - i, & !< counter in source loop - instance, of + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in) :: & + subdt !< timestep + real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: & + FeArray, & !< elastic deformation gradient + FpArray !< plastic deformation gradient + real(pReal), intent(in), dimension(3,3) :: & + Fi !< intermediate deformation gradient + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola Kirchhoff stress (vector notation) + real(pReal), dimension(3,3) :: & + Mp + integer :: & + ho, & !< homogenization + tme, & !< thermal member position + i, & !< counter in source loop + instance, of - ho = material_homogenizationAt(el) - tme = thermalMapping(ho)%p(ip,el) + ho = material_homogenizationAt(el) + tme = thermalMapping(ho)%p(ip,el) - Mp = matmul(matmul(transpose(Fi),Fi),S) + Mp = matmul(matmul(transpose(Fi),Fi),S) - plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) - case (PLASTICITY_ISOTROPIC_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_isotropic_dotState (Mp,instance,of) + case (PLASTICITY_ISOTROPIC_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_isotropic_dotState (Mp,instance,of) - case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_phenopowerlaw_dotState(Mp,instance,of) + case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_phenopowerlaw_dotState(Mp,instance,of) - case (PLASTICITY_KINEHARDENING_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_kinehardening_dotState(Mp,instance,of) + case (PLASTICITY_KINEHARDENING_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_kinehardening_dotState(Mp,instance,of) - case (PLASTICITY_DISLOTWIN_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_dislotwin_dotState (Mp,temperature(ho)%p(tme),instance,of) + case (PLASTICITY_DISLOTWIN_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_dislotwin_dotState (Mp,temperature(ho)%p(tme),instance,of) - case (PLASTICITY_DISLOUCLA_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of) + case (PLASTICITY_DISLOUCLA_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of) - case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState (Mp,FeArray,FpArray,temperature(ho)%p(tme), & - subdt,ip,el) - end select plasticityType + case (PLASTICITY_NONLOCAL_ID) plasticityType + call plastic_nonlocal_dotState (Mp,FeArray,FpArray,temperature(ho)%p(tme), & + subdt,ip,el) + end select plasticityType - SourceLoop: do i = 1, phase_Nsources(material_phaseAt(ipc,el)) + SourceLoop: do i = 1, phase_Nsources(material_phaseAt(ipc,el)) - sourceType: select case (phase_source(i,material_phaseAt(ipc,el))) + sourceType: select case (phase_source(i,material_phaseAt(ipc,el))) - case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState (S, ipc, ip, el) !< correct stress? + case (SOURCE_damage_anisoBrittle_ID) sourceType + call source_damage_anisoBrittle_dotState (S, ipc, ip, el) !< correct stress? - case (SOURCE_damage_isoDuctile_ID) sourceType - call source_damage_isoDuctile_dotState ( ipc, ip, el) + case (SOURCE_damage_isoDuctile_ID) sourceType + call source_damage_isoDuctile_dotState ( ipc, ip, el) - case (SOURCE_damage_anisoDuctile_ID) sourceType - call source_damage_anisoDuctile_dotState ( ipc, ip, el) + case (SOURCE_damage_anisoDuctile_ID) sourceType + call source_damage_anisoDuctile_dotState ( ipc, ip, el) - case (SOURCE_thermal_externalheat_ID) sourceType - of = material_phasememberAt(ipc,ip,el) - call source_thermal_externalheat_dotState(material_phaseAt(ipc,el),of) + case (SOURCE_thermal_externalheat_ID) sourceType + of = material_phasememberAt(ipc,ip,el) + call source_thermal_externalheat_dotState(material_phaseAt(ipc,el),of) - end select sourceType + end select sourceType - enddo SourceLoop + enddo SourceLoop end subroutine constitutive_collectDotState + !-------------------------------------------------------------------------------------------------- !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola Kirchhoff stress - Fe, & !< elastic deformation gradient - Fi !< intermediate deformation gradient - real(pReal), dimension(3,3) :: & - Mp - integer :: & - i, & - instance, of + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(3,3) :: & + S, & !< 2nd Piola Kirchhoff stress + Fe, & !< elastic deformation gradient + Fi !< intermediate deformation gradient + real(pReal), dimension(3,3) :: & + Mp + integer :: & + i, & + instance, of - Mp = matmul(matmul(transpose(Fi),Fi),S) + Mp = matmul(matmul(transpose(Fi),Fi),S) - plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) - case (PLASTICITY_KINEHARDENING_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - call plastic_kinehardening_deltaState(Mp,instance,of) + case (PLASTICITY_KINEHARDENING_ID) plasticityType + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + call plastic_kinehardening_deltaState(Mp,instance,of) - case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_deltaState(Mp,ip,el) + case (PLASTICITY_NONLOCAL_ID) plasticityType + call plastic_nonlocal_deltaState(Mp,ip,el) - end select plasticityType + end select plasticityType - sourceLoop: do i = 1, phase_Nsources(material_phaseAt(ipc,el)) + sourceLoop: do i = 1, phase_Nsources(material_phaseAt(ipc,el)) - sourceType: select case (phase_source(i,material_phaseAt(ipc,el))) + sourceType: select case (phase_source(i,material_phaseAt(ipc,el))) - case (SOURCE_damage_isoBrittle_ID) sourceType - call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(ipc,ip,el), Fe, & - ipc, ip, el) + case (SOURCE_damage_isoBrittle_ID) sourceType + call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(ipc,ip,el), Fe, & + ipc, ip, el) - end select sourceType + end select sourceType - enddo SourceLoop + enddo SourceLoop end subroutine constitutive_collectDeltaState @@ -706,82 +704,82 @@ end subroutine constitutive_collectDeltaState !-------------------------------------------------------------------------------------------------- function constitutive_postResults(S, Fi, ipc, ip, el) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(plasticState(material_phaseAt(ipc,el))%sizePostResults + & - sum(sourceState(material_phaseAt(ipc,el))%p(:)%sizePostResults)) :: & - constitutive_postResults - real(pReal), intent(in), dimension(3,3) :: & - Fi !< intermediate deformation gradient - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola Kirchhoff stress - real(pReal), dimension(3,3) :: & - Mp !< Mandel stress - integer :: & - startPos, endPos - integer :: & - ho, & !< homogenization - tme, & !< thermal member position - i, of, instance !< counter in source loop + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(plasticState(material_phaseAt(ipc,el))%sizePostResults + & + sum(sourceState(material_phaseAt(ipc,el))%p(:)%sizePostResults)) :: & + constitutive_postResults + real(pReal), intent(in), dimension(3,3) :: & + Fi !< intermediate deformation gradient + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola Kirchhoff stress + real(pReal), dimension(3,3) :: & + Mp !< Mandel stress + integer :: & + startPos, endPos + integer :: & + ho, & !< homogenization + tme, & !< thermal member position + i, of, instance !< counter in source loop - constitutive_postResults = 0.0_pReal + constitutive_postResults = 0.0_pReal - Mp = matmul(matmul(transpose(Fi),Fi),S) + Mp = matmul(matmul(transpose(Fi),Fi),S) - ho = material_homogenizationAt(el) - tme = thermalMapping(ho)%p(ip,el) + ho = material_homogenizationAt(el) + tme = thermalMapping(ho)%p(ip,el) - startPos = 1 - endPos = plasticState(material_phaseAt(ipc,el))%sizePostResults + startPos = 1 + endPos = plasticState(material_phaseAt(ipc,el))%sizePostResults - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + of = material_phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phaseAt(ipc,el)) - plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) - case (PLASTICITY_ISOTROPIC_ID) plasticityType - constitutive_postResults(startPos:endPos) = & - plastic_isotropic_postResults(Mp,instance,of) + plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) + case (PLASTICITY_ISOTROPIC_ID) plasticityType + constitutive_postResults(startPos:endPos) = & + plastic_isotropic_postResults(Mp,instance,of) - case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - constitutive_postResults(startPos:endPos) = & - plastic_phenopowerlaw_postResults(Mp,instance,of) + case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType + constitutive_postResults(startPos:endPos) = & + plastic_phenopowerlaw_postResults(Mp,instance,of) - case (PLASTICITY_KINEHARDENING_ID) plasticityType - constitutive_postResults(startPos:endPos) = & - plastic_kinehardening_postResults(Mp,instance,of) + case (PLASTICITY_KINEHARDENING_ID) plasticityType + constitutive_postResults(startPos:endPos) = & + plastic_kinehardening_postResults(Mp,instance,of) - case (PLASTICITY_DISLOTWIN_ID) plasticityType - constitutive_postResults(startPos:endPos) = & - plastic_dislotwin_postResults(Mp,temperature(ho)%p(tme),instance,of) + case (PLASTICITY_DISLOTWIN_ID) plasticityType + constitutive_postResults(startPos:endPos) = & + plastic_dislotwin_postResults(Mp,temperature(ho)%p(tme),instance,of) - case (PLASTICITY_DISLOUCLA_ID) plasticityType - constitutive_postResults(startPos:endPos) = & - plastic_disloucla_postResults(Mp,temperature(ho)%p(tme),instance,of) + case (PLASTICITY_DISLOUCLA_ID) plasticityType + constitutive_postResults(startPos:endPos) = & + plastic_disloucla_postResults(Mp,temperature(ho)%p(tme),instance,of) - case (PLASTICITY_NONLOCAL_ID) plasticityType - constitutive_postResults(startPos:endPos) = & - plastic_nonlocal_postResults (material_phaseAt(ipc,el),instance,of) + case (PLASTICITY_NONLOCAL_ID) plasticityType + constitutive_postResults(startPos:endPos) = & + plastic_nonlocal_postResults (material_phaseAt(ipc,el),instance,of) - end select plasticityType + end select plasticityType - SourceLoop: do i = 1, phase_Nsources(material_phaseAt(ipc,el)) - startPos = endPos + 1 - endPos = endPos + sourceState(material_phaseAt(ipc,el))%p(i)%sizePostResults - of = material_phasememberAt(ipc,ip,el) - sourceType: select case (phase_source(i,material_phaseAt(ipc,el))) - case (SOURCE_damage_isoBrittle_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(material_phaseAt(ipc,el),of) - case (SOURCE_damage_isoDuctile_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_isoDuctile_postResults(material_phaseAt(ipc,el),of) - case (SOURCE_damage_anisoBrittle_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_anisoBrittle_postResults(material_phaseAt(ipc,el),of) - case (SOURCE_damage_anisoDuctile_ID) sourceType - constitutive_postResults(startPos:endPos) = source_damage_anisoDuctile_postResults(material_phaseAt(ipc,el),of) - end select sourceType + SourceLoop: do i = 1, phase_Nsources(material_phaseAt(ipc,el)) + startPos = endPos + 1 + endPos = endPos + sourceState(material_phaseAt(ipc,el))%p(i)%sizePostResults + of = material_phasememberAt(ipc,ip,el) + sourceType: select case (phase_source(i,material_phaseAt(ipc,el))) + case (SOURCE_damage_isoBrittle_ID) sourceType + constitutive_postResults(startPos:endPos) = source_damage_isoBrittle_postResults(material_phaseAt(ipc,el),of) + case (SOURCE_damage_isoDuctile_ID) sourceType + constitutive_postResults(startPos:endPos) = source_damage_isoDuctile_postResults(material_phaseAt(ipc,el),of) + case (SOURCE_damage_anisoBrittle_ID) sourceType + constitutive_postResults(startPos:endPos) = source_damage_anisoBrittle_postResults(material_phaseAt(ipc,el),of) + case (SOURCE_damage_anisoDuctile_ID) sourceType + constitutive_postResults(startPos:endPos) = source_damage_anisoDuctile_postResults(material_phaseAt(ipc,el),of) + end select sourceType - enddo SourceLoop + enddo SourceLoop end function constitutive_postResults @@ -790,10 +788,9 @@ end function constitutive_postResults !> @brief writes constitutive results to HDF5 output file !-------------------------------------------------------------------------------------------------- subroutine constitutive_results - +#if defined(PETSc) || defined(DAMASK_HDF5) integer :: p character(len=256) :: group -#if defined(PETSc) || defined(DAMASK_HDF5) do p=1,size(config_name_phase) group = trim('current/constituent')//'/'//trim(config_name_phase(p)) call HDF5_closeGroup(results_addGroup(group)) @@ -824,9 +821,6 @@ subroutine constitutive_results enddo #endif - - end subroutine constitutive_results - end module constitutive From 3de3ebdd438934d64f467461538bb118af868c1c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 15:40:43 +0200 Subject: [PATCH 22/49] documentation was missing --- src/discretization.f90 | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/discretization.f90 b/src/discretization.f90 index a8f1c8fb7..30ae0a6b6 100644 --- a/src/discretization.f90 +++ b/src/discretization.f90 @@ -1,5 +1,6 @@ !-------------------------------------------------------------------------------------------------- !> @brief spatial discretization +!> @details serves as an abstraction layer between the different solvers and DAMASK !-------------------------------------------------------------------------------------------------- module discretization @@ -30,10 +31,12 @@ module discretization contains - +!-------------------------------------------------------------------------------------------------- +!> @brief stores the relevant information in globally accesible variables +!-------------------------------------------------------------------------------------------------- subroutine discretization_init(homogenizationAt,microstructureAt,IPcoords0,NodeCoords0) - integer, dimension(:), intent(in) :: & + integer, dimension(:), intent(in) :: & homogenizationAt, & microstructureAt real(pReal), dimension(:,:), intent(in) :: & @@ -57,6 +60,9 @@ subroutine discretization_init(homogenizationAt,microstructureAt,IPcoords0,NodeC end subroutine discretization_init +!-------------------------------------------------------------------------------------------------- +!> @brief write the displacements +!-------------------------------------------------------------------------------------------------- subroutine discretization_results #if defined(PETSc) || defined(DAMASK_HDF5) real(pReal), dimension(:,:), allocatable :: u @@ -70,6 +76,9 @@ subroutine discretization_results end subroutine discretization_results +!-------------------------------------------------------------------------------------------------- +!> @brief stores current IP coordinates +!-------------------------------------------------------------------------------------------------- subroutine discretization_setIPcoords(IPcoords) real(pReal), dimension(:,:), intent(in) :: IPcoords @@ -78,5 +87,4 @@ subroutine discretization_setIPcoords(IPcoords) end subroutine discretization_setIPcoords - end module discretization From 85e6885ea705cc22034a32cfea18853c73b5690a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 15:41:37 +0200 Subject: [PATCH 23/49] white space adjustments --- src/debug.f90 | 332 +++++++++++++++++++++++++------------------------- 1 file changed, 166 insertions(+), 166 deletions(-) diff --git a/src/debug.f90 b/src/debug.f90 index 10fc59631..86bcfcd29 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -6,70 +6,70 @@ !> @brief Reading in and interpretating the debugging settings for the various modules !-------------------------------------------------------------------------------------------------- module debug - use prec - use IO + use prec + use IO - implicit none - private + implicit none + private - integer, parameter, public :: & - debug_LEVELSELECTIVE = 2**0, & - debug_LEVELBASIC = 2**1, & - debug_LEVELEXTENSIVE = 2**2 - integer, parameter, private :: & - debug_MAXGENERAL = debug_LEVELEXTENSIVE ! must be set to the last bitcode used by (potentially) all debug types - integer, parameter, public :: & - debug_SPECTRALRESTART = debug_MAXGENERAL*2**1, & - debug_SPECTRALFFTW = debug_MAXGENERAL*2**2, & - debug_SPECTRALDIVERGENCE = debug_MAXGENERAL*2**3, & - debug_SPECTRALROTATION = debug_MAXGENERAL*2**4, & - debug_SPECTRALPETSC = debug_MAXGENERAL*2**5 - - integer, parameter, public :: & - debug_DEBUG = 1, & - debug_MATH = 2, & - debug_FESOLVING = 3, & - debug_MESH = 4, & !< stores debug level for mesh part of DAMASK bitwise coded - debug_MATERIAL = 5, & !< stores debug level for material part of DAMASK bitwise coded - debug_LATTICE = 6, & !< stores debug level for lattice part of DAMASK bitwise coded - debug_CONSTITUTIVE = 7, & !< stores debug level for constitutive part of DAMASK bitwise coded - debug_CRYSTALLITE = 8, & - debug_HOMOGENIZATION = 9, & - debug_CPFEM = 10, & - debug_SPECTRAL = 11, & - debug_MARC = 12, & - debug_ABAQUS = 13 - integer, parameter, private :: & - debug_MAXNTYPE = debug_ABAQUS !< must be set to the maximum defined debug type + integer, parameter, public :: & + debug_LEVELSELECTIVE = 2**0, & + debug_LEVELBASIC = 2**1, & + debug_LEVELEXTENSIVE = 2**2 + integer, parameter, private :: & + debug_MAXGENERAL = debug_LEVELEXTENSIVE ! must be set to the last bitcode used by (potentially) all debug types + integer, parameter, public :: & + debug_SPECTRALRESTART = debug_MAXGENERAL*2**1, & + debug_SPECTRALFFTW = debug_MAXGENERAL*2**2, & + debug_SPECTRALDIVERGENCE = debug_MAXGENERAL*2**3, & + debug_SPECTRALROTATION = debug_MAXGENERAL*2**4, & + debug_SPECTRALPETSC = debug_MAXGENERAL*2**5 + + integer, parameter, public :: & + debug_DEBUG = 1, & + debug_MATH = 2, & + debug_FESOLVING = 3, & + debug_MESH = 4, & !< stores debug level for mesh part of DAMASK bitwise coded + debug_MATERIAL = 5, & !< stores debug level for material part of DAMASK bitwise coded + debug_LATTICE = 6, & !< stores debug level for lattice part of DAMASK bitwise coded + debug_CONSTITUTIVE = 7, & !< stores debug level for constitutive part of DAMASK bitwise coded + debug_CRYSTALLITE = 8, & + debug_HOMOGENIZATION = 9, & + debug_CPFEM = 10, & + debug_SPECTRAL = 11, & + debug_MARC = 12, & + debug_ABAQUS = 13 + integer, parameter, private :: & + debug_MAXNTYPE = debug_ABAQUS !< must be set to the maximum defined debug type - integer,protected, dimension(debug_maxNtype+2), public :: & ! specific ones, and 2 for "all" and "other" - debug_level = 0 + integer,protected, dimension(debug_maxNtype+2), public :: & ! specific ones, and 2 for "all" and "other" + debug_level = 0 - integer, protected, public :: & - debug_e = 1, & - debug_i = 1, & - debug_g = 1 + integer, protected, public :: & + debug_e = 1, & + debug_i = 1, & + debug_g = 1 - integer, dimension(2), public :: & - debug_stressMaxLocation = 0, & - debug_stressMinLocation = 0, & - debug_jacobianMaxLocation = 0, & - debug_jacobianMinLocation = 0 + integer, dimension(2), public :: & + debug_stressMaxLocation = 0, & + debug_stressMinLocation = 0, & + debug_jacobianMaxLocation = 0, & + debug_jacobianMinLocation = 0 - real(pReal), public :: & - debug_stressMax = -huge(1.0_pReal), & - debug_stressMin = huge(1.0_pReal), & - debug_jacobianMax = -huge(1.0_pReal), & - debug_jacobianMin = huge(1.0_pReal) + real(pReal), public :: & + debug_stressMax = -huge(1.0_pReal), & + debug_stressMin = huge(1.0_pReal), & + debug_jacobianMax = -huge(1.0_pReal), & + debug_jacobianMin = huge(1.0_pReal) #ifdef PETSc - character(len=1024), parameter, public :: & - PETSCDEBUG = ' -snes_view -snes_monitor ' + character(len=1024), parameter, public :: & + PETSCDEBUG = ' -snes_view -snes_monitor ' #endif - public :: debug_init, & - debug_reset, & - debug_info + public :: debug_init, & + debug_reset, & + debug_info contains @@ -79,111 +79,111 @@ contains !-------------------------------------------------------------------------------------------------- subroutine debug_init - character(len=pStringLen), dimension(:), allocatable :: fileContent + character(len=pStringLen), dimension(:), allocatable :: fileContent - integer :: i, what, j - integer, allocatable, dimension(:) :: chunkPos - character(len=pStringLen) :: tag, line - logical :: fexist + integer :: i, what, j + integer, allocatable, dimension(:) :: chunkPos + character(len=pStringLen) :: tag, line + logical :: fexist - write(6,'(/,a)') ' <<<+- debug init -+>>>' + write(6,'(/,a)') ' <<<+- debug init -+>>>' #ifdef DEBUG - write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m' + write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m' #endif - inquire(file='debug.config', exist=fexist) + inquire(file='debug.config', exist=fexist) - fileExists: if (fexist) then - fileContent = IO_read_ASCII('debug.config') - do j=1, size(fileContent) - line = fileContent(j) - if (IO_isBlank(line)) cycle ! skip empty lines - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key - select case(tag) - case ('element','e','el') - debug_e = IO_intValue(line,chunkPos,2) - case ('integrationpoint','i','ip') - debug_i = IO_intValue(line,chunkPos,2) - case ('grain','g','gr') - debug_g = IO_intValue(line,chunkPos,2) - end select + fileExists: if (fexist) then + fileContent = IO_read_ASCII('debug.config') + do j=1, size(fileContent) + line = fileContent(j) + if (IO_isBlank(line)) cycle ! skip empty lines + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key + select case(tag) + case ('element','e','el') + debug_e = IO_intValue(line,chunkPos,2) + case ('integrationpoint','i','ip') + debug_i = IO_intValue(line,chunkPos,2) + case ('grain','g','gr') + debug_g = IO_intValue(line,chunkPos,2) + end select - what = 0 - select case(tag) - case ('debug') - what = debug_DEBUG - case ('math') - what = debug_MATH - case ('fesolving', 'fe') - what = debug_FESOLVING - case ('mesh') - what = debug_MESH - case ('material') - what = debug_MATERIAL - case ('lattice') - what = debug_LATTICE - case ('constitutive') - what = debug_CONSTITUTIVE - case ('crystallite') - what = debug_CRYSTALLITE - case ('homogenization') - what = debug_HOMOGENIZATION - case ('cpfem') - what = debug_CPFEM - case ('spectral') - what = debug_SPECTRAL - case ('marc') - what = debug_MARC - case ('abaqus') - what = debug_ABAQUS - case ('all') - what = debug_MAXNTYPE + 1 - case ('other') - what = debug_MAXNTYPE + 2 - end select - if (what /= 0) then - do i = 2, chunkPos(1) - select case(IO_lc(IO_stringValue(line,chunkPos,i))) - case('basic') - debug_level(what) = ior(debug_level(what), debug_LEVELBASIC) - case('extensive') - debug_level(what) = ior(debug_level(what), debug_LEVELEXTENSIVE) - case('selective') - debug_level(what) = ior(debug_level(what), debug_LEVELSELECTIVE) - case('restart') - debug_level(what) = ior(debug_level(what), debug_SPECTRALRESTART) - case('fft','fftw') - debug_level(what) = ior(debug_level(what), debug_SPECTRALFFTW) - case('divergence') - debug_level(what) = ior(debug_level(what), debug_SPECTRALDIVERGENCE) - case('rotation') - debug_level(what) = ior(debug_level(what), debug_SPECTRALROTATION) - case('petsc') - debug_level(what) = ior(debug_level(what), debug_SPECTRALPETSC) - end select - enddo - endif - enddo + what = 0 + select case(tag) + case ('debug') + what = debug_DEBUG + case ('math') + what = debug_MATH + case ('fesolving', 'fe') + what = debug_FESOLVING + case ('mesh') + what = debug_MESH + case ('material') + what = debug_MATERIAL + case ('lattice') + what = debug_LATTICE + case ('constitutive') + what = debug_CONSTITUTIVE + case ('crystallite') + what = debug_CRYSTALLITE + case ('homogenization') + what = debug_HOMOGENIZATION + case ('cpfem') + what = debug_CPFEM + case ('spectral') + what = debug_SPECTRAL + case ('marc') + what = debug_MARC + case ('abaqus') + what = debug_ABAQUS + case ('all') + what = debug_MAXNTYPE + 1 + case ('other') + what = debug_MAXNTYPE + 2 + end select + if (what /= 0) then + do i = 2, chunkPos(1) + select case(IO_lc(IO_stringValue(line,chunkPos,i))) + case('basic') + debug_level(what) = ior(debug_level(what), debug_LEVELBASIC) + case('extensive') + debug_level(what) = ior(debug_level(what), debug_LEVELEXTENSIVE) + case('selective') + debug_level(what) = ior(debug_level(what), debug_LEVELSELECTIVE) + case('restart') + debug_level(what) = ior(debug_level(what), debug_SPECTRALRESTART) + case('fft','fftw') + debug_level(what) = ior(debug_level(what), debug_SPECTRALFFTW) + case('divergence') + debug_level(what) = ior(debug_level(what), debug_SPECTRALDIVERGENCE) + case('rotation') + debug_level(what) = ior(debug_level(what), debug_SPECTRALROTATION) + case('petsc') + debug_level(what) = ior(debug_level(what), debug_SPECTRALPETSC) + end select + enddo + endif + enddo - do i = 1, debug_maxNtype - if (debug_level(i) == 0) & - debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 2)) ! fill undefined debug types with levels specified by "other" + do i = 1, debug_maxNtype + if (debug_level(i) == 0) & + debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 2)) ! fill undefined debug types with levels specified by "other" - debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 1)) ! fill all debug types with levels specified by "all" - enddo + debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 1)) ! fill all debug types with levels specified by "all" + enddo - if (iand(debug_level(debug_debug),debug_LEVELBASIC) /= 0) & - write(6,'(a,/)') ' using values from config file' - else fileExists - if (iand(debug_level(debug_debug),debug_LEVELBASIC) /= 0) & - write(6,'(a,/)') ' using standard values' - endif fileExists + if (iand(debug_level(debug_debug),debug_LEVELBASIC) /= 0) & + write(6,'(a,/)') ' using values from config file' + else fileExists + if (iand(debug_level(debug_debug),debug_LEVELBASIC) /= 0) & + write(6,'(a,/)') ' using standard values' + endif fileExists !-------------------------------------------------------------------------------------------------- ! output switched on (debug level for debug must be extensive) - if (iand(debug_level(debug_debug),debug_LEVELEXTENSIVE) /= 0) then + if (iand(debug_level(debug_debug),debug_LEVELEXTENSIVE) /= 0) then do i = 1, debug_MAXNTYPE select case(i) case (debug_DEBUG) @@ -231,7 +231,7 @@ subroutine debug_init if(iand(debug_level(i),debug_SPECTRALPETSC) /= 0) write(6,'(a)') ' PETSc' endif enddo - endif + endif end subroutine debug_init @@ -241,14 +241,14 @@ end subroutine debug_init !-------------------------------------------------------------------------------------------------- subroutine debug_reset - debug_stressMaxLocation = 0 - debug_stressMinLocation = 0 - debug_jacobianMaxLocation = 0 - debug_jacobianMinLocation = 0 - debug_stressMax = -huge(1.0_pReal) - debug_stressMin = huge(1.0_pReal) - debug_jacobianMax = -huge(1.0_pReal) - debug_jacobianMin = huge(1.0_pReal) + debug_stressMaxLocation = 0 + debug_stressMinLocation = 0 + debug_jacobianMaxLocation = 0 + debug_jacobianMinLocation = 0 + debug_stressMax = -huge(1.0_pReal) + debug_stressMin = huge(1.0_pReal) + debug_jacobianMax = -huge(1.0_pReal) + debug_jacobianMin = huge(1.0_pReal) end subroutine debug_reset @@ -258,18 +258,18 @@ end subroutine debug_reset !-------------------------------------------------------------------------------------------------- subroutine debug_info - !$OMP CRITICAL (write2out) - debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 & - .and. any(debug_stressMinLocation /= 0) & - .and. any(debug_stressMaxLocation /= 0) ) then - write(6,'(2/,a,/)') ' Extreme values of returned stress and Jacobian' - write(6,'(a39)') ' value el ip' - write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation - write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' max :', debug_stressMax, debug_stressMaxLocation - write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' Jacobian min :', debug_jacobianMin, debug_jacobianMinLocation - write(6,'(a14,1x,e12.3,1x,i8,1x,i4,/)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation - endif debugOutputCPFEM - !$OMP END CRITICAL (write2out) + !$OMP CRITICAL (write2out) + debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 & + .and. any(debug_stressMinLocation /= 0) & + .and. any(debug_stressMaxLocation /= 0) ) then + write(6,'(2/,a,/)') ' Extreme values of returned stress and Jacobian' + write(6,'(a39)') ' value el ip' + write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation + write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' max :', debug_stressMax, debug_stressMaxLocation + write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' Jacobian min :', debug_jacobianMin, debug_jacobianMinLocation + write(6,'(a14,1x,e12.3,1x,i8,1x,i4,/)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation + endif debugOutputCPFEM + !$OMP END CRITICAL (write2out) end subroutine debug_info From 9f35267470242a2ae4adc2833815cffc5197875c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 15:43:43 +0200 Subject: [PATCH 24/49] not needed --- src/element.f90 | 149 +++++------------------------------------------- 1 file changed, 13 insertions(+), 136 deletions(-) diff --git a/src/element.f90 b/src/element.f90 index dca5cbd28..8da633082 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -10,7 +10,7 @@ module element private !--------------------------------------------------------------------------------------------------- -!> Properties of a single element (the element used in the mesh) +!> Properties of a single element !--------------------------------------------------------------------------------------------------- type, public :: tElement integer :: & @@ -21,11 +21,9 @@ module element Ncellnodes, & NcellnodesPerCell, & nIPs, & - nIPneighbors, & ! ToDo: MD: Do all IPs in one element type have the same number of neighbors? - maxNnodeAtIP + nIPneighbors integer, dimension(:,:), allocatable :: & Cell, & !< intra-element (cell) nodes that constitute a cell - NnodeAtIP, & IPneighbor, & cellFace integer, dimension(:,:), allocatable :: & @@ -163,114 +161,6 @@ module element 8 & ! 3D 8node ] !< number of cell nodes in a specific cell type - - -! -------------------------------------------------------------------------------------------------- -! MD: probably not needed START - integer, dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = & - reshape([& - 1,2,3 & - ],[maxNnodeAtIP(1),nIP(1)]) - - integer, dimension(maxNnodeAtIP(2),nIP(2)), parameter, private :: NnodeAtIP2 = & - reshape([& - 1, & - 2, & - 3 & - ],[maxNnodeAtIP(2),nIP(2)]) - - integer, dimension(maxNnodeAtIP(3),nIP(3)), parameter, private :: NnodeAtIP3 = & - reshape([& - 1, & - 2, & - 4, & - 3 & - ],[maxNnodeAtIP(3),nIP(3)]) - - integer, dimension(maxNnodeAtIP(4),nIP(4)), parameter, private :: NnodeAtIP4 = & - reshape([& - 1,0, & - 1,2, & - 2,0, & - 1,4, & - 0,0, & - 2,3, & - 4,0, & - 3,4, & - 3,0 & - ],[maxNnodeAtIP(4),nIP(4)]) - - integer, dimension(maxNnodeAtIP(5),nIP(5)), parameter, private :: NnodeAtIP5 = & - reshape([& - 1,2,3,4 & - ],[maxNnodeAtIP(5),nIP(5)]) - - integer, dimension(maxNnodeAtIP(6),nIP(6)), parameter, private :: NnodeAtIP6 = & - reshape([& - 1, & - 2, & - 3, & - 4 & - ],[maxNnodeAtIP(6),nIP(6)]) - - integer, dimension(maxNnodeAtIP(7),nIP(7)), parameter, private :: NnodeAtIP7 = & - reshape([& - 1, & - 2, & - 3, & - 4, & - 5, & - 6 & - ],[maxNnodeAtIP(7),nIP(7)]) - - integer, dimension(maxNnodeAtIP(8),nIP(8)), parameter, private :: NnodeAtIP8 = & - reshape([& - 1,2,3,4,5,6,7,8 & - ],[maxNnodeAtIP(8),nIP(8)]) - - integer, dimension(maxNnodeAtIP(9),nIP(9)), parameter, private :: NnodeAtIP9 = & - reshape([& - 1, & - 2, & - 4, & - 3, & - 5, & - 6, & - 8, & - 7 & - ],[maxNnodeAtIP(9),nIP(9)]) - - integer, dimension(maxNnodeAtIP(10),nIP(10)), parameter, private :: NnodeAtIP10 = & - reshape([& - 1,0, 0,0, & - 1,2, 0,0, & - 2,0, 0,0, & - 1,4, 0,0, & - 1,3, 2,4, & - 2,3, 0,0, & - 4,0, 0,0, & - 3,4, 0,0, & - 3,0, 0,0, & - 1,5, 0,0, & - 1,6, 2,5, & - 2,6, 0,0, & - 1,8, 4,5, & - 0,0, 0,0, & - 2,7, 3,6, & - 4,8, 0,0, & - 3,8, 4,7, & - 3,7, 0,0, & - 5,0, 0,0, & - 5,6, 0,0, & - 6,0, 0,0, & - 5,8, 0,0, & - 5,7, 6,8, & - 6,7, 0,0, & - 8,0, 0,0, & - 7,8, 0,0, & - 7,0, 0,0 & - ],[maxNnodeAtIP(10),nIP(10)]) - ! *** FE_ipNeighbor *** ! is a list of the neighborhood of each IP. ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. @@ -803,9 +693,9 @@ module element ],[NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)]) !< 3D 8node, VTK_HEXAHEDRON (12) - contains +contains - subroutine tElement_init(self,elemType) +subroutine tElement_init(self,elemType) class(tElement) :: self integer, intent(in) :: elemType @@ -846,50 +736,38 @@ module element self%NcellNodes = NcellNode (self%geomType) - self%maxNnodeAtIP = maxNnodeAtIP (self%geomType) self%nIPs = nIP (self%geomType) self%cellType = cellType (self%geomType) - select case (self%geomType) case(1) - self%NnodeAtIP = NnodeAtIP1 self%IPneighbor = IPneighbor1 self%cell = CELL1 case(2) - self%NnodeAtIP = NnodeAtIP2 self%IPneighbor = IPneighbor2 self%cell = CELL2 case(3) - self%NnodeAtIP = NnodeAtIP3 self%IPneighbor = IPneighbor3 self%cell = CELL3 case(4) - self%NnodeAtIP = NnodeAtIP4 self%IPneighbor = IPneighbor4 self%cell = CELL4 case(5) - self%NnodeAtIP = NnodeAtIP5 self%IPneighbor = IPneighbor5 self%cell = CELL5 case(6) - self%NnodeAtIP = NnodeAtIP6 self%IPneighbor = IPneighbor6 self%cell = CELL6 case(7) - self%NnodeAtIP = NnodeAtIP7 self%IPneighbor = IPneighbor7 self%cell = CELL7 case(8) - self%NnodeAtIP = NnodeAtIP8 self%IPneighbor = IPneighbor8 self%cell = CELL8 case(9) - self%NnodeAtIP = NnodeAtIP9 self%IPneighbor = IPneighbor9 self%cell = CELL9 case(10) - self%NnodeAtIP = NnodeAtIP10 self%IPneighbor = IPneighbor10 self%cell = CELL10 end select @@ -911,16 +789,15 @@ module element write(6,'(/,a)') ' <<<+- element_init -+>>>' - write(6,*)' element type: ',self%elemType - write(6,*)' geom type: ',self%geomType - write(6,*)' cell type: ',self%cellType - write(6,*)' # node: ',self%Nnodes - write(6,*)' # IP: ',self%nIPs - write(6,*)' # cellnode: ',self%Ncellnodes - write(6,*)' # cellnode/cell: ',self%NcellnodesPerCell - write(6,*)' # IP neighbor: ',self%nIPneighbors - write(6,*)' max # node at IP: ',self%maxNnodeAtIP + write(6,*) ' element type: ',self%elemType + write(6,*) ' geom type: ',self%geomType + write(6,*) ' cell type: ',self%cellType + write(6,*) ' # node: ',self%Nnodes + write(6,*) ' # IP: ',self%nIPs + write(6,*) ' # cellnode: ',self%Ncellnodes + write(6,*) ' # cellnode/cell: ',self%NcellnodesPerCell + write(6,*) ' # IP neighbor: ',self%nIPneighbors - end subroutine tElement_init +end subroutine tElement_init end module element From 0c52262e4a4f54f96d76b1f510dcb3101174c469 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 15:44:15 +0200 Subject: [PATCH 25/49] white space adjustments --- src/crystallite.f90 | 194 ++++++++++++++++++++++---------------------- 1 file changed, 96 insertions(+), 98 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index a779c3223..d2e8ae97c 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -873,106 +873,106 @@ end function crystallite_push33ToRef !-------------------------------------------------------------------------------------------------- function crystallite_postResults(ipc, ip, el) - integer, intent(in):: & - el, & !< element index - ip, & !< integration point index - ipc !< grain index + integer, intent(in):: & + el, & !< element index + ip, & !< integration point index + ipc !< grain index - real(pReal), dimension(1+crystallite_sizePostResults(microstructure_crystallite(discretization_microstructureAt(el))) + & - 1+plasticState(material_phaseAt(ipc,el))%sizePostResults + & - sum(sourceState(material_phaseAt(ipc,el))%p(:)%sizePostResults)) :: & - crystallite_postResults - integer :: & - o, & - c, & - crystID, & - mySize, & - n - type(rotation) :: rot + real(pReal), dimension(1+crystallite_sizePostResults(microstructure_crystallite(discretization_microstructureAt(el))) + & + 1+plasticState(material_phaseAt(ipc,el))%sizePostResults + & + sum(sourceState(material_phaseAt(ipc,el))%p(:)%sizePostResults)) :: & + crystallite_postResults + integer :: & + o, & + c, & + crystID, & + mySize, & + n + type(rotation) :: rot - crystID = microstructure_crystallite(discretization_microstructureAt(el)) + crystID = microstructure_crystallite(discretization_microstructureAt(el)) - crystallite_postResults = 0.0_pReal - crystallite_postResults(1) = real(crystallite_sizePostResults(crystID),pReal) ! header-like information (length) - c = 1 + crystallite_postResults = 0.0_pReal + crystallite_postResults(1) = real(crystallite_sizePostResults(crystID),pReal) ! header-like information (length) + c = 1 - do o = 1,crystallite_Noutput(crystID) - mySize = 0 - select case(crystallite_outputID(o,crystID)) - case (phase_ID) - mySize = 1 - crystallite_postResults(c+1) = real(material_phaseAt(ipc,el),pReal) ! phaseID of grain - case (texture_ID) - mySize = 1 - crystallite_postResults(c+1) = real(material_texture(ipc,ip,el),pReal) ! textureID of grain - case (orientation_ID) - mySize = 4 - crystallite_postResults(c+1:c+mySize) = crystallite_orientation(ipc,ip,el)%asQuaternion() + do o = 1,crystallite_Noutput(crystID) + mySize = 0 + select case(crystallite_outputID(o,crystID)) + case (phase_ID) + mySize = 1 + crystallite_postResults(c+1) = real(material_phaseAt(ipc,el),pReal) ! phaseID of grain + case (texture_ID) + mySize = 1 + crystallite_postResults(c+1) = real(material_texture(ipc,ip,el),pReal) ! textureID of grain + case (orientation_ID) + mySize = 4 + crystallite_postResults(c+1:c+mySize) = crystallite_orientation(ipc,ip,el)%asQuaternion() - case (grainrotation_ID) - rot = crystallite_orientation0(ipc,ip,el)%misorientation(crystallite_orientation(ipc,ip,el)) - mySize = 4 - crystallite_postResults(c+1:c+mySize) = rot%asAxisAnglePair() - crystallite_postResults(c+4) = inDeg * crystallite_postResults(c+4) ! angle in degree + case (grainrotation_ID) + rot = crystallite_orientation0(ipc,ip,el)%misorientation(crystallite_orientation(ipc,ip,el)) + mySize = 4 + crystallite_postResults(c+1:c+mySize) = rot%asAxisAnglePair() + crystallite_postResults(c+4) = inDeg * crystallite_postResults(c+4) ! angle in degree ! remark: tensor output is of the form 11,12,13, 21,22,23, 31,32,33 ! thus row index i is slow, while column index j is fast. reminder: "row is slow" - case (defgrad_ID) - mySize = 9 - crystallite_postResults(c+1:c+mySize) = & - reshape(transpose(crystallite_partionedF(1:3,1:3,ipc,ip,el)),[mySize]) - case (fe_ID) - mySize = 9 - crystallite_postResults(c+1:c+mySize) = & - reshape(transpose(crystallite_Fe(1:3,1:3,ipc,ip,el)),[mySize]) - case (fp_ID) - mySize = 9 - crystallite_postResults(c+1:c+mySize) = & - reshape(transpose(crystallite_Fp(1:3,1:3,ipc,ip,el)),[mySize]) - case (fi_ID) - mySize = 9 - crystallite_postResults(c+1:c+mySize) = & - reshape(transpose(crystallite_Fi(1:3,1:3,ipc,ip,el)),[mySize]) - case (lp_ID) - mySize = 9 - crystallite_postResults(c+1:c+mySize) = & - reshape(transpose(crystallite_Lp(1:3,1:3,ipc,ip,el)),[mySize]) - case (li_ID) - mySize = 9 - crystallite_postResults(c+1:c+mySize) = & - reshape(transpose(crystallite_Li(1:3,1:3,ipc,ip,el)),[mySize]) - case (p_ID) - mySize = 9 - crystallite_postResults(c+1:c+mySize) = & - reshape(transpose(crystallite_P(1:3,1:3,ipc,ip,el)),[mySize]) - case (s_ID) - mySize = 9 - crystallite_postResults(c+1:c+mySize) = & - reshape(crystallite_S(1:3,1:3,ipc,ip,el),[mySize]) - case (elasmatrix_ID) - mySize = 36 - crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize]) - case(neighboringelement_ID) - mySize = nIPneighbors - crystallite_postResults(c+1:c+mySize) = 0.0_pReal - forall (n = 1:mySize) & - crystallite_postResults(c+n) = real(IPneighborhood(1,n,ip,el),pReal) - case(neighboringip_ID) - mySize = nIPneighbors - crystallite_postResults(c+1:c+mySize) = 0.0_pReal - forall (n = 1:mySize) & - crystallite_postResults(c+n) = real(IPneighborhood(2,n,ip,el),pReal) - end select - c = c + mySize - enddo + case (defgrad_ID) + mySize = 9 + crystallite_postResults(c+1:c+mySize) = & + reshape(transpose(crystallite_partionedF(1:3,1:3,ipc,ip,el)),[mySize]) + case (fe_ID) + mySize = 9 + crystallite_postResults(c+1:c+mySize) = & + reshape(transpose(crystallite_Fe(1:3,1:3,ipc,ip,el)),[mySize]) + case (fp_ID) + mySize = 9 + crystallite_postResults(c+1:c+mySize) = & + reshape(transpose(crystallite_Fp(1:3,1:3,ipc,ip,el)),[mySize]) + case (fi_ID) + mySize = 9 + crystallite_postResults(c+1:c+mySize) = & + reshape(transpose(crystallite_Fi(1:3,1:3,ipc,ip,el)),[mySize]) + case (lp_ID) + mySize = 9 + crystallite_postResults(c+1:c+mySize) = & + reshape(transpose(crystallite_Lp(1:3,1:3,ipc,ip,el)),[mySize]) + case (li_ID) + mySize = 9 + crystallite_postResults(c+1:c+mySize) = & + reshape(transpose(crystallite_Li(1:3,1:3,ipc,ip,el)),[mySize]) + case (p_ID) + mySize = 9 + crystallite_postResults(c+1:c+mySize) = & + reshape(transpose(crystallite_P(1:3,1:3,ipc,ip,el)),[mySize]) + case (s_ID) + mySize = 9 + crystallite_postResults(c+1:c+mySize) = & + reshape(crystallite_S(1:3,1:3,ipc,ip,el),[mySize]) + case (elasmatrix_ID) + mySize = 36 + crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize]) + case(neighboringelement_ID) + mySize = nIPneighbors + crystallite_postResults(c+1:c+mySize) = 0.0_pReal + forall (n = 1:mySize) & + crystallite_postResults(c+n) = real(IPneighborhood(1,n,ip,el),pReal) + case(neighboringip_ID) + mySize = nIPneighbors + crystallite_postResults(c+1:c+mySize) = 0.0_pReal + forall (n = 1:mySize) & + crystallite_postResults(c+n) = real(IPneighborhood(2,n,ip,el),pReal) + end select + c = c + mySize + enddo - crystallite_postResults(c+1) = real(plasticState(material_phaseAt(ipc,el))%sizePostResults,pReal) ! size of constitutive results - c = c + 1 - if (size(crystallite_postResults)-c > 0) & - crystallite_postResults(c+1:size(crystallite_postResults)) = & - constitutive_postResults(crystallite_S(1:3,1:3,ipc,ip,el), crystallite_Fi(1:3,1:3,ipc,ip,el), & - ipc, ip, el) + crystallite_postResults(c+1) = real(plasticState(material_phaseAt(ipc,el))%sizePostResults,pReal) ! size of constitutive results + c = c + 1 + if (size(crystallite_postResults)-c > 0) & + crystallite_postResults(c+1:size(crystallite_postResults)) = & + constitutive_postResults(crystallite_S(1:3,1:3,ipc,ip,el), crystallite_Fi(1:3,1:3,ipc,ip,el), & + ipc, ip, el) end function crystallite_postResults @@ -1046,13 +1046,13 @@ subroutine crystallite_results 'crystal orientation as quaternion',lattice_label) end select enddo - enddo + enddo - contains + contains -!-------------------------------------------------------------------------------------------------- -!> @brief select tensors for output -!-------------------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------------------ + !> @brief select tensors for output + !------------------------------------------------------------------------------------------------ function select_tensors(dataset,instance) integer, intent(in) :: instance @@ -1091,7 +1091,7 @@ subroutine crystallite_results j=0 do e = 1, size(material_phaseAt,2) - do i = 1, homogenization_maxNgrains !ToDo: this needs to be changed for varying Ngrains + do i = 1, homogenization_maxNgrains !ToDo: this needs to be changed for varying Ngrains do c = 1, size(material_phaseAt,1) if (material_phaseAt(c,e) == instance) then j = j + 1 @@ -1103,8 +1103,6 @@ subroutine crystallite_results end function select_rotations #endif - - end subroutine crystallite_results From 25d02c2f19b2a63d0ca1a71586df407fb51358e8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 15:48:47 +0200 Subject: [PATCH 26/49] most of the functionality is only relevant for commercial FEM --- src/CPFEM2.f90 | 47 +++++++++----------- src/FEsolving.f90 | 37 ++++++--------- src/grid/DAMASK_grid.f90 | 14 +++--- src/grid/grid_mech_FEM.f90 | 16 ++++--- src/grid/grid_mech_spectral_basic.f90 | 16 ++++--- src/grid/grid_mech_spectral_polarisation.f90 | 16 ++++--- src/mesh/DAMASK_FEM.f90 | 2 +- 7 files changed, 70 insertions(+), 78 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index c9b497f9d..dce2bb747 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -42,7 +42,7 @@ contains !-------------------------------------------------------------------------------------------------- subroutine CPFEM_initAll - call DAMASK_interface_init ! Spectral and FEM interface to commandline + call DAMASK_interface_init ! Spectral and FEM interface to commandline call prec_init call IO_init #ifdef FEM @@ -52,7 +52,6 @@ subroutine CPFEM_initAll call debug_init call config_init call math_init - call FE_init call mesh_init call lattice_init call HDF5_utilities_init @@ -78,8 +77,8 @@ subroutine CPFEM_init write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' flush(6) - ! *** restore the last converged values of each essential variable from the binary file - if (restartRead) then + ! *** restore the last converged values of each essential variable + if (interface_restartInc > 0) then if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0) then write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from hdf5 file' flush(6) @@ -89,30 +88,28 @@ subroutine CPFEM_init fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5') - call HDF5_read(fileHandle,crystallite_F0, 'convergedF') - call HDF5_read(fileHandle,crystallite_Fp0, 'convergedFp') - call HDF5_read(fileHandle,crystallite_Fi0, 'convergedFi') - call HDF5_read(fileHandle,crystallite_Lp0, 'convergedLp') - call HDF5_read(fileHandle,crystallite_Li0, 'convergedLi') - call HDF5_read(fileHandle,crystallite_S0, 'convergedS') + call HDF5_read(fileHandle,crystallite_F0, 'convergedF') + call HDF5_read(fileHandle,crystallite_Fp0,'convergedFp') + call HDF5_read(fileHandle,crystallite_Fi0,'convergedFi') + call HDF5_read(fileHandle,crystallite_Lp0,'convergedLp') + call HDF5_read(fileHandle,crystallite_Li0,'convergedLi') + call HDF5_read(fileHandle,crystallite_S0, 'convergedS') groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases') do ph = 1,size(phase_plasticity) - write(PlasticItem,*) ph,'_' - call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst') + write(PlasticItem,*) ph,'_' + call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst') enddo call HDF5_closeGroup(groupPlasticID) groupHomogID = HDF5_openGroup(fileHandle,'HomogStates') do homog = 1, material_Nhomogenization - write(HomogItem,*) homog,'_' - call HDF5_read(groupHomogID,homogState(homog)%state0, trim(HomogItem)//'convergedStateHomog') + write(HomogItem,*) homog,'_' + call HDF5_read(groupHomogID,homogState(homog)%state0, trim(HomogItem)//'convergedStateHomog') enddo call HDF5_closeGroup(groupHomogID) call HDF5_closeFile(fileHandle) - - restartRead = .false. endif end subroutine CPFEM_init @@ -135,7 +132,7 @@ subroutine CPFEM_age crystallite_Lp0 = crystallite_Lp crystallite_Fi0 = crystallite_Fi crystallite_Li0 = crystallite_Li - crystallite_S0 = crystallite_S + crystallite_S0 = crystallite_S do i = 1, size(plasticState) plasticState(i)%state0 = plasticState(i)%state @@ -157,12 +154,12 @@ subroutine CPFEM_age write(rankStr,'(a1,i0)')'_',worldrank fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','a') - call HDF5_write(fileHandle,crystallite_F0, 'convergedF') - call HDF5_write(fileHandle,crystallite_Fp0, 'convergedFp') - call HDF5_write(fileHandle,crystallite_Fi0, 'convergedFi') - call HDF5_write(fileHandle,crystallite_Lp0, 'convergedLp') - call HDF5_write(fileHandle,crystallite_Li0, 'convergedLi') - call HDF5_write(fileHandle,crystallite_S0, 'convergedS') + call HDF5_write(fileHandle,crystallite_F0, 'convergedF') + call HDF5_write(fileHandle,crystallite_Fp0, 'convergedFp') + call HDF5_write(fileHandle,crystallite_Fi0, 'convergedFi') + call HDF5_write(fileHandle,crystallite_Lp0, 'convergedLp') + call HDF5_write(fileHandle,crystallite_Li0, 'convergedLi') + call HDF5_write(fileHandle,crystallite_S0, 'convergedS') groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases') do ph = 1,size(phase_plasticity) @@ -193,8 +190,8 @@ end subroutine CPFEM_age !-------------------------------------------------------------------------------------------------- subroutine CPFEM_results(inc,time) - integer, intent(in) :: inc - real(pReal), intent(in) :: time + integer, intent(in) :: inc + real(pReal), intent(in) :: time call results_openJobFile call results_addIncrement(inc,time) diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 index 7e4742139..98bab4569 100644 --- a/src/FEsolving.f90 +++ b/src/FEsolving.f90 @@ -1,8 +1,7 @@ !-------------------------------------------------------------------------------------------------- !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief triggering reading in of restart information when doing a restart -!> @todo Descriptions for public variables needed +!> @brief holds some global variables and gets extra information for commercial FEM !-------------------------------------------------------------------------------------------------- module FEsolving use prec @@ -12,32 +11,34 @@ module FEsolving implicit none private - integer, public :: & - restartInc = 1 !< needs description - + logical, public :: & - symmetricSolver = .false., & !< use a symmetric FEM solver - restartWrite = .false., & !< write current state to enable restart +#if defined(Marc4DAMASK) || defined(Abaqus) restartRead = .false., & !< restart information to continue calculation from saved state +#endif + restartWrite = .false., & !< write current state to enable restart terminallyIll = .false. !< at least one material point is terminally ill integer, dimension(:,:), allocatable, public :: & FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP - - integer, dimension(2), public :: & + integer, dimension(2), public :: & FEsolving_execElem !< for ping-pong scheme always whole range, otherwise one specific element +#if defined(Marc4DAMASK) || defined(Abaqus) + logical, public, protected :: & + symmetricSolver = .false., & !< use a symmetric FEM solver character(len=1024), public :: & modelName !< needs description - logical, dimension(:,:), allocatable, public :: & calcMode !< do calculation or simply collect when using ping pong scheme public :: FE_init +#endif contains +#if defined(Marc4DAMASK) || defined(Abaqus) !-------------------------------------------------------------------------------------------------- !> @brief determine whether a symmetric solver is used and whether restart is requested !> @details restart information is found in input file in case of FEM solvers, in case of spectal @@ -45,27 +46,15 @@ contains !-------------------------------------------------------------------------------------------------- subroutine FE_init -#if defined(Marc4DAMASK) || defined(Abaqus) integer, parameter :: & FILEUNIT = 222 integer :: j character(len=65536) :: tag, line integer, allocatable, dimension(:) :: chunkPos -#endif write(6,'(/,a)') ' <<<+- FEsolving init -+>>>' - modelName = getSolverJobName() - -#if defined(Grid) || defined(FEM) - restartInc = interface_RestartInc - - if(restartInc < 0) then - call IO_warning(warning_ID=34) - restartInc = 0 - endif - restartRead = restartInc > 0 ! only read in if "true" restart requested -#else + modelName = getSolverJobName() call IO_open_inputFile(FILEUNIT,modelName) rewind(FILEUNIT) do @@ -125,7 +114,6 @@ subroutine FE_init 200 close(FILEUNIT) endif -#endif if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0) then write(6,'(a21,l1)') ' restart writing: ', restartWrite write(6,'(a21,l1)') ' restart reading: ', restartRead @@ -133,5 +121,6 @@ subroutine FE_init endif end subroutine FE_init +#endif end module FEsolving diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index d006fc5c2..a55cbbe17 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -336,20 +336,20 @@ program DAMASK_spectral writeHeader: if (interface_restartInc < 1) then open(newunit=fileUnit,file=trim(getSolverJobName())//& '.spectralOut',form='UNFORMATTED',status='REPLACE') - write(fileUnit) 'load:', trim(loadCaseFile) ! ... and write header + write(fileUnit) 'load:', trim(loadCaseFile) ! ... and write header write(fileUnit) 'workingdir:', 'n/a' write(fileUnit) 'geometry:', trim(geometryFile) write(fileUnit) 'grid:', grid write(fileUnit) 'size:', geomSize write(fileUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults write(fileUnit) 'loadcases:', size(loadCases) - write(fileUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase - write(fileUnit) 'times:', loadCases%time ! one entry per LoadCase + write(fileUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase + write(fileUnit) 'times:', loadCases%time ! one entry per LoadCase write(fileUnit) 'logscales:', loadCases%logscale - write(fileUnit) 'increments:', loadCases%incs ! one entry per LoadCase - write(fileUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc + write(fileUnit) 'increments:', loadCases%incs ! one entry per LoadCase + write(fileUnit) 'startingIncrement:', interface_restartInc ! start with writing out the previous inc write(fileUnit) 'eoh' - close(fileUnit) ! end of header + close(fileUnit) ! end of header open(newunit=statUnit,file=trim(getSolverJobName())//& '.sta',form='FORMATTED',status='REPLACE') write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file @@ -425,7 +425,7 @@ program DAMASK_spectral endif timeinc = timeinc * real(subStepFactor,pReal)**real(-cutBackLevel,pReal) ! depending on cut back level, decrease time step - skipping: if (totalIncsCounter <= restartInc) then ! not yet at restart inc? + skipping: if (totalIncsCounter <= interface_restartInc) then ! not yet at restart inc? time = time + timeinc ! just advance time, skip already performed calculation guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference else skipping diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index dd5028d48..59252a674 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -181,8 +181,9 @@ subroutine grid_mech_FEM_init !-------------------------------------------------------------------------------------------------- ! init fields - restart: if (restartInc > 0) then - write(6,'(/,a,'//IO_intOut(restartInc)//',a)') 'reading values of increment ', restartInc, ' from file' + restartRead: if (interface_restartInc > 0) then + write(6,'(/,a,'//IO_intOut(interface_restartInc)//',a)') & + 'reading values of increment ', interface_restartInc, ' from file' write(rankStr,'(a1,i0)')'_',worldrank fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5') @@ -195,10 +196,10 @@ subroutine grid_mech_FEM_init call HDF5_read(fileHandle,u_current, 'u') call HDF5_read(fileHandle,u_lastInc, 'u_lastInc') - elseif (restartInc == 0) then restart + elseif (interface_restartInc == 0) then restartRead F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity F = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) - endif restart + endif restartRead materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent call utilities_updateIPcoords(F) call utilities_constitutiveResponse(P_current,temp33_Real,C_volAvg,devNull, & ! stress field, stress avg, global average of stiffness and (min+max)/2 @@ -210,12 +211,13 @@ subroutine grid_mech_FEM_init call DMDAVecRestoreArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr) CHKERRQ(ierr) - restartRead: if (restartInc > 0) then - write(6,'(/,a,'//IO_intOut(restartInc)//',a)') 'reading more values of increment ', restartInc, ' from file' + restartRead2: if (interface_restartInc > 0) then + write(6,'(/,a,'//IO_intOut(interface_restartInc)//',a)') & + 'reading more values of increment ', interface_restartInc, ' from file' call HDF5_read(fileHandle,C_volAvg, 'C_volAvg') call HDF5_read(fileHandle,C_volAvgLastInc,'C_volAvgLastInc') call HDF5_closeFile(fileHandle) - endif restartRead + endif restartRead2 end subroutine grid_mech_FEM_init diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index 7528b1a1d..1581c8b9a 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -151,8 +151,9 @@ subroutine grid_mech_spectral_basic_init ! init fields call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! places pointer on PETSc data - restart: if (restartInc > 0) then - write(6,'(/,a,'//IO_intOut(restartInc)//',a)') ' reading values of increment ', restartInc, ' from file' + restartRead: if (interface_restartInc > 0) then + write(6,'(/,a,'//IO_intOut(interface_restartInc)//',a)') & + ' reading values of increment ', interface_restartInc, ' from file' write(rankStr,'(a1,i0)')'_',worldrank fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5') @@ -163,10 +164,10 @@ subroutine grid_mech_spectral_basic_init call HDF5_read(fileHandle,F, 'F') call HDF5_read(fileHandle,F_lastInc, 'F_lastInc') - elseif (restartInc == 0) then restart + elseif (interface_restartInc == 0) then restartRead F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) - endif restart + endif restartRead materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) @@ -176,15 +177,16 @@ subroutine grid_mech_spectral_basic_init math_I3) ! no rotation of boundary condition call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! deassociate pointer - restartRead: if (restartInc > 0) then - write(6,'(/,a,'//IO_intOut(restartInc)//',a)') 'reading more values of increment ', restartInc, ' from file' + restartRead2: if (interface_restartInc > 0) then + write(6,'(/,a,'//IO_intOut(interface_restartInc)//',a)') & + 'reading more values of increment ', interface_restartInc, ' from file' call HDF5_read(fileHandle,C_volAvg, 'C_volAvg') call HDF5_read(fileHandle,C_volAvgLastInc,'C_volAvgLastInc') call HDF5_closeFile(fileHandle) fileUnit = IO_open_jobFile_binary('C_ref') read(fileUnit) C_minMaxAvg; close(fileUnit) - endif restartRead + endif restartRead2 call utilities_updateGamma(C_minMaxAvg,.true.) diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 68d34d5b0..ccc7e77c0 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -160,8 +160,9 @@ subroutine grid_mech_spectral_polarisation_init F => FandF_tau( 0: 8,:,:,:) F_tau => FandF_tau( 9:17,:,:,:) - restart: if (restartInc > 0) then - write(6,'(/,a,'//IO_intOut(restartInc)//',a)') ' reading values of increment ', restartInc, ' from file' + restartRead: if (interface_restartInc > 0) then + write(6,'(/,a,'//IO_intOut(interface_restartInc)//',a)') & + ' reading values of increment ', interface_restartInc, ' from file' write(rankStr,'(a1,i0)')'_',worldrank fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5') @@ -174,12 +175,12 @@ subroutine grid_mech_spectral_polarisation_init call HDF5_read(fileHandle,F_tau, 'F_tau') call HDF5_read(fileHandle,F_tau_lastInc,'F_tau_lastInc') - elseif (restartInc == 0) then restart + elseif (interface_restartInc == 0) then restartRead F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) F_tau = 2.0_pReal*F F_tau_lastInc = 2.0_pReal*F_lastInc - endif restart + endif restartRead materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) @@ -189,15 +190,16 @@ subroutine grid_mech_spectral_polarisation_init math_I3) ! no rotation of boundary condition call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr) ! deassociate pointer - restartRead: if (restartInc > 0) then - write(6,'(/,a,'//IO_intOut(restartInc)//',a)') ' reading more values of increment ', restartInc, ' from file' + restartRead2: if (interface_restartInc > 0) then + write(6,'(/,a,'//IO_intOut(interface_restartInc)//',a)') & + ' reading more values of increment ', interface_restartInc, ' from file' call HDF5_read(fileHandle,C_volAvg, 'C_volAvg') call HDF5_read(fileHandle,C_volAvgLastInc,'C_volAvgLastInc') call HDF5_closeFile(fileHandle) fileUnit = IO_open_jobFile_binary('C_ref') read(fileUnit) C_minMaxAvg; close(fileUnit) - endif restartRead + endif restartRead2 call utilities_updateGamma(C_minMaxAvg,.true.) C_scale = C_minMaxAvg diff --git a/src/mesh/DAMASK_FEM.f90 b/src/mesh/DAMASK_FEM.f90 index 7400f1acb..5c4c5c21c 100644 --- a/src/mesh/DAMASK_FEM.f90 +++ b/src/mesh/DAMASK_FEM.f90 @@ -291,7 +291,7 @@ program DAMASK_FEM endif timeinc = timeinc * real(subStepFactor,pReal)**real(-cutBackLevel,pReal) ! depending on cut back level, decrease time step - skipping: if (totalIncsCounter <= restartInc) then ! not yet at restart inc? + skipping: if (totalIncsCounter <= interface_restartInc) then ! not yet at restart inc? time = time + timeinc ! just advance time, skip already performed calculation guess = .true. else skipping From 4256f6791934481dde4c50bfb200133bdfc611ee Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 16:21:15 +0200 Subject: [PATCH 27/49] polishing --- src/DAMASK_marc.f90 | 3 +-- src/future.f90 | 1 + 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 72017011d..3f527daf5 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -353,8 +353,7 @@ subroutine flux(f,ts,n,time) !-------------------------------------------------------------------------------------------------- -!> @brief sets user defined output variables for Marc -!> @details select a variable contour plotting (user subroutine). +!> @brief trigger writing of results !-------------------------------------------------------------------------------------------------- subroutine uedinc(inc,incsub) use prec diff --git a/src/future.f90 b/src/future.f90 index a8fcd3d8e..214bedc17 100644 --- a/src/future.f90 +++ b/src/future.f90 @@ -32,6 +32,7 @@ function findloc(a,v) end function findloc #endif + #if defined(__PGI) !-------------------------------------------------------------------------------------------------- !> @brief substitute for the norm2 intrinsic (only for real, dimension(3) at the moment) From f54a6cdc3bfd3253e58ec3e65160fcd674f6a58c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 16:42:16 +0200 Subject: [PATCH 28/49] white space adjustments --- src/HDF5_utilities.f90 | 204 ++++---- src/homogenization.f90 | 1022 ++++++++++++++++++++-------------------- 2 files changed, 611 insertions(+), 615 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 06de28d90..df5449357 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -22,7 +22,7 @@ module HDF5_utilities #if defined(PETSc) || defined(DAMASK_HDF5) !-------------------------------------------------------------------------------------------------- -!> @brief reads integer or float data of defined shape from file ! ToDo: order of arguments wrong +!> @brief reads integer or float data of defined shape from file ! ToDo: order of arguments wrong !> @details for parallel IO, all dimension except for the last need to match !-------------------------------------------------------------------------------------------------- interface HDF5_read @@ -45,7 +45,7 @@ module HDF5_utilities end interface HDF5_read !-------------------------------------------------------------------------------------------------- -!> @brief writes integer or real data of defined shape to file ! ToDo: order of arguments wrong +!> @brief writes integer or real data of defined shape to file ! ToDo: order of arguments wrong !> @details for parallel IO, all dimension except for the last need to match !-------------------------------------------------------------------------------------------------- interface HDF5_write @@ -1759,66 +1759,66 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ myStart, globalShape, & loc_id,localShape,datasetName,parallel) - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in) :: parallel - integer(HSIZE_T), intent(in), dimension(:) :: & - localShape - integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & - myStart, & - globalShape !< shape of the dataset (all processes) - integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - - integer, dimension(worldsize) :: & - readSize !< contribution of all processes - integer :: ierr - integer :: hdferr + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in) :: parallel + integer(HSIZE_T), intent(in), dimension(:) :: & + localShape + integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & + myStart, & + globalShape !< shape of the dataset (all processes) + integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + + integer, dimension(worldsize) :: & + readSize !< contribution of all processes + integer :: ierr + integer :: hdferr !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties (is collective for MPI) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pcreate_f') + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pcreate_f') !-------------------------------------------------------------------------------------------------- - readSize = 0 - readSize(worldrank+1) = int(localShape(ubound(localShape,1))) + readSize = 0 + readSize(worldrank+1) = int(localShape(ubound(localShape,1))) #ifdef PETSc - if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pset_dxpl_mpio_f') - call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894,ext_msg='initialize_read: MPI_allreduce') - endif + if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894,ext_msg='initialize_read: MPI_allreduce') + endif #endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) - globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T) + globalShape = [localShape(1:ubound(localShape,1)-1),int(sum(readSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) - call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5screate_simple_f/memspace_id') + call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5screate_simple_f/memspace_id') !-------------------------------------------------------------------------------------------------- ! creating a property list for IO and set it to collective - call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pcreate_f') + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pcreate_f') #ifdef PETSc - call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f') + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f') #endif !-------------------------------------------------------------------------------------------------- ! open the dataset in the file and get the space ID - call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5dopen_f') - call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5dget_space_f') + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5dopen_f') + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5dget_space_f') !-------------------------------------------------------------------------------------------------- ! select a hyperslab (the portion of the current process) in the file - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5sselect_hyperslab_f') + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5sselect_hyperslab_f') end subroutine initialize_read @@ -1828,19 +1828,19 @@ end subroutine initialize_read !-------------------------------------------------------------------------------------------------- subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) - integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer :: hdferr + integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer :: hdferr - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: plist_id') - call h5pclose_f(aplist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: aplist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5sclose_f/memspace_id') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: plist_id') + call h5pclose_f(aplist_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: aplist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5sclose_f/memspace_id') end subroutine finalize_read @@ -1852,60 +1852,60 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & myStart, totalShape, & loc_id,myShape,datasetName,datatype,parallel) - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in) :: parallel - integer(HID_T), intent(in) :: datatype - integer(HSIZE_T), intent(in), dimension(:) :: & - myShape - integer(HSIZE_T), intent(out), dimension(size(myShape,1)):: & - myStart, & - totalShape !< shape of the dataset (all processes) - integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id - - integer, dimension(worldsize) :: & - writeSize !< contribution of all processes - integer :: ierr - integer :: hdferr + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in) :: parallel + integer(HID_T), intent(in) :: datatype + integer(HSIZE_T), intent(in), dimension(:) :: & + myShape + integer(HSIZE_T), intent(out), dimension(size(myShape,1)):: & + myStart, & + totalShape !< shape of the dataset (all processes) + integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id + + integer, dimension(worldsize) :: & + writeSize !< contribution of all processes + integer :: ierr + integer :: hdferr !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties (is collective when reading in parallel) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5pcreate_f') + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5pcreate_f') #ifdef PETSc -if (parallel) then - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5pset_dxpl_mpio_f') - endif + if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5pset_dxpl_mpio_f') + endif #endif !-------------------------------------------------------------------------------------------------- ! determine the global data layout among all processes - writeSize = 0 - writeSize(worldrank+1) = int(myShape(ubound(myShape,1))) + writeSize = 0 + writeSize(worldrank+1) = int(myShape(ubound(myShape,1))) #ifdef PETSc -if (parallel) then - call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894,ext_msg='initialize_write: MPI_allreduce') - endif + if (parallel) then + call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894,ext_msg='initialize_write: MPI_allreduce') + endif #endif - myStart = int(0,HSIZE_T) - myStart(ubound(myStart)) = int(sum(writeSize(1:worldrank)),HSIZE_T) - totalShape = [myShape(1:ubound(myShape,1)-1),int(sum(writeSize),HSIZE_T)] + myStart = int(0,HSIZE_T) + myStart(ubound(myStart)) = int(sum(writeSize(1:worldrank)),HSIZE_T) + totalShape = [myShape(1:ubound(myShape,1)-1),int(sum(writeSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) and in file (global shape) - call h5screate_simple_f(size(myShape), myShape, memspace_id, hdferr, myShape) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dopen_f') - call h5screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dget_space_f') + call h5screate_simple_f(size(myShape), myShape, memspace_id, hdferr, myShape) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dopen_f') + call h5screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dget_space_f') !-------------------------------------------------------------------------------------------------- ! create dataset in the file and select a hyperslab from it (the portion of the current process) - call h5dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dcreate_f') - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, myShape, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5sselect_hyperslab_f') + call h5dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dcreate_f') + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, myShape, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5sselect_hyperslab_f') end subroutine initialize_write @@ -1915,19 +1915,19 @@ end subroutine initialize_write !-------------------------------------------------------------------------------------------------- subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id) - integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id - integer :: hdferr + integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id + integer :: hdferr - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: plist_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5dclose_f') - call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5sclose_f/filespace_id') - call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5sclose_f/memspace_id') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5sclose_f/memspace_id') end subroutine finalize_write - #endif + end module HDF5_Utilities diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 93227bf6b..2ee921d10 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -5,130 +5,130 @@ !> @brief homogenization manager, organizing deformation partitioning and stress homogenization !-------------------------------------------------------------------------------------------------- module homogenization - use prec - use IO - use config - use debug - use math - use material - use numerics - use constitutive - use crystallite - use FEsolving - use mesh - use discretization - use thermal_isothermal - use thermal_adiabatic - use thermal_conduction - use damage_none - use damage_local - use damage_nonlocal - use results - use HDF5_utilities - - implicit none - private + use prec + use IO + use config + use debug + use math + use material + use numerics + use constitutive + use crystallite + use FEsolving + use mesh + use discretization + use thermal_isothermal + use thermal_adiabatic + use thermal_conduction + use damage_none + use damage_local + use damage_nonlocal + use results + use HDF5_utilities + + implicit none + private !-------------------------------------------------------------------------------------------------- ! General variables for the homogenization at a material point - real(pReal), dimension(:,:,:,:), allocatable, public :: & - materialpoint_F0, & !< def grad of IP at start of FE increment - materialpoint_F, & !< def grad of IP to be reached at end of FE increment - materialpoint_P !< first P--K stress of IP - real(pReal), dimension(:,:,:,:,:,:), allocatable, public :: & - materialpoint_dPdF !< tangent of first P--K stress at IP - real(pReal), dimension(:,:,:), allocatable, public :: & - materialpoint_results !< results array of material point - integer, public, protected :: & - materialpoint_sizeResults, & - thermal_maxSizePostResults, & - damage_maxSizePostResults + real(pReal), dimension(:,:,:,:), allocatable, public :: & + materialpoint_F0, & !< def grad of IP at start of FE increment + materialpoint_F, & !< def grad of IP to be reached at end of FE increment + materialpoint_P !< first P--K stress of IP + real(pReal), dimension(:,:,:,:,:,:), allocatable, public :: & + materialpoint_dPdF !< tangent of first P--K stress at IP + real(pReal), dimension(:,:,:), allocatable, public :: & + materialpoint_results !< results array of material point + integer, public, protected :: & + materialpoint_sizeResults, & + thermal_maxSizePostResults, & + damage_maxSizePostResults - real(pReal), dimension(:,:,:,:), allocatable :: & - materialpoint_subF0, & !< def grad of IP at beginning of homogenization increment - materialpoint_subF !< def grad of IP to be reached at end of homog inc - real(pReal), dimension(:,:), allocatable :: & - materialpoint_subFrac, & - materialpoint_subStep, & - materialpoint_subdt - logical, dimension(:,:), allocatable :: & - materialpoint_requested, & - materialpoint_converged - logical, dimension(:,:,:), allocatable :: & - materialpoint_doneAndHappy - - interface + real(pReal), dimension(:,:,:,:), allocatable :: & + materialpoint_subF0, & !< def grad of IP at beginning of homogenization increment + materialpoint_subF !< def grad of IP to be reached at end of homog inc + real(pReal), dimension(:,:), allocatable :: & + materialpoint_subFrac, & + materialpoint_subStep, & + materialpoint_subdt + logical, dimension(:,:), allocatable :: & + materialpoint_requested, & + materialpoint_converged + logical, dimension(:,:,:), allocatable :: & + materialpoint_doneAndHappy + + interface - module subroutine mech_none_init - end subroutine mech_none_init - - module subroutine mech_isostrain_init - end subroutine mech_isostrain_init - - module subroutine mech_RGC_init - end subroutine mech_RGC_init - - - module subroutine mech_isostrain_partitionDeformation(F,avgF) - real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient - real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point - end subroutine mech_isostrain_partitionDeformation - - module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) - real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient - real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point - integer, intent(in) :: & - instance, & - of - end subroutine mech_RGC_partitionDeformation - - - module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) - 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 (:,:,:), intent(in) :: P !< partitioned stresses - real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: instance - end subroutine mech_isostrain_averageStressAndItsTangent - - module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) - 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 (:,:,:), intent(in) :: P !< partitioned stresses - real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: instance - end subroutine mech_RGC_averageStressAndItsTangent - - - module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) - logical, dimension(2) :: mech_RGC_updateState - real(pReal), dimension(:,:,:), intent(in) :: & - P,& !< partitioned stresses - F,& !< partitioned deformation gradients - F0 !< partitioned initial deformation gradients - real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - real(pReal), dimension(3,3), intent(in) :: avgF !< average F - real(pReal), intent(in) :: dt !< time increment - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - end function mech_RGC_updateState - - - module subroutine mech_RGC_results(instance,group) - integer, intent(in) :: instance !< homogenization instance - character(len=*), intent(in) :: group !< group name in HDF5 file - end subroutine mech_RGC_results + module subroutine mech_none_init + end subroutine mech_none_init + + module subroutine mech_isostrain_init + end subroutine mech_isostrain_init + + module subroutine mech_RGC_init + end subroutine mech_RGC_init + + + module subroutine mech_isostrain_partitionDeformation(F,avgF) + real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient + real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point + end subroutine mech_isostrain_partitionDeformation + + module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) + real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient + real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point + integer, intent(in) :: & + instance, & + of + end subroutine mech_RGC_partitionDeformation + + + module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) + 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 - end interface + real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses + real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + integer, intent(in) :: instance + end subroutine mech_isostrain_averageStressAndItsTangent + + module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) + 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 (:,:,:), intent(in) :: P !< partitioned stresses + real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + integer, intent(in) :: instance + end subroutine mech_RGC_averageStressAndItsTangent + + + module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) + logical, dimension(2) :: mech_RGC_updateState + real(pReal), dimension(:,:,:), intent(in) :: & + P,& !< partitioned stresses + F,& !< partitioned deformation gradients + F0 !< partitioned initial deformation gradients + real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + end function mech_RGC_updateState - public :: & - homogenization_init, & - materialpoint_stressAndItsTangent, & - materialpoint_postResults, & - homogenization_results + + module subroutine mech_RGC_results(instance,group) + integer, intent(in) :: instance !< homogenization instance + character(len=*), intent(in) :: group !< group name in HDF5 file + end subroutine mech_RGC_results + + end interface + + public :: & + homogenization_init, & + materialpoint_stressAndItsTangent, & + materialpoint_postResults, & + homogenization_results contains @@ -138,156 +138,156 @@ contains !-------------------------------------------------------------------------------------------------- subroutine homogenization_init - integer, parameter :: FILEUNIT = 200 - integer :: e,i,p - integer, dimension(:,:), pointer :: thisSize - integer, dimension(:) , pointer :: thisNoutput - character(len=64), dimension(:,:), pointer :: thisOutput - character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready - logical :: valid + integer, parameter :: FILEUNIT = 200 + integer :: e,i,p + integer, dimension(:,:), pointer :: thisSize + integer, dimension(:) , pointer :: thisNoutput + character(len=64), dimension(:,:), pointer :: thisOutput + character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready + logical :: valid - if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init - if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init - if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init + if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init + if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init + if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init - if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init - if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init - if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init + if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init + if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init + if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init - if (any(damage_type == DAMAGE_none_ID)) call damage_none_init - if (any(damage_type == DAMAGE_local_ID)) call damage_local_init - if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init + if (any(damage_type == DAMAGE_none_ID)) call damage_none_init + if (any(damage_type == DAMAGE_local_ID)) call damage_local_init + if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init !-------------------------------------------------------------------------------------------------- ! write description file for homogenization output - mainProcess: if (worldrank == 0) then - call IO_write_jobFile(FILEUNIT,'outputHomogenization') - do p = 1,size(config_homogenization) - if (any(material_homogenizationAt == p)) then - write(FILEUNIT,'(/,a,/)') '['//trim(config_name_homogenization(p))//']' - write(FILEUNIT,'(a)') '(type) n/a' - write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) - - i = thermal_typeInstance(p) ! which instance of this thermal type - valid = .true. ! assume valid - select case(thermal_type(p)) ! split per thermal type - case (THERMAL_isothermal_ID) - outputName = THERMAL_isothermal_label - thisNoutput => null() - thisOutput => null() - thisSize => null() - case (THERMAL_adiabatic_ID) - outputName = THERMAL_adiabatic_label - thisNoutput => thermal_adiabatic_Noutput - thisOutput => thermal_adiabatic_output - thisSize => thermal_adiabatic_sizePostResult - case (THERMAL_conduction_ID) - outputName = THERMAL_conduction_label - thisNoutput => thermal_conduction_Noutput - thisOutput => thermal_conduction_output - thisSize => thermal_conduction_sizePostResult - case default - valid = .false. - end select - if (valid) then - write(FILEUNIT,'(a)') '(thermal)'//char(9)//trim(outputName) - if (thermal_type(p) /= THERMAL_isothermal_ID) then - do e = 1,thisNoutput(i) - write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) - enddo - endif - endif - - i = damage_typeInstance(p) ! which instance of this damage type - valid = .true. ! assume valid - select case(damage_type(p)) ! split per damage type - case (DAMAGE_none_ID) - outputName = DAMAGE_none_label - thisNoutput => null() - thisOutput => null() - thisSize => null() - case (DAMAGE_local_ID) - outputName = DAMAGE_local_label - thisNoutput => damage_local_Noutput - thisOutput => damage_local_output - thisSize => damage_local_sizePostResult - case (DAMAGE_nonlocal_ID) - outputName = DAMAGE_nonlocal_label - thisNoutput => damage_nonlocal_Noutput - thisOutput => damage_nonlocal_output - thisSize => damage_nonlocal_sizePostResult - case default - valid = .false. - end select - if (valid) then - write(FILEUNIT,'(a)') '(damage)'//char(9)//trim(outputName) - if (damage_type(p) /= DAMAGE_none_ID) then - do e = 1,thisNoutput(i) - write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) - enddo - endif - endif - endif - enddo - close(FILEUNIT) - endif mainProcess + mainProcess: if (worldrank == 0) then + call IO_write_jobFile(FILEUNIT,'outputHomogenization') + do p = 1,size(config_homogenization) + if (any(material_homogenizationAt == p)) then + write(FILEUNIT,'(/,a,/)') '['//trim(config_name_homogenization(p))//']' + write(FILEUNIT,'(a)') '(type) n/a' + write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) + + i = thermal_typeInstance(p) ! which instance of this thermal type + valid = .true. ! assume valid + select case(thermal_type(p)) ! split per thermal type + case (THERMAL_isothermal_ID) + outputName = THERMAL_isothermal_label + thisNoutput => null() + thisOutput => null() + thisSize => null() + case (THERMAL_adiabatic_ID) + outputName = THERMAL_adiabatic_label + thisNoutput => thermal_adiabatic_Noutput + thisOutput => thermal_adiabatic_output + thisSize => thermal_adiabatic_sizePostResult + case (THERMAL_conduction_ID) + outputName = THERMAL_conduction_label + thisNoutput => thermal_conduction_Noutput + thisOutput => thermal_conduction_output + thisSize => thermal_conduction_sizePostResult + case default + valid = .false. + end select + if (valid) then + write(FILEUNIT,'(a)') '(thermal)'//char(9)//trim(outputName) + if (thermal_type(p) /= THERMAL_isothermal_ID) then + do e = 1,thisNoutput(i) + write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) + enddo + endif + endif + + i = damage_typeInstance(p) ! which instance of this damage type + valid = .true. ! assume valid + select case(damage_type(p)) ! split per damage type + case (DAMAGE_none_ID) + outputName = DAMAGE_none_label + thisNoutput => null() + thisOutput => null() + thisSize => null() + case (DAMAGE_local_ID) + outputName = DAMAGE_local_label + thisNoutput => damage_local_Noutput + thisOutput => damage_local_output + thisSize => damage_local_sizePostResult + case (DAMAGE_nonlocal_ID) + outputName = DAMAGE_nonlocal_label + thisNoutput => damage_nonlocal_Noutput + thisOutput => damage_nonlocal_output + thisSize => damage_nonlocal_sizePostResult + case default + valid = .false. + end select + if (valid) then + write(FILEUNIT,'(a)') '(damage)'//char(9)//trim(outputName) + if (damage_type(p) /= DAMAGE_none_ID) then + do e = 1,thisNoutput(i) + write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) + enddo + endif + endif + endif + enddo + close(FILEUNIT) + endif mainProcess - call config_deallocate('material.config/homogenization') + call config_deallocate('material.config/homogenization') !-------------------------------------------------------------------------------------------------- ! allocate and initialize global variables - allocate(materialpoint_dPdF(3,3,3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) - allocate(materialpoint_F0(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) - materialpoint_F0 = spread(spread(math_I3,3,discretization_nIP),4,discretization_nElem) ! initialize to identity - allocate(materialpoint_F(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) - materialpoint_F = materialpoint_F0 ! initialize to identity - allocate(materialpoint_subF0(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) - allocate(materialpoint_subF(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) - allocate(materialpoint_P(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) - allocate(materialpoint_subFrac(discretization_nIP,discretization_nElem), source=0.0_pReal) - allocate(materialpoint_subStep(discretization_nIP,discretization_nElem), source=0.0_pReal) - allocate(materialpoint_subdt(discretization_nIP,discretization_nElem), source=0.0_pReal) - allocate(materialpoint_requested(discretization_nIP,discretization_nElem), source=.false.) - allocate(materialpoint_converged(discretization_nIP,discretization_nElem), source=.true.) - allocate(materialpoint_doneAndHappy(2,discretization_nIP,discretization_nElem), source=.true.) + allocate(materialpoint_dPdF(3,3,3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) + allocate(materialpoint_F0(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) + materialpoint_F0 = spread(spread(math_I3,3,discretization_nIP),4,discretization_nElem) ! initialize to identity + allocate(materialpoint_F(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) + materialpoint_F = materialpoint_F0 ! initialize to identity + allocate(materialpoint_subF0(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) + allocate(materialpoint_subF(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) + allocate(materialpoint_P(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal) + allocate(materialpoint_subFrac(discretization_nIP,discretization_nElem), source=0.0_pReal) + allocate(materialpoint_subStep(discretization_nIP,discretization_nElem), source=0.0_pReal) + allocate(materialpoint_subdt(discretization_nIP,discretization_nElem), source=0.0_pReal) + allocate(materialpoint_requested(discretization_nIP,discretization_nElem), source=.false.) + allocate(materialpoint_converged(discretization_nIP,discretization_nElem), source=.true.) + allocate(materialpoint_doneAndHappy(2,discretization_nIP,discretization_nElem), source=.true.) !-------------------------------------------------------------------------------------------------- ! allocate and initialize global state and postresutls variables - thermal_maxSizePostResults = 0 - damage_maxSizePostResults = 0 - do p = 1,size(config_homogenization) - thermal_maxSizePostResults = max(thermal_maxSizePostResults, thermalState (p)%sizePostResults) - damage_maxSizePostResults = max(damage_maxSizePostResults ,damageState (p)%sizePostResults) - enddo + thermal_maxSizePostResults = 0 + damage_maxSizePostResults = 0 + do p = 1,size(config_homogenization) + thermal_maxSizePostResults = max(thermal_maxSizePostResults, thermalState (p)%sizePostResults) + damage_maxSizePostResults = max(damage_maxSizePostResults ,damageState (p)%sizePostResults) + enddo - materialpoint_sizeResults = 1 & ! grain count - + 1 + thermal_maxSizePostResults & - + damage_maxSizePostResults & - + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results - + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results - + constitutive_source_maxSizePostResults) - allocate(materialpoint_results(materialpoint_sizeResults,discretization_nIP,discretization_nElem)) + materialpoint_sizeResults = 1 & ! grain count + + 1 + thermal_maxSizePostResults & + + damage_maxSizePostResults & + + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results + + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results + + constitutive_source_maxSizePostResults) + allocate(materialpoint_results(materialpoint_sizeResults,discretization_nIP,discretization_nElem)) - write(6,'(/,a)') ' <<<+- homogenization init -+>>>' + write(6,'(/,a)') ' <<<+- homogenization init -+>>>' - if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0) then - write(6,'(a32,1x,7(i8,1x))') 'materialpoint_dPdF: ', shape(materialpoint_dPdF) - write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F0: ', shape(materialpoint_F0) - write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F: ', shape(materialpoint_F) - write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subF0: ', shape(materialpoint_subF0) - write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subF: ', shape(materialpoint_subF) - write(6,'(a32,1x,7(i8,1x))') 'materialpoint_P: ', shape(materialpoint_P) - write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subFrac: ', shape(materialpoint_subFrac) - write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subStep: ', shape(materialpoint_subStep) - write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subdt: ', shape(materialpoint_subdt) - write(6,'(a32,1x,7(i8,1x))') 'materialpoint_requested: ', shape(materialpoint_requested) - write(6,'(a32,1x,7(i8,1x))') 'materialpoint_converged: ', shape(materialpoint_converged) - write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_doneAndHappy: ', shape(materialpoint_doneAndHappy) - endif - flush(6) + if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0) then + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_dPdF: ', shape(materialpoint_dPdF) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F0: ', shape(materialpoint_F0) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_F: ', shape(materialpoint_F) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subF0: ', shape(materialpoint_subF0) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subF: ', shape(materialpoint_subF) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_P: ', shape(materialpoint_P) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subFrac: ', shape(materialpoint_subFrac) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subStep: ', shape(materialpoint_subStep) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_subdt: ', shape(materialpoint_subdt) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_requested: ', shape(materialpoint_requested) + write(6,'(a32,1x,7(i8,1x))') 'materialpoint_converged: ', shape(materialpoint_converged) + write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_doneAndHappy: ', shape(materialpoint_doneAndHappy) + endif + flush(6) - if (debug_g < 1 .or. debug_g > homogenization_Ngrains(material_homogenizationAt(debug_e))) & - call IO_error(602,ext_msg='constituent', el=debug_e, g=debug_g) + if (debug_g < 1 .or. debug_g > homogenization_Ngrains(material_homogenizationAt(debug_e))) & + call IO_error(602,ext_msg='constituent', el=debug_e, g=debug_g) end subroutine homogenization_init @@ -297,289 +297,289 @@ end subroutine homogenization_init !-------------------------------------------------------------------------------------------------- subroutine materialpoint_stressAndItsTangent(updateJaco,dt) - real(pReal), intent(in) :: dt !< time increment - logical, intent(in) :: updateJaco !< initiating Jacobian update - integer :: & - NiterationHomog, & - NiterationMPstate, & - g, & !< grain number - i, & !< integration point number - e, & !< element number - mySource, & - myNgrains + real(pReal), intent(in) :: dt !< time increment + logical, intent(in) :: updateJaco !< initiating Jacobian update + integer :: & + NiterationHomog, & + NiterationMPstate, & + g, & !< grain number + i, & !< integration point number + e, & !< element number + mySource, & + myNgrains #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0) then - write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i + if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0) then + write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug_e, debug_i - write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & - transpose(materialpoint_F0(1:3,1:3,debug_i,debug_e)) - write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', & - transpose(materialpoint_F(1:3,1:3,debug_i,debug_e)) - endif + write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & + transpose(materialpoint_F0(1:3,1:3,debug_i,debug_e)) + write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', & + transpose(materialpoint_F(1:3,1:3,debug_i,debug_e)) + endif #endif !-------------------------------------------------------------------------------------------------- ! initialize restoration points of ... - do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNgrains = homogenization_Ngrains(material_homogenizationAt(e)) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); - do g = 1,myNgrains + do e = FEsolving_execElem(1),FEsolving_execElem(2) + myNgrains = homogenization_Ngrains(material_homogenizationAt(e)) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); + do g = 1,myNgrains - plasticState (material_phaseAt(g,e))%partionedState0(:,material_phasememberAt(g,i,e)) = & - plasticState (material_phaseAt(g,e))%state0( :,material_phasememberAt(g,i,e)) - do mySource = 1, phase_Nsources(material_phaseAt(g,e)) - sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,material_phasememberAt(g,i,e)) = & - sourceState(material_phaseAt(g,e))%p(mySource)%state0( :,material_phasememberAt(g,i,e)) - enddo + plasticState (material_phaseAt(g,e))%partionedState0(:,material_phasememberAt(g,i,e)) = & + plasticState (material_phaseAt(g,e))%state0( :,material_phasememberAt(g,i,e)) + do mySource = 1, phase_Nsources(material_phaseAt(g,e)) + sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,material_phasememberAt(g,i,e)) = & + sourceState(material_phaseAt(g,e))%p(mySource)%state0( :,material_phasememberAt(g,i,e)) + enddo - crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) - crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e) - crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e) - crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e) - crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e) - crystallite_partionedS0(1:3,1:3,g,i,e) = crystallite_S0(1:3,1:3,g,i,e) + crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e) + crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e) + crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e) + crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e) + crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e) + crystallite_partionedS0(1:3,1:3,g,i,e) = crystallite_S0(1:3,1:3,g,i,e) - enddo + enddo - materialpoint_subF0(1:3,1:3,i,e) = materialpoint_F0(1:3,1:3,i,e) - materialpoint_subFrac(i,e) = 0.0_pReal - materialpoint_subStep(i,e) = 1.0_pReal/subStepSizeHomog ! <> - materialpoint_converged(i,e) = .false. ! pretend failed step of twice the required size - materialpoint_requested(i,e) = .true. ! everybody requires calculation - - if (homogState(material_homogenizationAt(e))%sizeState > 0) & - homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - homogState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state + materialpoint_subF0(1:3,1:3,i,e) = materialpoint_F0(1:3,1:3,i,e) + materialpoint_subFrac(i,e) = 0.0_pReal + materialpoint_subStep(i,e) = 1.0_pReal/subStepSizeHomog ! <> + materialpoint_converged(i,e) = .false. ! pretend failed step of twice the required size + materialpoint_requested(i,e) = .true. ! everybody requires calculation + + if (homogState(material_homogenizationAt(e))%sizeState > 0) & + homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + homogState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal homogenization state - if (thermalState(material_homogenizationAt(e))%sizeState > 0) & - thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - thermalState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal thermal state - - if (damageState(material_homogenizationAt(e))%sizeState > 0) & - damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - damageState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state - enddo - enddo - - NiterationHomog = 0 + if (thermalState(material_homogenizationAt(e))%sizeState > 0) & + thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + thermalState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal thermal state + + if (damageState(material_homogenizationAt(e))%sizeState > 0) & + damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + damageState(material_homogenizationAt(e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state + enddo + enddo + + NiterationHomog = 0 - cutBackLooping: do while (.not. terminallyIll .and. & - any(materialpoint_subStep(:,FEsolving_execELem(1):FEsolving_execElem(2)) > subStepMinHomog)) + cutBackLooping: do while (.not. terminallyIll .and. & + any(materialpoint_subStep(:,FEsolving_execELem(1):FEsolving_execElem(2)) > subStepMinHomog)) - !$OMP PARALLEL DO PRIVATE(myNgrains) - elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNgrains = homogenization_Ngrains(material_homogenizationAt(e)) - IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + !$OMP PARALLEL DO PRIVATE(myNgrains) + elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) + myNgrains = homogenization_Ngrains(material_homogenizationAt(e)) + IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - converged: if (materialpoint_converged(i,e)) then + converged: if (materialpoint_converged(i,e)) then #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0 & - .and. ((e == debug_e .and. i == debug_i) & - .or. .not. iand(debug_level(debug_homogenization),debug_levelSelective) /= 0)) then - write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,i8,1x,i2/)') '<< HOMOG >> winding forward from', & - materialpoint_subFrac(i,e), 'to current materialpoint_subFrac', & - materialpoint_subFrac(i,e)+materialpoint_subStep(i,e),'in materialpoint_stressAndItsTangent at el ip',e,i - endif + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0 & + .and. ((e == debug_e .and. i == debug_i) & + .or. .not. iand(debug_level(debug_homogenization),debug_levelSelective) /= 0)) then + write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,i8,1x,i2/)') '<< HOMOG >> winding forward from', & + materialpoint_subFrac(i,e), 'to current materialpoint_subFrac', & + materialpoint_subFrac(i,e)+materialpoint_subStep(i,e),'in materialpoint_stressAndItsTangent at el ip',e,i + endif #endif !--------------------------------------------------------------------------------------------------- ! calculate new subStep and new subFrac - materialpoint_subFrac(i,e) = materialpoint_subFrac(i,e) + materialpoint_subStep(i,e) - materialpoint_subStep(i,e) = min(1.0_pReal-materialpoint_subFrac(i,e), & - stepIncreaseHomog*materialpoint_subStep(i,e)) ! introduce flexibility for step increase/acceleration + materialpoint_subFrac(i,e) = materialpoint_subFrac(i,e) + materialpoint_subStep(i,e) + materialpoint_subStep(i,e) = min(1.0_pReal-materialpoint_subFrac(i,e), & + stepIncreaseHomog*materialpoint_subStep(i,e)) ! introduce flexibility for step increase/acceleration - steppingNeeded: if (materialpoint_subStep(i,e) > subStepMinHomog) then + steppingNeeded: if (materialpoint_subStep(i,e) > subStepMinHomog) then - ! wind forward grain starting point of... - crystallite_partionedF0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedF(1:3,1:3,1:myNgrains,i,e) + ! wind forward grain starting point of... + crystallite_partionedF0 (1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedF(1:3,1:3,1:myNgrains,i,e) - crystallite_partionedFp0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Fp (1:3,1:3,1:myNgrains,i,e) + crystallite_partionedFp0 (1:3,1:3,1:myNgrains,i,e) = & + crystallite_Fp (1:3,1:3,1:myNgrains,i,e) - crystallite_partionedLp0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Lp (1:3,1:3,1:myNgrains,i,e) + crystallite_partionedLp0 (1:3,1:3,1:myNgrains,i,e) = & + crystallite_Lp (1:3,1:3,1:myNgrains,i,e) - crystallite_partionedFi0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Fi (1:3,1:3,1:myNgrains,i,e) + crystallite_partionedFi0 (1:3,1:3,1:myNgrains,i,e) = & + crystallite_Fi (1:3,1:3,1:myNgrains,i,e) - crystallite_partionedLi0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_Li (1:3,1:3,1:myNgrains,i,e) + crystallite_partionedLi0 (1:3,1:3,1:myNgrains,i,e) = & + crystallite_Li (1:3,1:3,1:myNgrains,i,e) - crystallite_partionedS0 (1:3,1:3,1:myNgrains,i,e) = & - crystallite_S (1:3,1:3,1:myNgrains,i,e) + crystallite_partionedS0 (1:3,1:3,1:myNgrains,i,e) = & + crystallite_S (1:3,1:3,1:myNgrains,i,e) - do g = 1,myNgrains - plasticState (material_phaseAt(g,e))%partionedState0(:,material_phasememberAt(g,i,e)) = & - plasticState (material_phaseAt(g,e))%state (:,material_phasememberAt(g,i,e)) - do mySource = 1, phase_Nsources(material_phaseAt(g,e)) - sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,material_phasememberAt(g,i,e)) = & - sourceState(material_phaseAt(g,e))%p(mySource)%state (:,material_phasememberAt(g,i,e)) - enddo - enddo + do g = 1,myNgrains + plasticState (material_phaseAt(g,e))%partionedState0(:,material_phasememberAt(g,i,e)) = & + plasticState (material_phaseAt(g,e))%state (:,material_phasememberAt(g,i,e)) + do mySource = 1, phase_Nsources(material_phaseAt(g,e)) + sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,material_phasememberAt(g,i,e)) = & + sourceState(material_phaseAt(g,e))%p(mySource)%state (:,material_phasememberAt(g,i,e)) + enddo + enddo - if(homogState(material_homogenizationAt(e))%sizeState > 0) & - homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - homogState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) - if(thermalState(material_homogenizationAt(e))%sizeState > 0) & - thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - thermalState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) - if(damageState(material_homogenizationAt(e))%sizeState > 0) & - damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & - damageState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) - - materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) + if(homogState(material_homogenizationAt(e))%sizeState > 0) & + homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + homogState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) + if(thermalState(material_homogenizationAt(e))%sizeState > 0) & + thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + thermalState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) + if(damageState(material_homogenizationAt(e))%sizeState > 0) & + damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = & + damageState(material_homogenizationAt(e))%State (:,mappingHomogenization(1,i,e)) + + materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) - endif steppingNeeded + endif steppingNeeded - else converged - if ( (myNgrains == 1 .and. materialpoint_subStep(i,e) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite - subStepSizeHomog * materialpoint_subStep(i,e) <= subStepMinHomog ) then ! would require too small subStep + else converged + if ( (myNgrains == 1 .and. materialpoint_subStep(i,e) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite + subStepSizeHomog * materialpoint_subStep(i,e) <= subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense - !$OMP FLUSH(terminallyIll) - if (.not. terminallyIll) then ! so first signals terminally ill... - !$OMP CRITICAL (write2out) - write(6,*) 'Integration point ', i,' at element ', e, ' terminally ill' - !$OMP END CRITICAL (write2out) - endif - !$OMP CRITICAL (setTerminallyIll) - terminallyIll = .true. ! ...and kills all others - !$OMP END CRITICAL (setTerminallyIll) - else ! cutback makes sense - materialpoint_subStep(i,e) = subStepSizeHomog * materialpoint_subStep(i,e) ! crystallite had severe trouble, so do a significant cutback + !$OMP FLUSH(terminallyIll) + if (.not. terminallyIll) then ! so first signals terminally ill... + !$OMP CRITICAL (write2out) + write(6,*) 'Integration point ', i,' at element ', e, ' terminally ill' + !$OMP END CRITICAL (write2out) + endif + !$OMP CRITICAL (setTerminallyIll) + terminallyIll = .true. ! ...and kills all others + !$OMP END CRITICAL (setTerminallyIll) + else ! cutback makes sense + materialpoint_subStep(i,e) = subStepSizeHomog * materialpoint_subStep(i,e) ! crystallite had severe trouble, so do a significant cutback #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0 & - .and. ((e == debug_e .and. i == debug_i) & - .or. .not. iand(debug_level(debug_homogenization), debug_levelSelective) /= 0)) then - write(6,'(a,1x,f12.8,a,i8,1x,i2/)') & - '<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new materialpoint_subStep:',& - materialpoint_subStep(i,e),' at el ip',e,i - endif + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0 & + .and. ((e == debug_e .and. i == debug_i) & + .or. .not. iand(debug_level(debug_homogenization), debug_levelSelective) /= 0)) then + write(6,'(a,1x,f12.8,a,i8,1x,i2/)') & + '<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new materialpoint_subStep:',& + materialpoint_subStep(i,e),' at el ip',e,i + endif #endif !-------------------------------------------------------------------------------------------------- ! restore... - if (materialpoint_subStep(i,e) < 1.0_pReal) then ! protect against fake cutback from \Delta t = 2 to 1. Maybe that "trick" is not necessary anymore at all? I.e. start with \Delta t = 1 - crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) - crystallite_Li(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) - endif ! maybe protecting everything from overwriting (not only L) makes even more sense - crystallite_Fp(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) - crystallite_Fi(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) - crystallite_S(1:3,1:3,1:myNgrains,i,e) = & - crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) - do g = 1, myNgrains - plasticState (material_phaseAt(g,e))%state( :,material_phasememberAt(g,i,e)) = & - plasticState (material_phaseAt(g,e))%partionedState0(:,material_phasememberAt(g,i,e)) - do mySource = 1, phase_Nsources(material_phaseAt(g,e)) - sourceState(material_phaseAt(g,e))%p(mySource)%state( :,material_phasememberAt(g,i,e)) = & - sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,material_phasememberAt(g,i,e)) - enddo - enddo - if(homogState(material_homogenizationAt(e))%sizeState > 0) & - homogState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & - homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) - if(thermalState(material_homogenizationAt(e))%sizeState > 0) & - thermalState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & - thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) - if(damageState(material_homogenizationAt(e))%sizeState > 0) & - damageState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & - damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) - endif - endif converged + if (materialpoint_subStep(i,e) < 1.0_pReal) then ! protect against fake cutback from \Delta t = 2 to 1. Maybe that "trick" is not necessary anymore at all? I.e. start with \Delta t = 1 + crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) + crystallite_Li(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) + endif ! maybe protecting everything from overwriting (not only L) makes even more sense + crystallite_Fp(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) + crystallite_Fi(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) + crystallite_S(1:3,1:3,1:myNgrains,i,e) = & + crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) + do g = 1, myNgrains + plasticState (material_phaseAt(g,e))%state( :,material_phasememberAt(g,i,e)) = & + plasticState (material_phaseAt(g,e))%partionedState0(:,material_phasememberAt(g,i,e)) + do mySource = 1, phase_Nsources(material_phaseAt(g,e)) + sourceState(material_phaseAt(g,e))%p(mySource)%state( :,material_phasememberAt(g,i,e)) = & + sourceState(material_phaseAt(g,e))%p(mySource)%partionedState0(:,material_phasememberAt(g,i,e)) + enddo + enddo + if(homogState(material_homogenizationAt(e))%sizeState > 0) & + homogState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & + homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) + if(thermalState(material_homogenizationAt(e))%sizeState > 0) & + thermalState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & + thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) + if(damageState(material_homogenizationAt(e))%sizeState > 0) & + damageState(material_homogenizationAt(e))%State( :,mappingHomogenization(1,i,e)) = & + damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) + endif + endif converged - if (materialpoint_subStep(i,e) > subStepMinHomog) then - materialpoint_requested(i,e) = .true. - materialpoint_subF(1:3,1:3,i,e) = materialpoint_subF0(1:3,1:3,i,e) & - + materialpoint_subStep(i,e) * (materialpoint_F(1:3,1:3,i,e) & - - materialpoint_F0(1:3,1:3,i,e)) - materialpoint_subdt(i,e) = materialpoint_subStep(i,e) * dt - materialpoint_doneAndHappy(1:2,i,e) = [.false.,.true.] - endif - enddo IpLooping1 - enddo elementLooping1 - !$OMP END PARALLEL DO + if (materialpoint_subStep(i,e) > subStepMinHomog) then + materialpoint_requested(i,e) = .true. + materialpoint_subF(1:3,1:3,i,e) = materialpoint_subF0(1:3,1:3,i,e) & + + materialpoint_subStep(i,e) * (materialpoint_F(1:3,1:3,i,e) & + - materialpoint_F0(1:3,1:3,i,e)) + materialpoint_subdt(i,e) = materialpoint_subStep(i,e) * dt + materialpoint_doneAndHappy(1:2,i,e) = [.false.,.true.] + endif + enddo IpLooping1 + enddo elementLooping1 + !$OMP END PARALLEL DO - NiterationMPstate = 0 + NiterationMPstate = 0 - convergenceLooping: do while (.not. terminallyIll .and. & - any( materialpoint_requested(:,FEsolving_execELem(1):FEsolving_execElem(2)) & - .and. .not. materialpoint_doneAndHappy(1,:,FEsolving_execELem(1):FEsolving_execElem(2)) & - ) .and. & - NiterationMPstate < nMPstate) - NiterationMPstate = NiterationMPstate + 1 + convergenceLooping: do while (.not. terminallyIll .and. & + any( materialpoint_requested(:,FEsolving_execELem(1):FEsolving_execElem(2)) & + .and. .not. materialpoint_doneAndHappy(1,:,FEsolving_execELem(1):FEsolving_execElem(2)) & + ) .and. & + NiterationMPstate < nMPstate) + NiterationMPstate = NiterationMPstate + 1 !-------------------------------------------------------------------------------------------------- ! deformation partitioning ! based on materialpoint_subF0,.._subF,crystallite_partionedF0, and homogenization_state, ! results in crystallite_partionedF - !$OMP PARALLEL DO PRIVATE(myNgrains) - elementLooping2: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNgrains = homogenization_Ngrains(material_homogenizationAt(e)) - 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 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 - crystallite_requested(1:myNgrains,i,e) = .false. ! calculation for constituents not required anymore - endif - enddo IpLooping2 - enddo elementLooping2 - !$OMP END PARALLEL DO + !$OMP PARALLEL DO PRIVATE(myNgrains) + elementLooping2: do e = FEsolving_execElem(1),FEsolving_execElem(2) + myNgrains = homogenization_Ngrains(material_homogenizationAt(e)) + 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 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 + crystallite_requested(1:myNgrains,i,e) = .false. ! calculation for constituents not required anymore + endif + enddo IpLooping2 + enddo elementLooping2 + !$OMP END PARALLEL DO !-------------------------------------------------------------------------------------------------- ! crystallite integration ! based on crystallite_partionedF0,.._partionedF ! incrementing by crystallite_dt - materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic + materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic !-------------------------------------------------------------------------------------------------- ! state update !$OMP PARALLEL DO - elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) - IpLooping3: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - if ( materialpoint_requested(i,e) .and. & - .not. materialpoint_doneAndHappy(1,i,e)) then - if (.not. materialpoint_converged(i,e)) then - materialpoint_doneAndHappy(1:2,i,e) = [.true.,.false.] - else - 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 - enddo IpLooping3 - enddo elementLooping3 - !$OMP END PARALLEL DO - - enddo convergenceLooping - - NiterationHomog = NiterationHomog + 1 - - enddo cutBackLooping + elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) + IpLooping3: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + if ( materialpoint_requested(i,e) .and. & + .not. materialpoint_doneAndHappy(1,i,e)) then + if (.not. materialpoint_converged(i,e)) then + materialpoint_doneAndHappy(1:2,i,e) = [.true.,.false.] + else + 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 + enddo IpLooping3 + enddo elementLooping3 + !$OMP END PARALLEL DO - if(updateJaco) call crystallite_stressTangent - - if (.not. terminallyIll ) then - call crystallite_orientations() ! calculate crystal orientations - !$OMP PARALLEL DO - elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2) - IpLooping4: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - call averageStressAndItsTangent(i,e) - enddo IpLooping4 - enddo elementLooping4 - !$OMP END PARALLEL DO - else - write(6,'(/,a,/)') '<< HOMOG >> Material Point terminally ill' - endif + enddo convergenceLooping + + NiterationHomog = NiterationHomog + 1 + + enddo cutBackLooping + + if(updateJaco) call crystallite_stressTangent + + if (.not. terminallyIll ) then + call crystallite_orientations() ! calculate crystal orientations + !$OMP PARALLEL DO + elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2) + IpLooping4: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + call averageStressAndItsTangent(i,e) + enddo IpLooping4 + enddo elementLooping4 + !$OMP END PARALLEL DO + else + write(6,'(/,a,/)') '<< HOMOG >> Material Point terminally ill' + endif end subroutine materialpoint_stressAndItsTangent @@ -589,45 +589,44 @@ end subroutine materialpoint_stressAndItsTangent !-------------------------------------------------------------------------------------------------- subroutine materialpoint_postResults - integer :: & - thePos, & - theSize, & - myNgrains, & - myCrystallite, & - g, & !< grain number - i, & !< integration point number - e !< element number + integer :: & + thePos, & + theSize, & + myNgrains, & + myCrystallite, & + g, & !< grain number + i, & !< integration point number + e !< element number - !$OMP PARALLEL DO PRIVATE(myNgrains,myCrystallite,thePos,theSize) - elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNgrains = homogenization_Ngrains(material_homogenizationAt(e)) - myCrystallite = microstructure_crystallite(discretization_microstructureAt(e)) - IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - thePos = 0 + !$OMP PARALLEL DO PRIVATE(myNgrains,myCrystallite,thePos,theSize) + elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2) + myNgrains = homogenization_Ngrains(material_homogenizationAt(e)) + myCrystallite = microstructure_crystallite(discretization_microstructureAt(e)) + IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + thePos = 0 - theSize = homogState (material_homogenizationAt(e))%sizePostResults & - + thermalState (material_homogenizationAt(e))%sizePostResults & - + damageState (material_homogenizationAt(e))%sizePostResults - materialpoint_results(thePos+1,i,e) = real(theSize,pReal) ! tell size of homogenization results - thePos = thePos + 1 + theSize = thermalState (material_homogenizationAt(e))%sizePostResults & + + damageState (material_homogenizationAt(e))%sizePostResults + materialpoint_results(thePos+1,i,e) = real(theSize,pReal) ! tell size of homogenization results + thePos = thePos + 1 - if (theSize > 0) then ! any homogenization results to mention? - materialpoint_results(thePos+1:thePos+theSize,i,e) = postResults(i,e) ! tell homogenization results - thePos = thePos + theSize - endif + if (theSize > 0) then ! any homogenization results to mention? + materialpoint_results(thePos+1:thePos+theSize,i,e) = postResults(i,e) + thePos = thePos + theSize + endif - materialpoint_results(thePos+1,i,e) = real(myNgrains,pReal) ! tell number of grains at materialpoint - thePos = thePos + 1 + materialpoint_results(thePos+1,i,e) = real(myNgrains,pReal) ! tell number of grains at materialpoint + thePos = thePos + 1 - grainLooping :do g = 1,myNgrains - theSize = 1 + crystallite_sizePostResults(myCrystallite) + & - 1 + plasticState (material_phaseAt(g,e))%sizePostResults + & !ToDo - sum(sourceState(material_phaseAt(g,e))%p(:)%sizePostResults) - materialpoint_results(thePos+1:thePos+theSize,i,e) = crystallite_postResults(g,i,e) ! tell crystallite results - thePos = thePos + theSize - enddo grainLooping - enddo IpLooping - enddo elementLooping + grainLooping :do g = 1,myNgrains + theSize = 1 + crystallite_sizePostResults(myCrystallite) + & + 1 + plasticState (material_phaseAt(g,e))%sizePostResults + & + sum(sourceState(material_phaseAt(g,e))%p(:)%sizePostResults) + materialpoint_results(thePos+1:thePos+theSize,i,e) = crystallite_postResults(g,i,e) ! tell crystallite results + thePos = thePos + theSize + enddo grainLooping + enddo IpLooping + enddo elementLooping !$OMP END PARALLEL DO end subroutine materialpoint_postResults @@ -753,8 +752,7 @@ function postResults(ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - real(pReal), dimension( homogState (material_homogenizationAt(el))%sizePostResults & - + thermalState (material_homogenizationAt(el))%sizePostResults & + real(pReal), dimension( thermalState (material_homogenizationAt(el))%sizePostResults & + damageState (material_homogenizationAt(el))%sizePostResults) :: & postResults integer :: & @@ -817,8 +815,6 @@ subroutine homogenization_results enddo #endif - - end subroutine homogenization_results end module homogenization From 6370dd1a4326109e805d34f67fc0c4c2df5bc895 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 18:27:38 +0200 Subject: [PATCH 29/49] white space adjustments --- src/homogenization_mech_RGC.f90 | 1628 +++++++++++++++---------------- 1 file changed, 809 insertions(+), 819 deletions(-) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 1cbe837d2..acd0f8cef 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -8,58 +8,58 @@ !-------------------------------------------------------------------------------------------------- submodule(homogenization) homogenization_mech_RGC - enum, bind(c) - enumerator :: & - undefined_ID, & - constitutivework_ID, & - penaltyenergy_ID, & - volumediscrepancy_ID, & - averagerelaxrate_ID,& - maximumrelaxrate_ID,& - magnitudemismatch_ID - end enum + enum, bind(c) + enumerator :: & + undefined_ID, & + constitutivework_ID, & + penaltyenergy_ID, & + volumediscrepancy_ID, & + averagerelaxrate_ID,& + maximumrelaxrate_ID,& + magnitudemismatch_ID + end enum + + type :: tParameters + integer, dimension(:), allocatable :: & + Nconstituents + real(pReal) :: & + xiAlpha, & + ciAlpha + real(pReal), dimension(:), allocatable :: & + dAlpha, & + angles + integer :: & + of_debug = 0 + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID + end type tParameters - type :: tParameters - integer, dimension(:), allocatable :: & - Nconstituents - real(pReal) :: & - xiAlpha, & - ciAlpha - real(pReal), dimension(:), allocatable :: & - dAlpha, & - angles - integer :: & - of_debug = 0 - integer(kind(undefined_ID)), dimension(:), allocatable :: & - outputID - end type tParameters - - type :: tRGCstate - real(pReal), pointer, dimension(:) :: & - work, & - penaltyEnergy - real(pReal), pointer, dimension(:,:) :: & - relaxationVector - end type tRGCstate - - type :: 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 :: & - param - type(tRGCstate), dimension(:), allocatable :: & - state, & - state0 - type(tRGCdependentState), dimension(:), allocatable :: & - dependentState + type :: tRGCstate + real(pReal), pointer, dimension(:) :: & + work, & + penaltyEnergy + real(pReal), pointer, dimension(:,:) :: & + relaxationVector + end type tRGCstate + + type :: 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 :: & + param + type(tRGCstate), dimension(:), allocatable :: & + state, & + state0 + type(tRGCdependentState), dimension(:), allocatable :: & + dependentState contains @@ -68,121 +68,121 @@ contains !-------------------------------------------------------------------------------------------------- module subroutine mech_RGC_init - integer :: & - Ninstance, & - h, i, & - NofMyHomog, & - sizeState, nIntFaceTot - - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer :: & + Ninstance, & + h, i, & + NofMyHomog, & + sizeState, nIntFaceTot - integer(kind(undefined_ID)) :: & - outputID - - character(len=65536), dimension(:), allocatable :: & - outputs + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + + integer(kind(undefined_ID)) :: & + outputID + + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' - 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)') ' 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' - - Ninstance = count(homogenization_type == HOMOGENIZATION_RGC_ID) - if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - - allocate(param(Ninstance)) - allocate(state(Ninstance)) - allocate(state0(Ninstance)) - allocate(dependentState(Ninstance)) + 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' - - do h = 1, size(homogenization_type) - 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)) - + 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' + + Ninstance = count(homogenization_type == HOMOGENIZATION_RGC_ID) + if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) & + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + + allocate(param(Ninstance)) + allocate(state(Ninstance)) + allocate(state0(Ninstance)) + allocate(dependentState(Ninstance)) + + + do h = 1, size(homogenization_type) + 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',requiredSize=3) - if (homogenization_Ngrains(h) /= product(prm%Nconstituents)) & - call IO_error(211,ext_msg='clustersize ('//HOMOGENIZATION_RGC_label//')') - - prm%xiAlpha = config%getFloat('scalingparameter') - prm%ciAlpha = config%getFloat('overproportionality') - - prm%dAlpha = config%getFloats('grainsize', requiredSize=3) - prm%angles = config%getFloats('clusterorientation',requiredSize=3) - - outputs = config%getStrings('(output)',defaultVal=emptyStringArray) - allocate(prm%outputID(0)) - - do i=1, size(outputs) - outputID = undefined_ID - select case(outputs(i)) - - case('constitutivework') - outputID = constitutivework_ID - case('penaltyenergy') - outputID = penaltyenergy_ID - case('volumediscrepancy') - outputID = volumediscrepancy_ID - case('averagerelaxrate') - outputID = averagerelaxrate_ID - case('maximumrelaxrate') - outputID = maximumrelaxrate_ID - case('magnitudemismatch') - outputID = magnitudemismatch_ID - - end select - - if (outputID /= undefined_ID) then - prm%outputID = [prm%outputID , outputID] - endif - - enddo - - NofMyHomog = count(material_homogenizationAt == h) - nIntFaceTot = 3*( (prm%Nconstituents(1)-1)*prm%Nconstituents(2)*prm%Nconstituents(3) & - + prm%Nconstituents(1)*(prm%Nconstituents(2)-1)*prm%Nconstituents(3) & - + prm%Nconstituents(1)*prm%Nconstituents(2)*(prm%Nconstituents(3)-1)) - sizeState = nIntFaceTot & - + size(['avg constitutive work ','average penalty energy']) - - homogState(h)%sizeState = sizeState - homogState(h)%sizePostResults = 0 - 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) - - 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,:) - - allocate(dst%volumeDiscrepancy( NofMyHomog)) - allocate(dst%relaxationRate_avg( NofMyHomog)) - allocate(dst%relaxationRate_max( NofMyHomog)) - allocate(dst%mismatch( 3,NofMyHomog)) + prm%Nconstituents = config%getInts('clustersize',requiredSize=3) + if (homogenization_Ngrains(h) /= product(prm%Nconstituents)) & + call IO_error(211,ext_msg='clustersize ('//HOMOGENIZATION_RGC_label//')') + + prm%xiAlpha = config%getFloat('scalingparameter') + prm%ciAlpha = config%getFloat('overproportionality') + + prm%dAlpha = config%getFloats('grainsize', requiredSize=3) + prm%angles = config%getFloats('clusterorientation',requiredSize=3) + + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + + do i=1, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + + case('constitutivework') + outputID = constitutivework_ID + case('penaltyenergy') + outputID = penaltyenergy_ID + case('volumediscrepancy') + outputID = volumediscrepancy_ID + case('averagerelaxrate') + outputID = averagerelaxrate_ID + case('maximumrelaxrate') + outputID = maximumrelaxrate_ID + case('magnitudemismatch') + outputID = magnitudemismatch_ID + + end select + + if (outputID /= undefined_ID) then + prm%outputID = [prm%outputID , outputID] + endif + + enddo + + NofMyHomog = count(material_homogenizationAt == h) + nIntFaceTot = 3*( (prm%Nconstituents(1)-1)*prm%Nconstituents(2)*prm%Nconstituents(3) & + + prm%Nconstituents(1)*(prm%Nconstituents(2)-1)*prm%Nconstituents(3) & + + prm%Nconstituents(1)*prm%Nconstituents(2)*(prm%Nconstituents(3)-1)) + sizeState = nIntFaceTot & + + size(['avg constitutive work ','average penalty energy']) + + homogState(h)%sizeState = sizeState + homogState(h)%sizePostResults = 0 + 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) + + 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,:) + + allocate(dst%volumeDiscrepancy( NofMyHomog)) + allocate(dst%relaxationRate_avg( NofMyHomog)) + allocate(dst%relaxationRate_max( NofMyHomog)) + allocate(dst%mismatch( 3,NofMyHomog)) !-------------------------------------------------------------------------------------------------- ! assigning cluster orientations - 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 - - enddo + 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 + + enddo end subroutine mech_RGC_init @@ -192,47 +192,47 @@ end subroutine mech_RGC_init !-------------------------------------------------------------------------------------------------- module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) - real(pReal), dimension (:,:,:), 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, intent(in) :: & + instance, & + of + + real(pReal), dimension(3) :: aVect,nVect + integer, dimension(4) :: intFace + integer, dimension(3) :: iGrain3 + integer :: iGrain,iFace,i,j - real(pReal), dimension (3,3), intent(in) :: avgF !< averaged F - integer, intent(in) :: & - instance, & - of - - real(pReal), dimension(3) :: aVect,nVect - integer, dimension(4) :: intFace - integer, dimension(3) :: iGrain3 - integer :: iGrain,iFace,i,j - - associate(prm => param(instance)) + associate(prm => param(instance)) !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations - F = 0.0_pReal - do iGrain = 1,product(prm%Nconstituents) - iGrain3 = grain1to3(iGrain,prm%Nconstituents) - do iFace = 1,6 - 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:3,j=1:3) & - 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 + F = 0.0_pReal + do iGrain = 1,product(prm%Nconstituents) + iGrain3 = grain1to3(iGrain,prm%Nconstituents) + do iFace = 1,6 + 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:3,j=1:3) & + 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 #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then - write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain - do i = 1,3 - write(6,'(1x,3(e15.8,1x))')(F(i,j,iGrain), j = 1,3) - enddo - write(6,*)' ' - flush(6) - endif + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then + write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain + do i = 1,3 + write(6,'(1x,3(e15.8,1x))')(F(i,j,iGrain), j = 1,3) + enddo + write(6,*)' ' + flush(6) + endif #endif - enddo + enddo - end associate + end associate end subroutine mech_RGC_partitionDeformation @@ -243,203 +243,198 @@ end subroutine mech_RGC_partitionDeformation !-------------------------------------------------------------------------------------------------- module procedure mech_RGC_updateState - integer, dimension(4) :: intFaceN,intFaceP,faceID - integer, dimension(3) :: nGDim,iGr3N,iGr3P - integer :: 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 + integer, dimension(4) :: intFaceN,intFaceP,faceID + integer, dimension(3) :: nGDim,iGr3N,iGr3P + integer :: 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, dimension(3) :: stresLoc - integer, dimension(2) :: residLoc + integer, dimension(3) :: stresLoc + integer, dimension(2) :: residLoc #endif - zeroTimeStep: if(dEq0(dt)) then - mech_RGC_updateState = .true. ! pretend everything is fine and return - return - endif zeroTimeStep + zeroTimeStep: if(dEq0(dt)) then + mech_RGC_updateState = .true. ! pretend everything is fine and return + return + endif zeroTimeStep - instance = homogenization_typeInstance(material_homogenizationAt(el)) - of = mappingHomogenization(1,ip,el) - - associate(stt => state(instance), st0 => state0(instance), dst => dependentState(instance), prm => param(instance)) + instance = homogenization_typeInstance(material_homogenizationAt(el)) + of = mappingHomogenization(1,ip,el) + + associate(stt => state(instance), st0 => state0(instance), dst => dependentState(instance), prm => param(instance)) !-------------------------------------------------------------------------------------------------- ! get the dimension of the cluster (grains and interfaces) - nGDim = prm%Nconstituents - nGrain = product(nGDim) - nIntFaceTot = (nGDim(1)-1)*nGDim(2)*nGDim(3) & - + nGDim(1)*(nGDim(2)-1)*nGDim(3) & - + nGDim(1)*nGDim(2)*(nGDim(3)-1) + nGDim = prm%Nconstituents + nGrain = product(nGDim) + nIntFaceTot = (nGDim(1)-1)*nGDim(2)*nGDim(3) & + + nGDim(1)*(nGDim(2)-1)*nGDim(3) & + + nGDim(1)*nGDim(2)*(nGDim(3)-1) !-------------------------------------------------------------------------------------------------- ! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster - allocate(resid(3*nIntFaceTot), source=0.0_pReal) - allocate(tract(nIntFaceTot,3), source=0.0_pReal) - relax = stt%relaxationVector(:,of) - drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) + allocate(resid(3*nIntFaceTot), source=0.0_pReal) + allocate(tract(nIntFaceTot,3), source=0.0_pReal) + relax = stt%relaxationVector(:,of) + drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then - write(6,'(1x,a30)')'Obtained state: ' - do i = 1,size(stt%relaxationVector(:,of)) - write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) - enddo - write(6,*)' ' - endif + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then + write(6,'(1x,a30)')'Obtained state: ' + do i = 1,size(stt%relaxationVector(:,of)) + write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) + enddo + write(6,*)' ' + endif #endif !-------------------------------------------------------------------------------------------------- ! computing interface mismatch and stress penalty tensor for all interfaces of all grains - call stressPenalty(R,NN,avgF,F,ip,el,instance,of) + call stressPenalty(R,NN,avgF,F,ip,el,instance,of) !-------------------------------------------------------------------------------------------------- ! calculating volume discrepancy and stress penalty related to overall volume discrepancy - call volumePenalty(D,dst%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) then - do iGrain = 1,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) - write(6,'(/,1x,a30,1x,i3)')'Stress and penalties of grain: ',iGrain - do i = 1,3 - write(6,'(1x,3(e15.8,1x),1x,3(e15.8,1x),1x,3(e15.8,1x))')(P(i,j,iGrain), j = 1,3), & - (R(i,j,iGrain), j = 1,3), & - (D(i,j,iGrain), j = 1,3) - enddo - write(6,*)' ' - enddo - endif + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then + do iGrain = 1,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) + write(6,'(/,1x,a30,1x,i3)')'Stress and penalties of grain: ',iGrain + do i = 1,3 + write(6,'(1x,3(e15.8,1x),1x,3(e15.8,1x),1x,3(e15.8,1x))')(P(i,j,iGrain), j = 1,3), & + (R(i,j,iGrain), j = 1,3), & + (D(i,j,iGrain), j = 1,3) + enddo + write(6,*)' ' + enddo + endif #endif !------------------------------------------------------------------------------------------------ ! computing the residual stress from the balance of traction at all (interior) interfaces - do iNum = 1,nIntFaceTot - faceID = interface1to4(iNum,param(instance)%Nconstituents) ! identifying the interface ID in local coordinate system (4-dimensional index) + do iNum = 1,nIntFaceTot + 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,param(instance)%Nconstituents) ! translate the local grain ID into global coordinate system (1-dimensional index) - intFaceN = getInterface(2*faceID(1),iGr3N) - normN = interfaceNormal(intFaceN,instance,of) + 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*faceID(1),iGr3N) + normN = interfaceNormal(intFaceN,instance,of) !-------------------------------------------------------------------------------------------------- ! identify the right/up/front grain (+|P) - iGr3P = iGr3N - iGr3P(faceID(1)) = iGr3N(faceID(1))+1 ! 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*faceID(1)-1,iGr3P) - normP = interfaceNormal(intFaceP,instance,of) + iGr3P = iGr3N + iGr3P(faceID(1)) = iGr3N(faceID(1))+1 ! 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*faceID(1)-1,iGr3P) + normP = interfaceNormal(intFaceP,instance,of) !-------------------------------------------------------------------------------------------------- ! compute the residual of traction at the interface (in local system, 4-dimensional index) - do i = 1,3 - tract(iNum,i) = sign(viscModus_RGC*(abs(drelax(i+3*(iNum-1)))/(refRelaxRate_RGC*dt))**viscPower_RGC, & - drelax(i+3*(iNum-1))) ! contribution from the relaxation viscosity - do j = 1,3 - tract(iNum,i) = tract(iNum,i) + (P(i,j,iGrP) + R(i,j,iGrP) + D(i,j,iGrP))*normP(j) & ! contribution from material stress P, mismatch penalty R, and volume penalty D projected into the interface - + (P(i,j,iGrN) + R(i,j,iGrN) + D(i,j,iGrN))*normN(j) - resid(i+3*(iNum-1)) = tract(iNum,i) ! translate the local residual into global 1-dimensional residual array - enddo - enddo + do i = 1,3 + tract(iNum,i) = sign(viscModus_RGC*(abs(drelax(i+3*(iNum-1)))/(refRelaxRate_RGC*dt))**viscPower_RGC, & + drelax(i+3*(iNum-1))) ! contribution from the relaxation viscosity + do j = 1,3 + tract(iNum,i) = tract(iNum,i) + (P(i,j,iGrP) + R(i,j,iGrP) + D(i,j,iGrP))*normP(j) & ! contribution from material stress P, mismatch penalty R, and volume penalty D projected into the interface + + (P(i,j,iGrN) + R(i,j,iGrN) + D(i,j,iGrN))*normN(j) + resid(i+3*(iNum-1)) = tract(iNum,i) ! translate the local residual into global 1-dimensional residual array + enddo + enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then - write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum - write(6,'(1x,3(e15.8,1x))')(tract(iNum,j), j = 1,3) - write(6,*)' ' - endif + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then + write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum + write(6,'(1x,3(e15.8,1x))')(tract(iNum,j), j = 1,3) + write(6,*)' ' + endif #endif - enddo + enddo !-------------------------------------------------------------------------------------------------- ! convergence check for stress residual - stresMax = maxval(abs(P)) ! get the maximum of first Piola-Kirchhoff (material) stress - residMax = maxval(abs(tract)) ! get the maximum of the residual + stresMax = maxval(abs(P)) ! get the maximum of first Piola-Kirchhoff (material) stress + residMax = maxval(abs(tract)) ! get the maximum of the residual #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & - .and. prm%of_debug == of) then - stresLoc = maxloc(abs(P)) - residLoc = maxloc(abs(tract)) - 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, & - '@ grain',stresLoc(3),'in component',stresLoc(1),stresLoc(2) - 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) - endif + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) then + stresLoc = maxloc(abs(P)) + residLoc = maxloc(abs(tract)) + 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, & + '@ grain',stresLoc(3),'in component',stresLoc(1),stresLoc(2) + 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) + endif #endif - mech_RGC_updateState = .false. + mech_RGC_updateState = .false. !-------------------------------------------------------------------------------------------------- ! If convergence reached => done and happy - if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then - mech_RGC_updateState = .true. + if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then + mech_RGC_updateState = .true. #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & - .and. prm%of_debug == of) write(6,'(1x,a55,/)')'... done and happy' - flush(6) + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) & + write(6,'(1x,a55,/)')'... done and happy'; flush(6) #endif !-------------------------------------------------------------------------------------------------- ! compute/update the state for postResult, i.e., all energy densities computed by time-integration - do iGrain = 1,product(prm%Nconstituents) - do i = 1,3;do j = 1,3 - 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 + do iGrain = 1,product(prm%Nconstituents) + do i = 1,3;do j = 1,3 + 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 - dst%mismatch(1:3,of) = sum(NN,2)/real(nGrain,pReal) - dst%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pReal) - dst%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*nIntFaceTot,pReal) + dst%relaxationRate_max(of) = maxval(abs(drelax))/dt #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & - .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), & - 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: ', 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 + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .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), & + 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: ', 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 - return + return !-------------------------------------------------------------------------------------------------- ! 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 - mech_RGC_updateState = [.true.,.false.] ! with direct cut-back + elseif (residMax > relMax_RGC*stresMax .or. residMax > absMax_RGC) then ! try to restart when residual blows up exceeding maximum bound + mech_RGC_updateState = [.true.,.false.] ! with direct cut-back #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & - .and. prm%of_debug == of) write(6,'(1x,a,/)') '... broken' - flush(6) + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) & + write(6,'(1x,a,/)') '... broken'; flush(6) #endif return else ! proceed with computing the Jacobian and state update #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & - .and. prm%of_debug == of) write(6,'(1x,a,/)') '... not yet done' - flush(6) + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) & + write(6,'(1x,a,/)') '... not yet done'; flush(6) #endif endif @@ -450,465 +445,464 @@ module procedure mech_RGC_updateState !-------------------------------------------------------------------------------------------------- ! ... 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,nIntFaceTot - faceID = interface1to4(iNum,param(instance)%Nconstituents) ! assembling of local dPdF into global Jacobian matrix + allocate(smatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal) + do iNum = 1,nIntFaceTot + 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*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system - normN = interfaceNormal(intFaceN,instance,of) - do iFace = 1,6 - 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 - do i=1,3; do j=1,3; do k=1,3; do l=1,3 - 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 + 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*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system + normN = interfaceNormal(intFaceN,instance,of) + do iFace = 1,6 + 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 + do i=1,3; do j=1,3; do k=1,3; do l=1,3 + 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 - endif - enddo + endif + enddo !-------------------------------------------------------------------------------------------------- ! identify the right/up/front grain (+|P) - iGr3P = iGr3N - iGr3P(faceID(1)) = iGr3N(faceID(1))+1 ! identifying the grain ID in local coordinate sytem - iGrP = grain3to1(iGr3P,param(instance)%Nconstituents) ! translate into global grain ID - intFaceP = getInterface(2*faceID(1)-1,iGr3P) ! identifying the connecting interface in local coordinate system - normP = interfaceNormal(intFaceP,instance,of) - do iFace = 1,6 - 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 - if (iMun > 0) then ! get the corresponding tangent - do i=1,3; do j=1,3; do k=1,3; do l=1,3 - 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 - enddo + iGr3P = iGr3N + iGr3P(faceID(1)) = iGr3N(faceID(1))+1 ! identifying the grain ID in local coordinate sytem + iGrP = grain3to1(iGr3P,param(instance)%Nconstituents) ! translate into global grain ID + intFaceP = getInterface(2*faceID(1)-1,iGr3P) ! identifying the connecting interface in local coordinate system + normP = interfaceNormal(intFaceP,instance,of) + do iFace = 1,6 + 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 + if (iMun > 0) then ! get the corresponding tangent + do i=1,3; do j=1,3; do k=1,3; do l=1,3 + 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 + enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then - write(6,'(1x,a30)')'Jacobian matrix of stress' - do i = 1,3*nIntFaceTot - write(6,'(1x,100(e11.4,1x))')(smatrix(i,j), j = 1,3*nIntFaceTot) - enddo - write(6,*)' ' - flush(6) - endif + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then + write(6,'(1x,a30)')'Jacobian matrix of stress' + do i = 1,3*nIntFaceTot + write(6,'(1x,100(e11.4,1x))')(smatrix(i,j), j = 1,3*nIntFaceTot) + enddo + write(6,*)' ' + flush(6) + endif #endif !-------------------------------------------------------------------------------------------------- ! ... of the stress penalty tangent (mismatch penalty and volume penalty, computed using numerical ! perturbation method) "pmatrix" - 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) + 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,3*nIntFaceTot - p_relax = relax - 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,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 + do ipert = 1,3*nIntFaceTot + p_relax = relax + 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,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 - p_resid = 0.0_pReal - do iNum = 1,nIntFaceTot - faceID = interface1to4(iNum,param(instance)%Nconstituents) ! identifying the interface ID in local coordinate system (4-dimensional index) + p_resid = 0.0_pReal + do iNum = 1,nIntFaceTot + 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) ! 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*faceID(1),iGr3N) ! identify the interface ID of the grain - normN = interfaceNormal(intFaceN,instance,of) + 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*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 ! 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*faceID(1)-1,iGr3P) ! identify the interface ID of the grain - normP = interfaceNormal(intFaceP,instance,of) + iGr3P = iGr3N + iGr3P(faceID(1)) = iGr3N(faceID(1))+1 ! 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*faceID(1)-1,iGr3P) ! identify the interface ID of the grain + normP = interfaceNormal(intFaceP,instance,of) !-------------------------------------------------------------------------------------------------- ! compute the residual stress (contribution of mismatch and volume penalties) from perturbed state ! at all interfaces - do i = 1,3; do j = 1,3 - p_resid(i+3*(iNum-1)) = p_resid(i+3*(iNum-1)) + (pR(i,j,iGrP) - R(i,j,iGrP))*normP(j) & - + (pR(i,j,iGrN) - R(i,j,iGrN))*normN(j) & - + (pD(i,j,iGrP) - D(i,j,iGrP))*normP(j) & - + (pD(i,j,iGrN) - D(i,j,iGrN))*normN(j) - enddo; enddo - enddo - pmatrix(:,ipert) = p_resid/pPert_RGC - enddo + do i = 1,3; do j = 1,3 + p_resid(i+3*(iNum-1)) = p_resid(i+3*(iNum-1)) + (pR(i,j,iGrP) - R(i,j,iGrP))*normP(j) & + + (pR(i,j,iGrN) - R(i,j,iGrN))*normN(j) & + + (pD(i,j,iGrP) - D(i,j,iGrP))*normP(j) & + + (pD(i,j,iGrN) - D(i,j,iGrN))*normN(j) + enddo; enddo + enddo + pmatrix(:,ipert) = p_resid/pPert_RGC + enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then - write(6,'(1x,a30)')'Jacobian matrix of penalty' - do i = 1,3*nIntFaceTot - write(6,'(1x,100(e11.4,1x))')(pmatrix(i,j), j = 1,3*nIntFaceTot) - enddo - write(6,*)' ' - flush(6) - endif + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then + write(6,'(1x,a30)')'Jacobian matrix of penalty' + do i = 1,3*nIntFaceTot + write(6,'(1x,100(e11.4,1x))')(pmatrix(i,j), j = 1,3*nIntFaceTot) + enddo + write(6,*)' ' + flush(6) + endif #endif !-------------------------------------------------------------------------------------------------- ! ... of the numerical viscosity traction "rmatrix" - allocate(rmatrix(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal) - do i=1,3*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 - enddo + allocate(rmatrix(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal) + do i=1,3*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 + enddo #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then - write(6,'(1x,a30)')'Jacobian matrix of penalty' - do i = 1,3*nIntFaceTot - write(6,'(1x,100(e11.4,1x))')(rmatrix(i,j), j = 1,3*nIntFaceTot) - enddo - write(6,*)' ' - flush(6) - endif + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then + write(6,'(1x,a30)')'Jacobian matrix of penalty' + do i = 1,3*nIntFaceTot + write(6,'(1x,100(e11.4,1x))')(rmatrix(i,j), j = 1,3*nIntFaceTot) + enddo + write(6,*)' ' + flush(6) + endif #endif !-------------------------------------------------------------------------------------------------- ! The overall Jacobian matrix summarizing contributions of smatrix, pmatrix, rmatrix - allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix + allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then - write(6,'(1x,a30)')'Jacobian matrix (total)' - do i = 1,3*nIntFaceTot - write(6,'(1x,100(e11.4,1x))')(jmatrix(i,j), j = 1,3*nIntFaceTot) - enddo - write(6,*)' ' - flush(6) - endif + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then + write(6,'(1x,a30)')'Jacobian matrix (total)' + do i = 1,3*nIntFaceTot + write(6,'(1x,100(e11.4,1x))')(jmatrix(i,j), j = 1,3*nIntFaceTot) + enddo + write(6,*)' ' + flush(6) + endif #endif !-------------------------------------------------------------------------------------------------- ! computing the update of the state variable (relaxation vectors) using the Jacobian matrix - allocate(jnverse(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal) - call math_invert2(jnverse,error,jmatrix) + allocate(jnverse(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal) + call math_invert2(jnverse,error,jmatrix) #ifdef DEBUG - if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then - write(6,'(1x,a30)')'Jacobian inverse' - do i = 1,3*nIntFaceTot - write(6,'(1x,100(e11.4,1x))')(jnverse(i,j), j = 1,3*nIntFaceTot) - enddo - write(6,*)' ' - flush(6) - endif + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then + write(6,'(1x,a30)')'Jacobian inverse' + do i = 1,3*nIntFaceTot + write(6,'(1x,100(e11.4,1x))')(jnverse(i,j), j = 1,3*nIntFaceTot) + enddo + write(6,*)' ' + flush(6) + endif #endif !-------------------------------------------------------------------------------------------------- ! calculate the state update (global relaxation vectors) for the next Newton-Raphson iteration - drelax = 0.0_pReal - do i = 1,3*nIntFaceTot;do j = 1,3*nIntFaceTot - drelax(i) = drelax(i) - jnverse(i,j)*resid(j) ! Calculate the correction for the state variable - enddo; enddo - 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 - mech_RGC_updateState = [.true.,.false.] - !$OMP CRITICAL (write2out) - write(6,'(1x,a,1x,i3,1x,a,1x,i3,1x,a)')'RGC_updateState: ip',ip,'| el',el,'enforces cutback' - write(6,'(1x,a,1x,e15.8)')'due to large relaxation change =',maxval(abs(drelax)) - flush(6) - !$OMP END CRITICAL (write2out) - endif + drelax = 0.0_pReal + do i = 1,3*nIntFaceTot;do j = 1,3*nIntFaceTot + drelax(i) = drelax(i) - jnverse(i,j)*resid(j) ! Calculate the correction for the state variable + enddo; enddo + 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 + mech_RGC_updateState = [.true.,.false.] + !$OMP CRITICAL (write2out) + write(6,'(1x,a,1x,i3,1x,a,1x,i3,1x,a)')'RGC_updateState: ip',ip,'| el',el,'enforces cutback' + write(6,'(1x,a,1x,e15.8)')'due to large relaxation change =',maxval(abs(drelax)) + flush(6) + !$OMP END CRITICAL (write2out) + endif #ifdef DEBUG - if (iand(debug_homogenization, debug_levelExtensive) > 0) then - write(6,'(1x,a30)')'Returned state: ' - do i = 1,size(stt%relaxationVector(:,of)) - write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) - enddo - write(6,*)' ' - flush(6) - endif -#endif - - end associate - - contains - !-------------------------------------------------------------------------------------------------- - !> @brief calculate stress-like penalty due to deformation mismatch - !-------------------------------------------------------------------------------------------------- - subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of) - - real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty - real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch - - real(pReal), dimension (:,:,:), intent(in) :: fDef !< deformation gradients - real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor - integer, intent(in) :: ip,el,instance,of - - integer, dimension (4) :: intFace - integer, dimension (3) :: iGrain3,iGNghb3,nGDim - real(pReal), dimension (3,3) :: gDef,nDef - real(pReal), dimension (3) :: nVect,surfCorr - real(pReal), dimension (2) :: Gmoduli - integer :: 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 - - 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,instance,of) - - associate(prm => param(instance)) - -#ifdef DEBUG - debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & - .and. prm%of_debug == of - - if (debugActive) then - write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el - write(6,*) surfCorr + if (iand(debug_homogenization, debug_levelExtensive) > 0) then + write(6,'(1x,a30)')'Returned state: ' + do i = 1,size(stt%relaxationVector(:,of)) + write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) + enddo + write(6,*)' ' + flush(6) endif #endif - - !-------------------------------------------------------------------------------------------------- - ! computing the mismatch and penalty stress tensor of all grains - grainLoop: do iGrain = 1,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 - - interfaceLoop: do iFace = 1,6 - 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(abs(intFace(1))) = iGNghb3(abs(intFace(1))) & - + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal)) - where(iGNghb3 < 1) iGNghb3 = nGDim - where(iGNghb3 >nGDim) iGNghb3 = 1 - 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)) ! 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,3; do j = 1,3 - do k = 1,3; do l = 1,3 - 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 - 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) + + end associate + + contains + !------------------------------------------------------------------------------------------------ + !> @brief calculate stress-like penalty due to deformation mismatch + !------------------------------------------------------------------------------------------------ + subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of) + + real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty + real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch + + real(pReal), dimension (:,:,:), intent(in) :: fDef !< deformation gradients + real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor + integer, intent(in) :: ip,el,instance,of + + integer, dimension (4) :: intFace + integer, dimension (3) :: iGrain3,iGNghb3,nGDim + real(pReal), dimension (3,3) :: gDef,nDef + real(pReal), dimension (3) :: nVect,surfCorr + real(pReal), dimension (2) :: Gmoduli + integer :: iGrain,iGNghb,iFace,i,j,k,l + real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb + real(pReal), parameter :: nDefToler = 1.0e-10_pReal #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 + logical :: debugActive +#endif + + 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,instance,of) + + associate(prm => param(instance)) + +#ifdef DEBUG + debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .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 + grainLoop: do iGrain = 1,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 + + interfaceLoop: do iFace = 1,6 + 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(abs(intFace(1))) = iGNghb3(abs(intFace(1))) & + + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal)) + where(iGNghb3 < 1) iGNghb3 = nGDim + where(iGNghb3 >nGDim) iGNghb3 = 1 + 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)) ! 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,3; do j = 1,3 + do k = 1,3; do l = 1,3 + 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 + 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,3; do j = 1,3; do k = 1,3; do l = 1,3 + 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 interfaceLoop +#ifdef DEBUG + if (debugActive) then + write(6,'(1x,a20,i2)')'Penalty of grain: ',iGrain + write(6,*) transpose(rPen(1:3,1:3,iGrain)) + endif +#endif + + enddo grainLoop + + end associate + + end subroutine stressPenalty + + + !------------------------------------------------------------------------------------------------ + !> @brief calculate stress-like penalty due to volume discrepancy + !------------------------------------------------------------------------------------------------ + subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of) + + real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume + real(pReal), intent(out) :: vDiscrep ! total volume discrepancy + + real(pReal), dimension (:,:,:), intent(in) :: fDef ! deformation gradients + real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient + integer, intent(in) :: & + Ngrain, & + instance, & + of + + real(pReal), dimension(size(vPen,3)) :: gVol + integer :: i + + !---------------------------------------------------------------------------------------------- + ! compute the volumes of grains and of cluster + vDiscrep = math_det33(fAvg) ! compute the volume of the cluster + do i = 1,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 i = 1,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(i)*transpose(math_inv33(fDef(:,:,i))) + +#ifdef DEBUG + if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & + .and. param(instance)%of_debug == of) then + write(6,'(1x,a30,i2)')'Volume penalty of grain: ',i + write(6,*) transpose(vPen(:,:,i)) endif #endif - - !-------------------------------------------------------------------------------------------------- - ! compute the stress penalty of all interfaces - do i = 1,3; do j = 1,3; do k = 1,3; do l = 1,3 - 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 interfaceLoop -#ifdef DEBUG - if (debugActive) then - write(6,'(1x,a20,i2)')'Penalty of grain: ',iGrain - write(6,*) transpose(rPen(1:3,1:3,iGrain)) - endif -#endif - - enddo grainLoop - - end associate - - end subroutine stressPenalty - - - !-------------------------------------------------------------------------------------------------- - !> @brief calculate stress-like penalty due to volume discrepancy - !-------------------------------------------------------------------------------------------------- - subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of) - - real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume - real(pReal), intent(out) :: vDiscrep ! total volume discrepancy - - real(pReal), dimension (:,:,:), intent(in) :: fDef ! deformation gradients - real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient - integer, intent(in) :: & - Ngrain, & - instance, & - of - - real(pReal), dimension(size(vPen,3)) :: gVol - integer :: i - - !-------------------------------------------------------------------------------------------------- - ! compute the volumes of grains and of cluster - vDiscrep = math_det33(fAvg) ! compute the volume of the cluster - do i = 1,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 i = 1,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(i)*transpose(math_inv33(fDef(:,:,i))) - -#ifdef DEBUG - if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & - .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 - - - !-------------------------------------------------------------------------------------------------- - !> @brief compute the correction factor accouted for surface evolution (area change) due to - ! deformation - !-------------------------------------------------------------------------------------------------- - function surfaceCorrection(avgF,instance,of) - - real(pReal), dimension(3) :: surfaceCorrection - - real(pReal), dimension(3,3), intent(in) :: avgF !< average F - integer, intent(in) :: & - instance, & - of - real(pReal), dimension(3,3) :: invC - real(pReal), dimension(3) :: nVect - real(pReal) :: detF - integer :: i,j,iBase - logical :: error - - call math_invert33(matmul(transpose(avgF),avgF),invC,detF,error) - - surfaceCorrection = 0.0_pReal - do iBase = 1,3 - nVect = interfaceNormal([iBase,1,1,1],instance,of) - do i = 1,3; do j = 1,3 - 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) - - real(pReal), dimension(2) :: equivalentModuli - - integer, intent(in) :: & - grainID,& - ip, & !< integration point number - el !< element number - real(pReal), dimension(6,6) :: elasTens - 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_partitionDeformation, but used only for perturbation scheme) - !-------------------------------------------------------------------------------------------------- - subroutine grainDeformation(F, avgF, instance, of) - - real(pReal), dimension(:,:,:), intent(out) :: F !< partioned F per grain - - real(pReal), dimension(:,:), intent(in) :: avgF !< averaged F - integer, intent(in) :: & - instance, & - of - - real(pReal), dimension(3) :: aVect,nVect - integer, dimension(4) :: intFace - integer, dimension(3) :: iGrain3 - integer :: iGrain,iFace,i,j - - !------------------------------------------------------------------------------------------------- - ! compute the deformation gradient of individual grains due to relaxations - - associate(prm => param(instance)) - - F = 0.0_pReal - do iGrain = 1,product(prm%Nconstituents) - iGrain3 = grain1to3(iGrain,prm%Nconstituents) - do iFace = 1,6 - intFace = getInterface(iFace,iGrain3) - aVect = relaxationVector(intFace,instance,of) - nVect = interfaceNormal(intFace,instance,of) - forall (i=1:3,j=1:3) & - 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 volumePenalty + + + !-------------------------------------------------------------------------------------------------- + !> @brief compute the correction factor accouted for surface evolution (area change) due to + ! deformation + !-------------------------------------------------------------------------------------------------- + function surfaceCorrection(avgF,instance,of) + + real(pReal), dimension(3) :: surfaceCorrection + + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + integer, intent(in) :: & + instance, & + of + real(pReal), dimension(3,3) :: invC + real(pReal), dimension(3) :: nVect + real(pReal) :: detF + integer :: i,j,iBase + logical :: error - end associate + call math_invert33(matmul(transpose(avgF),avgF),invC,detF,error) - end subroutine grainDeformation + surfaceCorrection = 0.0_pReal + do iBase = 1,3 + nVect = interfaceNormal([iBase,1,1,1],instance,of) + do i = 1,3; do j = 1,3 + 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) + + real(pReal), dimension(2) :: equivalentModuli + + integer, intent(in) :: & + grainID,& + ip, & !< integration point number + el !< element number + real(pReal), dimension(6,6) :: elasTens + 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_partitionDeformation, but used only for perturbation scheme) + !-------------------------------------------------------------------------------------------------- + subroutine grainDeformation(F, avgF, instance, of) + + real(pReal), dimension(:,:,:), intent(out) :: F !< partioned F per grain + + real(pReal), dimension(:,:), intent(in) :: avgF !< averaged F + integer, intent(in) :: & + instance, & + of + + real(pReal), dimension(3) :: aVect,nVect + integer, dimension(4) :: intFace + integer, dimension(3) :: iGrain3 + integer :: iGrain,iFace,i,j + + !------------------------------------------------------------------------------------------------- + ! compute the deformation gradient of individual grains due to relaxations + + associate(prm => param(instance)) + + F = 0.0_pReal + do iGrain = 1,product(prm%Nconstituents) + iGrain3 = grain1to3(iGrain,prm%Nconstituents) + do iFace = 1,6 + intFace = getInterface(iFace,iGrain3) + aVect = relaxationVector(intFace,instance,of) + nVect = interfaceNormal(intFace,instance,of) + forall (i=1:3,j=1:3) & + 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 associate + + end subroutine grainDeformation end procedure mech_RGC_updateState @@ -918,22 +912,21 @@ end procedure mech_RGC_updateState !-------------------------------------------------------------------------------------------------- module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) - 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 (:,:,:), intent(in) :: P !< partitioned stresses - real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: instance + real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses + real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + integer, intent(in) :: instance - avgP = sum(P,3) /real(product(param(instance)%Nconstituents),pReal) - dAvgPdAvgF = sum(dPdF,5)/real(product(param(instance)%Nconstituents),pReal) + avgP = sum(P,3) /real(product(param(instance)%Nconstituents),pReal) + dAvgPdAvgF = sum(dPdF,5)/real(product(param(instance)%Nconstituents),pReal) end subroutine mech_RGC_averageStressAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief writes results to HDF5 output file -! ToDo: check wheter units are correct !-------------------------------------------------------------------------------------------------- module subroutine mech_RGC_results(instance,group) #if defined(PETSc) || defined(DAMASK_HDF5) @@ -983,24 +976,22 @@ end subroutine mech_RGC_results !-------------------------------------------------------------------------------------------------- pure function relaxationVector(intFace,instance,of) - real(pReal), dimension (3) :: relaxationVector - - integer, intent(in) :: instance,of - integer, dimension(4), intent(in) :: intFace !< set of interface ID in 4D array (normal and position) - - integer :: iNum - + real(pReal), dimension (3) :: relaxationVector + integer, intent(in) :: instance,of + integer, dimension(4), intent(in) :: intFace !< set of interface ID in 4D array (normal and position) + + integer :: iNum !-------------------------------------------------------------------------------------------------- ! collect the interface relaxation vector from the global state array - iNum = interface4to1(intFace,param(instance)%Nconstituents) ! identify the position of the interface in global state array - if (iNum > 0) then - relaxationVector = state(instance)%relaxationVector((3*iNum-2):(3*iNum),of) - else - relaxationVector = 0.0_pReal - endif + iNum = interface4to1(intFace,param(instance)%Nconstituents) ! identify the position of the interface in global state array + if (iNum > 0) then + relaxationVector = state(instance)%relaxationVector((3*iNum-2):(3*iNum),of) + else + relaxationVector = 0.0_pReal + endif end function relaxationVector @@ -1010,22 +1001,22 @@ end function relaxationVector !-------------------------------------------------------------------------------------------------- pure function interfaceNormal(intFace,instance,of) - real(pReal), dimension(3) :: interfaceNormal + real(pReal), dimension(3) :: interfaceNormal - integer, dimension(4), intent(in) :: intFace !< interface ID in 4D array (normal and position) - integer, intent(in) :: & - instance, & - of + integer, dimension(4), intent(in) :: intFace !< interface ID in 4D array (normal and position) + integer, intent(in) :: & + instance, & + of - integer :: nPos + integer :: nPos !-------------------------------------------------------------------------------------------------- ! 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 = 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 = matmul(dependentState(instance)%orientation(1:3,1:3,of),interfaceNormal) ! map the normal vector into sample coordinate system (basis) + interfaceNormal = matmul(dependentState(instance)%orientation(1:3,1:3,of),interfaceNormal) ! map the normal vector into sample coordinate system (basis) end function interfaceNormal @@ -1035,21 +1026,20 @@ end function interfaceNormal !-------------------------------------------------------------------------------------------------- pure function getInterface(iFace,iGrain3) - integer, dimension(4) :: getInterface + integer, dimension(4) :: getInterface - integer, dimension(3), intent(in) :: iGrain3 !< grain ID in 3D array - integer, intent(in) :: iFace !< face index (1..6) mapped like (-e1,-e2,-e3,+e1,+e2,+e3) or iDir = (-1,-2,-3,1,2,3) + integer, dimension(3), intent(in) :: iGrain3 !< grain ID in 3D array + integer, intent(in) :: iFace !< face index (1..6) mapped like (-e1,-e2,-e3,+e1,+e2,+e3) or iDir = (-1,-2,-3,1,2,3) - integer :: iDir + integer :: iDir !< direction of interface normal -!* Direction of interface normal iDir = (int(real(iFace-1,pReal)/2.0_pReal)+1)*(-1)**iFace getInterface(1) = iDir !-------------------------------------------------------------------------------------------------- ! identify the interface position by the direction of its normal - getInterface(2:4) = iGrain3 - if (iDir < 0) getInterface(1-iDir) = getInterface(1-iDir)-1 ! to have a correlation with coordinate/position in real space + getInterface(2:4) = iGrain3 + if (iDir < 0) getInterface(1-iDir) = getInterface(1-iDir)-1 ! to have a correlation with coordinate/position in real space end function getInterface @@ -1059,13 +1049,13 @@ end function getInterface !-------------------------------------------------------------------------------------------------- pure function grain1to3(grain1,nGDim) - integer, dimension(3) :: grain1to3 + integer, dimension(3) :: grain1to3 - integer, intent(in) :: grain1 !< grain ID in 1D array - integer, dimension(3), intent(in) :: nGDim + integer, intent(in) :: grain1 !< grain ID in 1D array + integer, dimension(3), intent(in) :: nGDim - grain1to3 = 1 + [mod((grain1-1),nGDim(1)), & - mod((grain1-1)/nGDim(1),nGDim(2)), & + grain1to3 = 1 + [mod((grain1-1), nGDim(1)), & + mod((grain1-1)/ nGDim(1),nGDim(2)), & (grain1-1)/(nGDim(1)*nGDim(2))] end function grain1to3 @@ -1076,12 +1066,12 @@ end function grain1to3 !-------------------------------------------------------------------------------------------------- integer pure function grain3to1(grain3,nGDim) - integer, dimension(3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z) - integer, dimension(3), intent(in) :: nGDim - - grain3to1 = grain3(1) & - + nGDim(1)*(grain3(2)-1) & - + nGDim(1)*nGDim(2)*(grain3(3)-1) + integer, dimension(3), intent(in) :: grain3 !< grain ID in 3D array (pos.x,pos.y,pos.z) + integer, dimension(3), intent(in) :: nGDim + + grain3to1 = grain3(1) & + + nGDim(1)*(grain3(2)-1) & + + nGDim(1)*nGDim(2)*(grain3(3)-1) end function grain3to1 @@ -1091,43 +1081,43 @@ end function grain3to1 !-------------------------------------------------------------------------------------------------- integer pure function interface4to1(iFace4D, nGDim) - integer, dimension(4), intent(in) :: iFace4D !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z) - integer, dimension(3), intent(in) :: nGDim + integer, dimension(4), intent(in) :: iFace4D !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z) + integer, dimension(3), intent(in) :: nGDim - - select case(abs(iFace4D(1))) + + select case(abs(iFace4D(1))) - case(1) - if ((iFace4D(2) == 0) .or. (iFace4D(2) == nGDim(1))) then - interface4to1 = 0 - else - interface4to1 = iFace4D(3) + nGDim(2)*(iFace4D(4)-1) & - + nGDim(2)*nGDim(3)*(iFace4D(2)-1) - endif + case(1) + if ((iFace4D(2) == 0) .or. (iFace4D(2) == nGDim(1))) then + interface4to1 = 0 + else + interface4to1 = iFace4D(3) + nGDim(2)*(iFace4D(4)-1) & + + nGDim(2)*nGDim(3)*(iFace4D(2)-1) + endif - case(2) - if ((iFace4D(3) == 0) .or. (iFace4D(3) == nGDim(2))) then - interface4to1 = 0 - else - interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1) & - + nGDim(3)*nGDim(1)*(iFace4D(3)-1) & - + (nGDim(1)-1)*nGDim(2)*nGDim(3) ! total # of interfaces normal || e1 - endif + case(2) + if ((iFace4D(3) == 0) .or. (iFace4D(3) == nGDim(2))) then + interface4to1 = 0 + else + interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1) & + + nGDim(3)*nGDim(1)*(iFace4D(3)-1) & + + (nGDim(1)-1)*nGDim(2)*nGDim(3) ! total # of interfaces normal || e1 + endif - case(3) - if ((iFace4D(4) == 0) .or. (iFace4D(4) == nGDim(3))) then - interface4to1 = 0 - else - interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1) & - + nGDim(1)*nGDim(2)*(iFace4D(4)-1) & - + (nGDim(1)-1)*nGDim(2)*nGDim(3) & ! total # of interfaces normal || e1 - + nGDim(1)*(nGDim(2)-1)*nGDim(3) ! total # of interfaces normal || e2 - endif + case(3) + if ((iFace4D(4) == 0) .or. (iFace4D(4) == nGDim(3))) then + interface4to1 = 0 + else + interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1) & + + nGDim(1)*nGDim(2)*(iFace4D(4)-1) & + + (nGDim(1)-1)*nGDim(2)*nGDim(3) & ! total # of interfaces normal || e1 + + nGDim(1)*(nGDim(2)-1)*nGDim(3) ! total # of interfaces normal || e2 + endif - case default - interface4to1 = -1 - - end select + case default + interface4to1 = -1 + + end select end function interface4to1 @@ -1137,36 +1127,36 @@ end function interface4to1 !-------------------------------------------------------------------------------------------------- pure function interface1to4(iFace1D, nGDim) - integer, dimension(4) :: interface1to4 + integer, dimension(4) :: interface1to4 - integer, intent(in) :: iFace1D !< interface ID in 1D array - integer, dimension(3), intent(in) :: nGDim - integer, dimension(3) :: nIntFace + integer, intent(in) :: iFace1D !< interface ID in 1D array + integer, dimension(3), intent(in) :: nGDim + integer, dimension(3) :: nIntFace !-------------------------------------------------------------------------------------------------- ! compute the total number of interfaces, which ... - nIntFace = [(nGDim(1)-1)*nGDim(2)*nGDim(3), & ! ... normal || e1 - nGDim(1)*(nGDim(2)-1)*nGDim(3), & ! ... normal || e2 - nGDim(1)*nGDim(2)*(nGDim(3)-1)] ! ... normal || e3 + nIntFace = [(nGDim(1)-1)*nGDim(2)*nGDim(3), & ! ... normal || e1 + nGDim(1)*(nGDim(2)-1)*nGDim(3), & ! ... normal || e2 + nGDim(1)*nGDim(2)*(nGDim(3)-1)] ! ... normal || e3 !-------------------------------------------------------------------------------------------------- ! get the corresponding interface ID in 4D (normal and local position) - if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then ! interface with normal || e1 - interface1to4(1) = 1 - interface1to4(3) = mod((iFace1D-1),nGDim(2))+1 - interface1to4(4) = mod(int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)),nGDim(3))+1 - interface1to4(2) = int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)/real(nGDim(3),pReal))+1 - elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then ! interface with normal || e2 - interface1to4(1) = 2 - interface1to4(4) = mod((iFace1D-nIntFace(1)-1),nGDim(3))+1 - interface1to4(2) = mod(int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)),nGDim(1))+1 - interface1to4(3) = int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)/real(nGDim(1),pReal))+1 - elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal || e3 - interface1to4(1) = 3 - interface1to4(2) = mod((iFace1D-nIntFace(2)-nIntFace(1)-1),nGDim(1))+1 - interface1to4(3) = mod(int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)),nGDim(2))+1 - interface1to4(4) = int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)/real(nGDim(2),pReal))+1 - endif + if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then ! interface with normal || e1 + interface1to4(1) = 1 + interface1to4(3) = mod((iFace1D-1),nGDim(2))+1 + interface1to4(4) = mod(int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)),nGDim(3))+1 + interface1to4(2) = int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)/real(nGDim(3),pReal))+1 + elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then ! interface with normal || e2 + interface1to4(1) = 2 + interface1to4(4) = mod((iFace1D-nIntFace(1)-1),nGDim(3))+1 + interface1to4(2) = mod(int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)),nGDim(1))+1 + interface1to4(3) = int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)/real(nGDim(1),pReal))+1 + elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal || e3 + interface1to4(1) = 3 + interface1to4(2) = mod((iFace1D-nIntFace(2)-nIntFace(1)-1),nGDim(1))+1 + interface1to4(3) = mod(int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)),nGDim(2))+1 + interface1to4(4) = int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)/real(nGDim(2),pReal))+1 + endif end function interface1to4 From 2c4f1eb1738caa8e54f98ff5e74649b9e179ae69 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 20:32:53 +0200 Subject: [PATCH 30/49] adjusting indentation --- src/IO.f90 | 973 ++++++++++++++------------- src/kinematics_cleavage_opening.f90 | 18 +- src/kinematics_slipplane_opening.f90 | 302 ++++----- src/kinematics_thermal_expansion.f90 | 22 +- src/material.f90 | 118 ++-- src/quit.f90 | 67 +- 6 files changed, 750 insertions(+), 750 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index a6e0c7836..d245cccb3 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -50,6 +50,7 @@ module IO IO_countNumericalDataLines #endif #endif + private :: & IO_verifyFloatValue, & IO_verifyIntValue @@ -90,7 +91,7 @@ function IO_read_ASCII(fileName) result(fileContent) character(len=*), intent(in) :: fileName - character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines + character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines character(len=pStringLen) :: line character(len=:), allocatable :: rawData integer :: & @@ -224,85 +225,85 @@ end function IO_open_binary !-------------------------------------------------------------------------------------------------- subroutine IO_open_inputFile(fileUnit,modelName) - integer, intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: modelName !< model name, in case of restart not solver job name - - integer :: myStat - character(len=1024) :: path + integer, intent(in) :: fileUnit !< file unit + character(len=*), intent(in) :: modelName !< model name, in case of restart not solver job name + + integer :: myStat + character(len=1024) :: path #if defined(Abaqus) - integer :: fileType - - fileType = 1 ! assume .pes - path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used - open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') - if(myStat /= 0) then ! if .pes does not work / exist; use conventional extension, i.e.".inp" - fileType = 2 - path = trim(modelName)//inputFileExtension(fileType) - open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') - endif - if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) - - path = trim(modelName)//inputFileExtension(fileType)//'_assembly' - open(fileUnit,iostat=myStat,file=path) - if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) - if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1)) call IO_error(103) ! strip comments and concatenate any "include"s - close(fileUnit+1) + integer :: fileType - contains + fileType = 1 ! assume .pes + path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used + open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') + if(myStat /= 0) then ! if .pes does not work / exist; use conventional extension, i.e.".inp" + fileType = 2 + path = trim(modelName)//inputFileExtension(fileType) + open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') + endif + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) -!-------------------------------------------------------------------------------------------------- -!> @brief create a new input file for abaqus simulations by removing all comment lines and -!> including "include"s -!-------------------------------------------------------------------------------------------------- -recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) - - integer, intent(in) :: unit1, & - unit2 - - - integer, allocatable, dimension(:) :: chunkPos - character(len=65536) :: line,fname - logical :: createSuccess,fexist - - - do - read(unit2,'(A65536)',END=220) line - chunkPos = IO_stringPos(line) - - if (IO_lc(IO_StringValue(line,chunkPos,1))=='*include') then - fname = trim(line(9+scan(line(9:),'='):)) - inquire(file=fname, exist=fexist) - if (.not.(fexist)) then - !$OMP CRITICAL (write2out) - write(6,*)'ERROR: file does not exist error in abaqus_assembleInputFile' - write(6,*)'filename: ', trim(fname) - !$OMP END CRITICAL (write2out) - createSuccess = .false. - return - endif - open(unit2+1,err=200,status='old',file=fname) - if (abaqus_assembleInputFile(unit1,unit2+1)) then - createSuccess=.true. - close(unit2+1) - else - createSuccess=.false. - return - endif - else if (line(1:2) /= '**' .OR. line(1:8)=='**damask') then - write(unit1,'(A)') trim(line) - endif - enddo - + path = trim(modelName)//inputFileExtension(fileType)//'_assembly' + open(fileUnit,iostat=myStat,file=path) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) + if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1)) call IO_error(103) ! strip comments and concatenate any "include"s + close(fileUnit+1) + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief create a new input file for abaqus simulations by removing all comment lines and + !> including "include"s + !-------------------------------------------------------------------------------------------------- + recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) + + integer, intent(in) :: unit1, & + unit2 + + + integer, allocatable, dimension(:) :: chunkPos + character(len=65536) :: line,fname + logical :: createSuccess,fexist + + + do + read(unit2,'(A65536)',END=220) line + chunkPos = IO_stringPos(line) + + if (IO_lc(IO_StringValue(line,chunkPos,1))=='*include') then + fname = trim(line(9+scan(line(9:),'='):)) + inquire(file=fname, exist=fexist) + if (.not.(fexist)) then + !$OMP CRITICAL (write2out) + write(6,*)'ERROR: file does not exist error in abaqus_assembleInputFile' + write(6,*)'filename: ', trim(fname) + !$OMP END CRITICAL (write2out) + createSuccess = .false. + return + endif + open(unit2+1,err=200,status='old',file=fname) + if (abaqus_assembleInputFile(unit1,unit2+1)) then + createSuccess=.true. + close(unit2+1) + else + createSuccess=.false. + return + endif + else if (line(1:2) /= '**' .OR. line(1:8)=='**damask') then + write(unit1,'(A)') trim(line) + endif + enddo + 220 createSuccess = .true. - return - + return + 200 createSuccess =.false. - -end function abaqus_assembleInputFile + + end function abaqus_assembleInputFile #elif defined(Marc4DAMASK) - path = trim(modelName)//inputFileExtension - open(fileUnit,status='old',iostat=myStat,file=path) - if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) + path = trim(modelName)//inputFileExtension + open(fileUnit,status='old',iostat=myStat,file=path) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) #endif end subroutine IO_open_inputFile @@ -314,14 +315,14 @@ end subroutine IO_open_inputFile !-------------------------------------------------------------------------------------------------- subroutine IO_open_logFile(fileUnit) - integer, intent(in) :: fileUnit !< file unit + integer, intent(in) :: fileUnit !< file unit - integer :: myStat - character(len=1024) :: path + integer :: myStat + character(len=1024) :: path - path = trim(getSolverJobName())//LogFileExtension - open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') - if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) + path = trim(getSolverJobName())//LogFileExtension + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) end subroutine IO_open_logFile #endif @@ -333,15 +334,15 @@ end subroutine IO_open_logFile !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobFile(fileUnit,ext) - integer, intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext !< extension of file + integer, intent(in) :: fileUnit !< file unit + character(len=*), intent(in) :: ext !< extension of file - integer :: myStat - character(len=1024) :: path + integer :: myStat + character(len=1024) :: path - path = trim(getSolverJobName())//'.'//ext - open(fileUnit,status='replace',iostat=myStat,file=path) - if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) + path = trim(getSolverJobName())//'.'//ext + open(fileUnit,status='replace',iostat=myStat,file=path) + if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=path) end subroutine IO_write_jobFile @@ -351,16 +352,16 @@ end subroutine IO_write_jobFile !-------------------------------------------------------------------------------------------------- logical pure function IO_isBlank(string) - character(len=*), intent(in) :: string !< string to check for content + character(len=*), intent(in) :: string !< string to check for content - character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces - character(len=*), parameter :: comment = achar(35) ! comment id '#' + character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces + character(len=*), parameter :: comment = achar(35) ! comment id '#' - integer :: posNonBlank, posComment + integer :: posNonBlank, posComment - posNonBlank = verify(string,blankChar) - posComment = scan(string,comment) - IO_isBlank = posNonBlank == 0 .or. posNonBlank == posComment + posNonBlank = verify(string,blankChar) + posComment = scan(string,comment) + IO_isBlank = posNonBlank == 0 .or. posNonBlank == posComment end function IO_isBlank @@ -370,28 +371,28 @@ end function IO_isBlank !-------------------------------------------------------------------------------------------------- pure function IO_getTag(string,openChar,closeChar) - character(len=*), intent(in) :: string !< string to check for tag - character(len=len_trim(string)) :: IO_getTag - - character, intent(in) :: openChar, & !< indicates beginning of tag - closeChar !< indicates end of tag - - character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces - integer :: left,right - - IO_getTag = '' - - - if (openChar /= closeChar) then - left = scan(string,openChar) - right = scan(string,closeChar) - else - left = scan(string,openChar) - right = left + merge(scan(string(left+1:),openChar),0,len(string) > left) - endif - - if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs - IO_getTag = string(left+1:right-1) + character(len=*), intent(in) :: string !< string to check for tag + character(len=len_trim(string)) :: IO_getTag + + character, intent(in) :: openChar, & !< indicates beginning of tag + closeChar !< indicates end of tag + + character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces + integer :: left,right + + IO_getTag = '' + + + if (openChar /= closeChar) then + left = scan(string,openChar) + right = scan(string,closeChar) + else + left = scan(string,openChar) + right = left + merge(scan(string(left+1:),openChar),0,len(string) > left) + endif + + if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs + IO_getTag = string(left+1:right-1) end function IO_getTag @@ -433,28 +434,28 @@ end function IO_stringPos !-------------------------------------------------------------------------------------------------- function IO_stringValue(string,chunkPos,myChunk,silent) - integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - integer, intent(in) :: myChunk !< position number of desired chunk - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - character(len=:), allocatable :: IO_stringValue + integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + integer, intent(in) :: myChunk !< position number of desired chunk + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + character(len=:), allocatable :: IO_stringValue - logical, optional,intent(in) :: silent !< switch to trigger verbosity - character(len=16), parameter :: MYNAME = 'IO_stringValue: ' + logical, optional,intent(in) :: silent !< switch to trigger verbosity + character(len=16), parameter :: MYNAME = 'IO_stringValue: ' - logical :: warn + logical :: warn - if (present(silent)) then - warn = silent - else - warn = .false. - endif + if (present(silent)) then + warn = silent + else + warn = .false. + endif - IO_stringValue = '' - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then - if (warn) call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) - else valuePresent - IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) - endif valuePresent + IO_stringValue = '' + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then + if (warn) call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) + else valuePresent + IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) + endif valuePresent end function IO_stringValue @@ -464,21 +465,21 @@ end function IO_stringValue !-------------------------------------------------------------------------------------------------- real(pReal) function IO_floatValue (string,chunkPos,myChunk) - integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - integer, intent(in) :: myChunk !< position number of desired chunk - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - character(len=15), parameter :: MYNAME = 'IO_floatValue: ' - character(len=17), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-' + integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + integer, intent(in) :: myChunk !< position number of desired chunk + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + character(len=15), parameter :: MYNAME = 'IO_floatValue: ' + character(len=17), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-' - IO_floatValue = 0.0_pReal + IO_floatValue = 0.0_pReal - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then - call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) - else valuePresent - IO_floatValue = & - IO_verifyFloatValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),& - VALIDCHARACTERS,MYNAME) - endif valuePresent + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then + call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) + else valuePresent + IO_floatValue = & + IO_verifyFloatValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),& + VALIDCHARACTERS,MYNAME) + endif valuePresent end function IO_floatValue @@ -488,20 +489,20 @@ end function IO_floatValue !-------------------------------------------------------------------------------------------------- integer function IO_intValue(string,chunkPos,myChunk) - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - integer, intent(in) :: myChunk !< position number of desired chunk - integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - character(len=13), parameter :: MYNAME = 'IO_intValue: ' - character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + integer, intent(in) :: myChunk !< position number of desired chunk + integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + character(len=13), parameter :: MYNAME = 'IO_intValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - IO_intValue = 0 + IO_intValue = 0 - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then - call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) - else valuePresent - IO_intValue = IO_verifyIntValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),& - VALIDCHARACTERS,MYNAME) - endif valuePresent + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then + call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) + else valuePresent + IO_intValue = IO_verifyIntValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),& + VALIDCHARACTERS,MYNAME) + endif valuePresent end function IO_intValue @@ -512,29 +513,29 @@ end function IO_intValue !-------------------------------------------------------------------------------------------------- real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk) - character(len=*), intent(in) :: string !< raw input with known ends of each chunk - integer, intent(in) :: myChunk !< position number of desired chunk - integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=22), parameter :: MYNAME = 'IO_fixedNoEFloatValue ' - character(len=13), parameter :: VALIDBASE = '0123456789.+-' - character(len=12), parameter :: VALIDEXP = '0123456789+-' - - real(pReal) :: base - integer :: expon - integer :: pos_exp - - pos_exp = scan(string(ends(myChunk)+1:ends(myChunk+1)),'+-',back=.true.) - hasExponent: if (pos_exp > 1) then - base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk)+pos_exp-1))),& - VALIDBASE,MYNAME//'(base): ') - expon = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+pos_exp:ends(myChunk+1)))),& - VALIDEXP,MYNAME//'(exp): ') - else hasExponent - base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk+1)))),& - VALIDBASE,MYNAME//'(base): ') - expon = 0 - endif hasExponent - IO_fixedNoEFloatValue = base*10.0_pReal**real(expon,pReal) + character(len=*), intent(in) :: string !< raw input with known ends of each chunk + integer, intent(in) :: myChunk !< position number of desired chunk + integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string + character(len=22), parameter :: MYNAME = 'IO_fixedNoEFloatValue ' + character(len=13), parameter :: VALIDBASE = '0123456789.+-' + character(len=12), parameter :: VALIDEXP = '0123456789+-' + + real(pReal) :: base + integer :: expon + integer :: pos_exp + + pos_exp = scan(string(ends(myChunk)+1:ends(myChunk+1)),'+-',back=.true.) + hasExponent: if (pos_exp > 1) then + base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk)+pos_exp-1))),& + VALIDBASE,MYNAME//'(base): ') + expon = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+pos_exp:ends(myChunk+1)))),& + VALIDEXP,MYNAME//'(exp): ') + else hasExponent + base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk+1)))),& + VALIDBASE,MYNAME//'(base): ') + expon = 0 + endif hasExponent + IO_fixedNoEFloatValue = base*10.0_pReal**real(expon,pReal) end function IO_fixedNoEFloatValue @@ -544,14 +545,14 @@ end function IO_fixedNoEFloatValue !-------------------------------------------------------------------------------------------------- integer function IO_fixedIntValue(string,ends,myChunk) - character(len=*), intent(in) :: string !< raw input with known ends of each chunk - integer, intent(in) :: myChunk !< position number of desired chunk - integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=20), parameter :: MYNAME = 'IO_fixedIntValue: ' - character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - - IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk+1)))),& - VALIDCHARACTERS,MYNAME) + character(len=*), intent(in) :: string !< raw input with known ends of each chunk + integer, intent(in) :: myChunk !< position number of desired chunk + integer, dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string + character(len=20), parameter :: MYNAME = 'IO_fixedIntValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' + + IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk+1)))),& + VALIDCHARACTERS,MYNAME) end function IO_fixedIntValue #endif @@ -562,19 +563,19 @@ end function IO_fixedIntValue !-------------------------------------------------------------------------------------------------- pure function IO_lc(string) - character(len=*), intent(in) :: string !< string to convert - character(len=len(string)) :: IO_lc + character(len=*), intent(in) :: string !< string to convert + character(len=len(string)) :: IO_lc - character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' - character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' + character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - integer :: i,n + integer :: i,n - IO_lc = string - do i=1,len(string) - n = index(UPPER,IO_lc(i:i)) - if (n/=0) IO_lc(i:i) = LOWER(n:n) - enddo + IO_lc = string + do i=1,len(string) + n = index(UPPER,IO_lc(i:i)) + if (n/=0) IO_lc(i:i) = LOWER(n:n) + enddo end function IO_lc @@ -604,262 +605,262 @@ end function IO_intOut !-------------------------------------------------------------------------------------------------- subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) - integer, intent(in) :: error_ID - integer, optional, intent(in) :: el,ip,g,instance - character(len=*), optional, intent(in) :: ext_msg + integer, intent(in) :: error_ID + integer, optional, intent(in) :: el,ip,g,instance + character(len=*), optional, intent(in) :: ext_msg - external :: quit - character(len=1024) :: msg - character(len=1024) :: formatString + external :: quit + character(len=1024) :: msg + character(len=1024) :: formatString - select case (error_ID) + select case (error_ID) !-------------------------------------------------------------------------------------------------- ! internal errors - case (0) - msg = 'internal check failed:' + case (0) + msg = 'internal check failed:' !-------------------------------------------------------------------------------------------------- ! file handling errors - case (100) - msg = 'could not open file:' - case (101) - msg = 'write error for file:' - case (102) - msg = 'could not read file:' - case (103) - msg = 'could not assemble input files' - case (104) - msg = '{input} recursion limit reached' - case (105) - msg = 'unknown output:' - case (106) - msg = 'working directory does not exist:' - case (107) - msg = 'line length exceeds limit of 256' + case (100) + msg = 'could not open file:' + case (101) + msg = 'write error for file:' + case (102) + msg = 'could not read file:' + case (103) + msg = 'could not assemble input files' + case (104) + msg = '{input} recursion limit reached' + case (105) + msg = 'unknown output:' + case (106) + msg = 'working directory does not exist:' + case (107) + msg = 'line length exceeds limit of 256' !-------------------------------------------------------------------------------------------------- ! lattice error messages - case (130) - msg = 'unknown lattice structure encountered' - case (131) - msg = 'hex lattice structure with invalid c/a ratio' - case (132) - msg = 'trans_lattice_structure not possible' - case (133) - msg = 'transformed hex lattice structure with invalid c/a ratio' - case (135) - msg = 'zero entry on stiffness diagonal' - case (136) - msg = 'zero entry on stiffness diagonal for transformed phase' - case (137) - msg = 'not defined for lattice structure' - case (138) - msg = 'not enough interaction parameters given' + case (130) + msg = 'unknown lattice structure encountered' + case (131) + msg = 'hex lattice structure with invalid c/a ratio' + case (132) + msg = 'trans_lattice_structure not possible' + case (133) + msg = 'transformed hex lattice structure with invalid c/a ratio' + case (135) + msg = 'zero entry on stiffness diagonal' + case (136) + msg = 'zero entry on stiffness diagonal for transformed phase' + case (137) + msg = 'not defined for lattice structure' + case (138) + msg = 'not enough interaction parameters given' !-------------------------------------------------------------------------------------------------- ! errors related to the parsing of material.config - case (140) - msg = 'key not found' - case (141) - msg = 'number of chunks in string differs' - case (142) - msg = 'empty list' - case (143) - msg = 'no value found for key' - case (144) - msg = 'negative number systems requested' - case (145) - msg = 'too many systems requested' - case (146) - msg = 'number of values does not match' - case (147) - msg = 'not supported anymore' + case (140) + msg = 'key not found' + case (141) + msg = 'number of chunks in string differs' + case (142) + msg = 'empty list' + case (143) + msg = 'no value found for key' + case (144) + msg = 'negative number systems requested' + case (145) + msg = 'too many systems requested' + case (146) + msg = 'number of values does not match' + case (147) + msg = 'not supported anymore' !-------------------------------------------------------------------------------------------------- ! material error messages and related messages in mesh - case (150) - msg = 'index out of bounds' - case (151) - msg = 'microstructure has no constituents' - case (153) - msg = 'sum of phase fractions differs from 1' - case (154) - msg = 'homogenization index out of bounds' - case (155) - msg = 'microstructure index out of bounds' - case (156) - msg = 'reading from ODF file' - case (157) - msg = 'illegal texture transformation specified' - case (160) - msg = 'no entries in config part' - case (161) - msg = 'config part found twice' - case (165) - msg = 'homogenization configuration' - case (170) - msg = 'no homogenization specified via State Variable 2' - case (180) - msg = 'no microstructure specified via State Variable 3' - case (190) - msg = 'unknown element type:' - case (191) - msg = 'mesh consists of more than one element type' + case (150) + msg = 'index out of bounds' + case (151) + msg = 'microstructure has no constituents' + case (153) + msg = 'sum of phase fractions differs from 1' + case (154) + msg = 'homogenization index out of bounds' + case (155) + msg = 'microstructure index out of bounds' + case (156) + msg = 'reading from ODF file' + case (157) + msg = 'illegal texture transformation specified' + case (160) + msg = 'no entries in config part' + case (161) + msg = 'config part found twice' + case (165) + msg = 'homogenization configuration' + case (170) + msg = 'no homogenization specified via State Variable 2' + case (180) + msg = 'no microstructure specified via State Variable 3' + case (190) + msg = 'unknown element type:' + case (191) + msg = 'mesh consists of more than one element type' !-------------------------------------------------------------------------------------------------- ! plasticity error messages - case (200) - msg = 'unknown elasticity specified:' - case (201) - msg = 'unknown plasticity specified:' + case (200) + msg = 'unknown elasticity specified:' + case (201) + msg = 'unknown plasticity specified:' - case (210) - msg = 'unknown material parameter:' - case (211) - msg = 'material parameter out of bounds:' + case (210) + msg = 'unknown material parameter:' + case (211) + msg = 'material parameter out of bounds:' !-------------------------------------------------------------------------------------------------- ! numerics error messages - case (300) - msg = 'unknown numerics parameter:' - case (301) - msg = 'numerics parameter out of bounds:' + case (300) + msg = 'unknown numerics parameter:' + case (301) + msg = 'numerics parameter out of bounds:' !-------------------------------------------------------------------------------------------------- ! math errors - case (400) - msg = 'matrix inversion error' - case (401) - msg = 'math_check failed' - case (405) - msg = 'I_TO_HALTON-error: an input base BASE is <= 1' - case (406) - msg = 'Prime-error: N must be between 0 and PRIME_MAX' - case (407) - msg = 'Polar decomposition error' - case (409) - msg = 'math_check: R*v == q*v failed' - case (410) - msg = 'eigenvalues computation error' + case (400) + msg = 'matrix inversion error' + case (401) + msg = 'math_check failed' + case (405) + msg = 'I_TO_HALTON-error: an input base BASE is <= 1' + case (406) + msg = 'Prime-error: N must be between 0 and PRIME_MAX' + case (407) + msg = 'Polar decomposition error' + case (409) + msg = 'math_check: R*v == q*v failed' + case (410) + msg = 'eigenvalues computation error' !------------------------------------------------------------------------------------------------- ! homogenization errors - case (500) - msg = 'unknown homogenization specified' + case (500) + msg = 'unknown homogenization specified' !-------------------------------------------------------------------------------------------------- ! user errors - case (600) - msg = 'Ping-Pong not possible when using non-DAMASK elements' - case (601) - msg = 'Ping-Pong needed when using non-local plasticity' - case (602) - msg = 'invalid selection for debug' + case (600) + msg = 'Ping-Pong not possible when using non-DAMASK elements' + case (601) + msg = 'Ping-Pong needed when using non-local plasticity' + case (602) + msg = 'invalid selection for debug' !------------------------------------------------------------------------------------------------- ! DAMASK_marc errors - case (700) - msg = 'invalid materialpoint result requested' + case (700) + msg = 'invalid materialpoint result requested' !------------------------------------------------------------------------------------------------- ! errors related to the grid solver - case (809) - msg = 'initializing FFTW' - case (810) - msg = 'FFTW plan creation' - case (831) - msg = 'mask consistency violated in spectral loadcase' - case (832) - msg = 'ill-defined L (line partly defined) in spectral loadcase' - case (834) - msg = 'negative time increment in spectral loadcase' - case (835) - msg = 'non-positive increments in spectral loadcase' - case (836) - msg = 'non-positive result frequency in spectral loadcase' - case (837) - msg = 'incomplete loadcase' - case (838) - msg = 'mixed boundary conditions allow rotation' - case (841) - msg = 'missing header length info in spectral mesh' - case (842) - msg = 'incomplete information in spectral mesh header' - case (843) - msg = 'microstructure count mismatch' - case (846) - msg = 'rotation for load case rotation ill-defined (R:RT != I)' - case (880) - msg = 'mismatch of microstructure count and a*b*c in geom file' - case (891) - msg = 'unknown solver type selected' - case (892) - msg = 'unknown filter type selected' - case (893) - msg = 'PETSc: SNES_DIVERGED_FNORM_NAN' - case (894) - msg = 'MPI error' + case (809) + msg = 'initializing FFTW' + case (810) + msg = 'FFTW plan creation' + case (831) + msg = 'mask consistency violated in grid load case' + case (832) + msg = 'ill-defined L (line partly defined) in grid load case' + case (834) + msg = 'negative time increment in grid load case' + case (835) + msg = 'non-positive increments in grid load case' + case (836) + msg = 'non-positive result frequency in grid load case' + case (837) + msg = 'incomplete loadcase' + case (838) + msg = 'mixed boundary conditions allow rotation' + case (841) + msg = 'missing header length info in grid mesh' + case (842) + msg = 'incomplete information in grid mesh header' + case (843) + msg = 'microstructure count mismatch' + case (846) + msg = 'rotation for load case rotation ill-defined (R:RT != I)' + case (880) + msg = 'mismatch of microstructure count and a*b*c in geom file' + case (891) + msg = 'unknown solver type selected' + case (892) + msg = 'unknown filter type selected' + case (893) + msg = 'PETSc: SNES_DIVERGED_FNORM_NAN' + case (894) + msg = 'MPI error' !------------------------------------------------------------------------------------------------- ! error messages related to parsing of Abaqus input file - case (900) - msg = 'improper definition of nodes in input file (Nnodes < 2)' - case (901) - msg = 'no elements defined in input file (Nelems = 0)' - case (902) - msg = 'no element sets defined in input file (No *Elset exists)' - case (903) - msg = 'no materials defined in input file (Look into section assigments)' - case (904) - msg = 'no elements could be assigned for Elset: ' - case (905) - msg = 'error in mesh_abaqus_map_materials' - case (906) - msg = 'error in mesh_abaqus_count_cpElements' - case (907) - msg = 'size of mesh_mapFEtoCPelem in mesh_abaqus_map_elements' - case (908) - msg = 'size of mesh_mapFEtoCPnode in mesh_abaqus_map_nodes' - case (909) - msg = 'size of mesh_node in mesh_abaqus_build_nodes not equal to mesh_Nnodes' + case (900) + msg = 'improper definition of nodes in input file (Nnodes < 2)' + case (901) + msg = 'no elements defined in input file (Nelems = 0)' + case (902) + msg = 'no element sets defined in input file (No *Elset exists)' + case (903) + msg = 'no materials defined in input file (Look into section assigments)' + case (904) + msg = 'no elements could be assigned for Elset: ' + case (905) + msg = 'error in mesh_abaqus_map_materials' + case (906) + msg = 'error in mesh_abaqus_count_cpElements' + case (907) + msg = 'size of mesh_mapFEtoCPelem in mesh_abaqus_map_elements' + case (908) + msg = 'size of mesh_mapFEtoCPnode in mesh_abaqus_map_nodes' + case (909) + msg = 'size of mesh_node in mesh_abaqus_build_nodes not equal to mesh_Nnodes' !------------------------------------------------------------------------------------------------- ! general error messages - case (666) - msg = 'memory leak detected' - case default - msg = 'unknown error number...' + case (666) + msg = 'memory leak detected' + case default + msg = 'unknown error number...' - end select - - !$OMP CRITICAL (write2out) - write(0,'(/,a)') ' ┌'//IO_DIVIDER//'┐' - write(0,'(a,24x,a,40x,a)') ' │','error', '│' - write(0,'(a,24x,i3,42x,a)') ' │',error_ID, '│' - write(0,'(a)') ' ├'//IO_DIVIDER//'┤' - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(msg))),',',& - max(1,72-len(trim(msg))-4),'x,a)' - write(0,formatString) '│ ',trim(msg), '│' - if (present(ext_msg)) then - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(ext_msg))),',',& - max(1,72-len(trim(ext_msg))-4),'x,a)' - write(0,formatString) '│ ',trim(ext_msg), '│' - endif - if (present(el)) & - write(0,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' - if (present(ip)) & - write(0,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│' - if (present(g)) & - write(0,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│' - if (present(instance)) & - write(0,'(a19,1x,i9,44x,a3)') ' │ at instance ',instance, '│' - write(0,'(a,69x,a)') ' │', '│' - write(0,'(a)') ' └'//IO_DIVIDER//'┘' - flush(0) - call quit(9000+error_ID) - !$OMP END CRITICAL (write2out) + end select + + !$OMP CRITICAL (write2out) + write(0,'(/,a)') ' ┌'//IO_DIVIDER//'┐' + write(0,'(a,24x,a,40x,a)') ' │','error', '│' + write(0,'(a,24x,i3,42x,a)') ' │',error_ID, '│' + write(0,'(a)') ' ├'//IO_DIVIDER//'┤' + write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(msg))),',',& + max(1,72-len(trim(msg))-4),'x,a)' + write(0,formatString) '│ ',trim(msg), '│' + if (present(ext_msg)) then + write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(ext_msg))),',',& + max(1,72-len(trim(ext_msg))-4),'x,a)' + write(0,formatString) '│ ',trim(ext_msg), '│' + endif + if (present(el)) & + write(0,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' + if (present(ip)) & + write(0,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│' + if (present(g)) & + write(0,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│' + if (present(instance)) & + write(0,'(a19,1x,i9,44x,a3)') ' │ at instance ',instance, '│' + write(0,'(a,69x,a)') ' │', '│' + write(0,'(a)') ' └'//IO_DIVIDER//'┘' + flush(0) + call quit(9000+error_ID) + !$OMP END CRITICAL (write2out) end subroutine IO_error @@ -869,83 +870,83 @@ end subroutine IO_error !-------------------------------------------------------------------------------------------------- subroutine IO_warning(warning_ID,el,ip,g,ext_msg) - integer, intent(in) :: warning_ID - integer, optional, intent(in) :: el,ip,g - character(len=*), optional, intent(in) :: ext_msg - - character(len=1024) :: msg - character(len=1024) :: formatString - - select case (warning_ID) - case (1) - msg = 'unknown key' - case (34) - msg = 'invalid restart increment given' - case (35) - msg = 'could not get $DAMASK_NUM_THREADS' - case (40) - msg = 'found spectral solver parameter' - case (42) - msg = 'parameter has no effect' - case (43) - msg = 'main diagonal of C66 close to zero' - case (47) - msg = 'no valid parameter for FFTW, using FFTW_PATIENT' - case (50) - msg = 'not all available slip system families are defined' - case (51) - msg = 'not all available twin system families are defined' - case (52) - msg = 'not all available parameters are defined' - case (53) - msg = 'not all available transformation system families are defined' - case (101) - msg = 'crystallite debugging off' - case (201) - msg = 'position not found when parsing line' - case (202) - msg = 'invalid character in string chunk' - case (203) - msg = 'interpretation of string chunk failed' - case (207) - msg = 'line truncated' - case (600) - msg = 'crystallite responds elastically' - case (601) - msg = 'stiffness close to zero' - case (650) - msg = 'polar decomposition failed' - case (700) - msg = 'unknown crystal symmetry' - case (850) - msg = 'max number of cut back exceeded, terminating' - case default - msg = 'unknown warning number' - end select - - !$OMP CRITICAL (write2out) - write(6,'(/,a)') ' ┌'//IO_DIVIDER//'┐' - write(6,'(a,24x,a,38x,a)') ' │','warning', '│' - write(6,'(a,24x,i3,42x,a)') ' │',warning_ID, '│' - write(6,'(a)') ' ├'//IO_DIVIDER//'┤' - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(msg))),',',& - max(1,72-len(trim(msg))-4),'x,a)' - write(6,formatString) '│ ',trim(msg), '│' - if (present(ext_msg)) then - write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(ext_msg))),',',& - max(1,72-len(trim(ext_msg))-4),'x,a)' - write(6,formatString) '│ ',trim(ext_msg), '│' - endif - if (present(el)) & - write(6,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' - if (present(ip)) & - write(6,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│' - if (present(g)) & - write(6,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│' - write(6,'(a,69x,a)') ' │', '│' - write(6,'(a)') ' └'//IO_DIVIDER//'┘' - flush(6) - !$OMP END CRITICAL (write2out) + integer, intent(in) :: warning_ID + integer, optional, intent(in) :: el,ip,g + character(len=*), optional, intent(in) :: ext_msg + + character(len=1024) :: msg + character(len=1024) :: formatString + + select case (warning_ID) + case (1) + msg = 'unknown key' + case (34) + msg = 'invalid restart increment given' + case (35) + msg = 'could not get $DAMASK_NUM_THREADS' + case (40) + msg = 'found spectral solver parameter' + case (42) + msg = 'parameter has no effect' + case (43) + msg = 'main diagonal of C66 close to zero' + case (47) + msg = 'no valid parameter for FFTW, using FFTW_PATIENT' + case (50) + msg = 'not all available slip system families are defined' + case (51) + msg = 'not all available twin system families are defined' + case (52) + msg = 'not all available parameters are defined' + case (53) + msg = 'not all available transformation system families are defined' + case (101) + msg = 'crystallite debugging off' + case (201) + msg = 'position not found when parsing line' + case (202) + msg = 'invalid character in string chunk' + case (203) + msg = 'interpretation of string chunk failed' + case (207) + msg = 'line truncated' + case (600) + msg = 'crystallite responds elastically' + case (601) + msg = 'stiffness close to zero' + case (650) + msg = 'polar decomposition failed' + case (700) + msg = 'unknown crystal symmetry' + case (850) + msg = 'max number of cut back exceeded, terminating' + case default + msg = 'unknown warning number' + end select + + !$OMP CRITICAL (write2out) + write(6,'(/,a)') ' ┌'//IO_DIVIDER//'┐' + write(6,'(a,24x,a,38x,a)') ' │','warning', '│' + write(6,'(a,24x,i3,42x,a)') ' │',warning_ID, '│' + write(6,'(a)') ' ├'//IO_DIVIDER//'┤' + write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(msg))),',',& + max(1,72-len(trim(msg))-4),'x,a)' + write(6,formatString) '│ ',trim(msg), '│' + if (present(ext_msg)) then + write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len(trim(ext_msg))),',',& + max(1,72-len(trim(ext_msg))-4),'x,a)' + write(6,formatString) '│ ',trim(ext_msg), '│' + endif + if (present(el)) & + write(6,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│' + if (present(ip)) & + write(6,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│' + if (present(g)) & + write(6,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│' + write(6,'(a,69x,a)') ' │', '│' + write(6,'(a)') ' └'//IO_DIVIDER//'┘' + flush(6) + !$OMP END CRITICAL (write2out) end subroutine IO_warning diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 42761f8df..eec8a1986 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -102,15 +102,15 @@ subroutine kinematics_cleavage_opening_init kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,p),& ! limit active cleavage systems per family to min of available and requested kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance)) - kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether - if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) & - call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') - if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) & - call IO_error(211,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') - if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) & - call IO_error(211,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') - if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) & - call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') + kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether + if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) & + call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') + if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) & + call IO_error(211,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') + if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) & + call IO_error(211,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') + if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) & + call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') enddo end subroutine kinematics_cleavage_opening_init diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index a8aaa0e82..c0f198985 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -5,40 +5,40 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module kinematics_slipplane_opening - use prec - use config - use IO - use debug - use math - use lattice - use material - - implicit none - private + use prec + use config + use IO + use debug + use math + use lattice + use material - integer, dimension(:), allocatable :: kinematics_slipplane_opening_instance - - type :: tParameters !< container type for internal constitutive parameters - integer :: & - totalNslip - integer, dimension(:), allocatable :: & - Nslip !< active number of slip systems per family - real(pReal) :: & - sdot0, & - n - real(pReal), dimension(:), allocatable :: & - critLoad - real(pReal), dimension(:,:), allocatable :: & - slip_direction, & - slip_normal, & - slip_transverse - end type tParameters - - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) + implicit none + private + + integer, dimension(:), allocatable :: kinematics_slipplane_opening_instance + + type :: tParameters !< container type for internal constitutive parameters + integer :: & + totalNslip + integer, dimension(:), allocatable :: & + Nslip !< active number of slip systems per family + real(pReal) :: & + sdot0, & + n + real(pReal), dimension(:), allocatable :: & + critLoad + real(pReal), dimension(:,:), allocatable :: & + slip_direction, & + slip_normal, & + slip_transverse + end type tParameters - public :: & - kinematics_slipplane_opening_init, & - kinematics_slipplane_opening_LiAndItsTangent + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) + + public :: & + kinematics_slipplane_opening_init, & + kinematics_slipplane_opening_LiAndItsTangent contains @@ -49,53 +49,53 @@ contains !-------------------------------------------------------------------------------------------------- subroutine kinematics_slipplane_opening_init - integer :: maxNinstance,p,instance + integer :: maxNinstance,p,instance - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' - maxNinstance = count(phase_kinematics == KINEMATICS_slipplane_opening_ID) - if (maxNinstance == 0) return - - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0) - do p = 1, size(config_phase) - kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_slipplane_opening_ID) ! ToDo: count correct? - enddo - - allocate(param(maxNinstance)) - - do p = 1, size(config_phase) - if (all(phase_kinematics(:,p) /= KINEMATICS_slipplane_opening_ID)) cycle - associate(prm => param(kinematics_slipplane_opening_instance(p)), & - config => config_phase(p)) - instance = kinematics_slipplane_opening_instance(p) - prm%sdot0 = config_phase(p)%getFloat('anisoductile_sdot0') - prm%n = config_phase(p)%getFloat('anisoductile_ratesensitivity') - - prm%Nslip = config%getInts('nslip') + maxNinstance = count(phase_kinematics == KINEMATICS_slipplane_opening_ID) + if (maxNinstance == 0) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0) + do p = 1, size(config_phase) + kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_slipplane_opening_ID) ! ToDo: count correct? + enddo + + allocate(param(maxNinstance)) + + do p = 1, size(config_phase) + if (all(phase_kinematics(:,p) /= KINEMATICS_slipplane_opening_ID)) cycle + associate(prm => param(kinematics_slipplane_opening_instance(p)), & + config => config_phase(p)) + instance = kinematics_slipplane_opening_instance(p) + prm%sdot0 = config_phase(p)%getFloat('anisoductile_sdot0') + prm%n = config_phase(p)%getFloat('anisoductile_ratesensitivity') + + prm%Nslip = config%getInts('nslip') - prm%critLoad = config_phase(p)%getFloats('anisoductile_criticalload',requiredSize=size(prm%Nslip )) + prm%critLoad = config_phase(p)%getFloats('anisoductile_criticalload',requiredSize=size(prm%Nslip )) - prm%critLoad = math_expand(prm%critLoad, prm%Nslip) - - prm%slip_direction = lattice_slip_direction (prm%Nslip,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%slip_normal = lattice_slip_normal (prm%Nslip,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%slip_transverse = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%critLoad = math_expand(prm%critLoad, prm%Nslip) + + prm%slip_direction = lattice_slip_direction (prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%slip_normal = lattice_slip_normal (prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%slip_transverse = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) - ! if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) & - ! call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')') - ! if (any(kinematics_slipplane_opening_critPlasticStrain(:,instance) < 0.0_pReal)) & - ! call IO_error(211,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')') - ! if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) & - ! call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')') - - end associate - enddo + ! if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) & + ! call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')') + ! if (any(kinematics_slipplane_opening_critPlasticStrain(:,instance) < 0.0_pReal)) & + ! call IO_error(211,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')') + ! if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) & + ! call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')') + + end associate + enddo end subroutine kinematics_slipplane_opening_init @@ -104,84 +104,84 @@ end subroutine kinematics_slipplane_opening_init !-------------------------------------------------------------------------------------------------- subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) - integer, intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(in), dimension(3,3) :: & - S - real(pReal), intent(out), dimension(3,3) :: & - Ld !< damage velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) - real(pReal), dimension(3,3) :: & - projection_d, projection_t, projection_n !< projection modes 3x3 tensor - integer :: & - instance, phase, & - homog, damageOffset, & - i, k, l, m, n - real(pReal) :: & - traction_d, traction_t, traction_n, traction_crit, & - udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt - - phase = material_phaseAt(ipc,el) - instance = kinematics_slipplane_opening_instance(phase) - homog = material_homogenizationAt(el) - damageOffset = damageMapping(homog)%p(ip,el) - - associate(prm => param(instance)) - Ld = 0.0_pReal - dLd_dTstar = 0.0_pReal - do i = 1, prm%totalNslip - - projection_d = math_outer(prm%slip_direction(1:3,i),prm%slip_normal(1:3,i)) - projection_t = math_outer(prm%slip_transverse(1:3,i),prm%slip_normal(1:3,i)) - projection_n = math_outer(prm%slip_normal(1:3,i),prm%slip_normal(1:3,i)) - - traction_d = math_mul33xx33(S,projection_d) - traction_t = math_mul33xx33(S,projection_t) - traction_n = math_mul33xx33(S,projection_n) - - traction_crit = prm%critLoad(i)* damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage - - udotd = sign(1.0_pReal,traction_d)* & - prm%sdot0* & - (abs(traction_d)/traction_crit - & - abs(traction_d)/prm%critLoad(i))**prm%n - if (abs(udotd) > tol_math_check) then - Ld = Ld + udotd*projection_d - dudotd_dt = udotd*prm%n/traction_d - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & - dudotd_dt*projection_d(k,l)*projection_d(m,n) - endif - - udott = sign(1.0_pReal,traction_t)* & - prm%sdot0* & - (abs(traction_t)/traction_crit - & - abs(traction_t)/prm%critLoad(i))**prm%n - if (abs(udott) > tol_math_check) then - Ld = Ld + udott*projection_t - dudott_dt = udott*prm%n/traction_t - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & - dudott_dt*projection_t(k,l)*projection_t(m,n) - endif - - udotn = & - prm%sdot0* & - (max(0.0_pReal,traction_n)/traction_crit - & - max(0.0_pReal,traction_n)/prm%critLoad(i))**prm%n - if (abs(udotn) > tol_math_check) then - Ld = Ld + udotn*projection_n - dudotn_dt = udotn*prm%n/traction_n - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & - dudotn_dt*projection_n(k,l)*projection_n(m,n) - endif - enddo + integer, intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(in), dimension(3,3) :: & + S + real(pReal), intent(out), dimension(3,3) :: & + Ld !< damage velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) + real(pReal), dimension(3,3) :: & + projection_d, projection_t, projection_n !< projection modes 3x3 tensor + integer :: & + instance, phase, & + homog, damageOffset, & + i, k, l, m, n + real(pReal) :: & + traction_d, traction_t, traction_n, traction_crit, & + udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt + + phase = material_phaseAt(ipc,el) + instance = kinematics_slipplane_opening_instance(phase) + homog = material_homogenizationAt(el) + damageOffset = damageMapping(homog)%p(ip,el) -end associate + associate(prm => param(instance)) + Ld = 0.0_pReal + dLd_dTstar = 0.0_pReal + do i = 1, prm%totalNslip + + projection_d = math_outer(prm%slip_direction(1:3,i),prm%slip_normal(1:3,i)) + projection_t = math_outer(prm%slip_transverse(1:3,i),prm%slip_normal(1:3,i)) + projection_n = math_outer(prm%slip_normal(1:3,i),prm%slip_normal(1:3,i)) + + traction_d = math_mul33xx33(S,projection_d) + traction_t = math_mul33xx33(S,projection_t) + traction_n = math_mul33xx33(S,projection_n) + + traction_crit = prm%critLoad(i)* damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage + + udotd = sign(1.0_pReal,traction_d)* & + prm%sdot0* & + (abs(traction_d)/traction_crit - & + abs(traction_d)/prm%critLoad(i))**prm%n + if (abs(udotd) > tol_math_check) then + Ld = Ld + udotd*projection_d + dudotd_dt = udotd*prm%n/traction_d + forall (k=1:3,l=1:3,m=1:3,n=1:3) & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & + dudotd_dt*projection_d(k,l)*projection_d(m,n) + endif + + udott = sign(1.0_pReal,traction_t)* & + prm%sdot0* & + (abs(traction_t)/traction_crit - & + abs(traction_t)/prm%critLoad(i))**prm%n + if (abs(udott) > tol_math_check) then + Ld = Ld + udott*projection_t + dudott_dt = udott*prm%n/traction_t + forall (k=1:3,l=1:3,m=1:3,n=1:3) & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & + dudott_dt*projection_t(k,l)*projection_t(m,n) + endif + + udotn = & + prm%sdot0* & + (max(0.0_pReal,traction_n)/traction_crit - & + max(0.0_pReal,traction_n)/prm%critLoad(i))**prm%n + if (abs(udotn) > tol_math_check) then + Ld = Ld + udotn*projection_n + dudotn_dt = udotn*prm%n/traction_n + forall (k=1:3,l=1:3,m=1:3,n=1:3) & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & + dudotn_dt*projection_n(k,l)*projection_n(m,n) + endif + enddo + + end associate end subroutine kinematics_slipplane_opening_LiAndItsTangent diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 4294321a5..814d604ed 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -84,11 +84,11 @@ pure function kinematics_thermal_expansion_initialStrain(homog,phase,offset) kinematics_thermal_expansion_initialStrain = & (temperature(homog)%p(offset) - lattice_referenceTemperature(phase))**1 / 1. * & - lattice_thermalExpansion33(1:3,1:3,1,phase) + & ! constant coefficient + lattice_thermalExpansion33(1:3,1:3,1,phase) + & ! constant coefficient (temperature(homog)%p(offset) - lattice_referenceTemperature(phase))**2 / 2. * & - lattice_thermalExpansion33(1:3,1:3,2,phase) + & ! linear coefficient + lattice_thermalExpansion33(1:3,1:3,2,phase) + & ! linear coefficient (temperature(homog)%p(offset) - lattice_referenceTemperature(phase))**3 / 3. * & - lattice_thermalExpansion33(1:3,1:3,3,phase) ! quadratic coefficient + lattice_thermalExpansion33(1:3,1:3,3,phase) ! quadratic coefficient end function kinematics_thermal_expansion_initialStrain @@ -99,13 +99,13 @@ end function kinematics_thermal_expansion_initialStrain subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el) integer, intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number + ipc, & !< grain number + ip, & !< integration point number + el !< element number real(pReal), intent(out), dimension(3,3) :: & - Li !< thermal velocity gradient + Li !< thermal velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & - dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero) + dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero) integer :: & phase, & homog, offset @@ -120,9 +120,9 @@ subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, TRef = lattice_referenceTemperature(phase) Li = TDot * ( & - lattice_thermalExpansion33(1:3,1:3,1,phase)*(T - TRef)**0 & ! constant coefficient - + lattice_thermalExpansion33(1:3,1:3,2,phase)*(T - TRef)**1 & ! linear coefficient - + lattice_thermalExpansion33(1:3,1:3,3,phase)*(T - TRef)**2 & ! quadratic coefficient + lattice_thermalExpansion33(1:3,1:3,1,phase)*(T - TRef)**0 & ! constant coefficient + + lattice_thermalExpansion33(1:3,1:3,2,phase)*(T - TRef)**1 & ! linear coefficient + + lattice_thermalExpansion33(1:3,1:3,3,phase)*(T - TRef)**2 & ! quadratic coefficient ) / & (1.0_pReal & + lattice_thermalExpansion33(1:3,1:3,1,phase)*(T - TRef)**1 / 1. & diff --git a/src/material.f90 b/src/material.f90 index 4163812ee..636d7193d 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -774,41 +774,41 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,& sizeState,sizeDotState,sizeDeltaState,& Nslip,Ntwin,Ntrans) - integer, intent(in) :: & - phase, & - NofMyPhase, & - sizeState, & - sizeDotState, & - sizeDeltaState, & - Nslip, & - Ntwin, & - Ntrans + integer, intent(in) :: & + phase, & + NofMyPhase, & + sizeState, & + sizeDotState, & + sizeDeltaState, & + Nslip, & + Ntwin, & + Ntrans - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition - plasticState(phase)%Nslip = Nslip - plasticState(phase)%Ntwin = Ntwin - plasticState(phase)%Ntrans= Ntrans + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition + plasticState(phase)%Nslip = Nslip + plasticState(phase)%Ntwin = Ntwin + plasticState(phase)%Ntrans= Ntrans - allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal) - allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%aTolState (sizeState), source=0.0_pReal) + allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 1) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (numerics_integrator == 4) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 5) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (numerics_integrator == 1) then + allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (numerics_integrator == 4) & + allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (numerics_integrator == 5) & + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) end subroutine material_allocatePlasticState @@ -819,34 +819,34 @@ end subroutine material_allocatePlasticState subroutine material_allocateSourceState(phase,of,NofMyPhase,& sizeState,sizeDotState,sizeDeltaState) - integer, intent(in) :: & - phase, & - of, & - NofMyPhase, & - sizeState, sizeDotState,sizeDeltaState - - sourceState(phase)%p(of)%sizeState = sizeState - sourceState(phase)%p(of)%sizeDotState = sizeDotState - sourceState(phase)%p(of)%sizeDeltaState = sizeDeltaState - sourceState(phase)%p(of)%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition - - allocate(sourceState(phase)%p(of)%aTolState (sizeState), source=0.0_pReal) - allocate(sourceState(phase)%p(of)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(of)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(of)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(of)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(of)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 1) then - allocate(sourceState(phase)%p(of)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(of)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (numerics_integrator == 4) & - allocate(sourceState(phase)%p(of)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (numerics_integrator == 5) & - allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(of)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) + integer, intent(in) :: & + phase, & + of, & + NofMyPhase, & + sizeState, sizeDotState,sizeDeltaState + + sourceState(phase)%p(of)%sizeState = sizeState + sourceState(phase)%p(of)%sizeDotState = sizeDotState + sourceState(phase)%p(of)%sizeDeltaState = sizeDeltaState + sourceState(phase)%p(of)%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition + + allocate(sourceState(phase)%p(of)%aTolState (sizeState), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%state0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%state (sizeState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(of)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (numerics_integrator == 1) then + allocate(sourceState(phase)%p(of)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) + allocate(sourceState(phase)%p(of)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) + endif + if (numerics_integrator == 4) & + allocate(sourceState(phase)%p(of)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) + if (numerics_integrator == 5) & + allocate(sourceState(phase)%p(of)%RKCK45dotState (6,sizeDotState,NofMyPhase), source=0.0_pReal) + + allocate(sourceState(phase)%p(of)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) end subroutine material_allocateSourceState diff --git a/src/quit.f90 b/src/quit.f90 index 63184c113..5f492de36 100644 --- a/src/quit.f90 +++ b/src/quit.f90 @@ -7,43 +7,42 @@ !-------------------------------------------------------------------------------------------------- subroutine quit(stop_id) #include + use PetscSys #ifdef _OPENMP - use MPI, only: & - MPI_finalize + use MPI #endif - use PetscSys - use hdf5 + use hdf5 - implicit none - integer, intent(in) :: stop_id - integer, dimension(8) :: dateAndTime ! type default integer - integer :: error - PetscErrorCode :: ierr = 0 - - call h5open_f(error) - if (error /= 0) write(6,'(a,i5)') ' Error in h5open_f ',error ! prevents error if not opened yet - call h5close_f(error) - if (error /= 0) write(6,'(a,i5)') ' Error in h5close_f ',error - - call PETScFinalize(ierr) - CHKERRQ(ierr) - -#ifdef _OPENMP - call MPI_finalize(error) - if (error /= 0) write(6,'(a,i5)') ' Error in MPI_finalize',error -#endif + implicit none + integer, intent(in) :: stop_id + integer, dimension(8) :: dateAndTime + integer :: error + PetscErrorCode :: ierr = 0 - call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' DAMASK terminated on:' - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - - if (stop_id == 0 .and. ierr == 0 .and. error == 0) stop 0 ! normal termination - if (stop_id == 2 .and. ierr == 0 .and. error == 0) stop 2 ! not all incs converged - stop 1 ! error (message from IO_error) + call h5open_f(error) + if (error /= 0) write(6,'(a,i5)') ' Error in h5open_f ',error ! prevents error if not opened yet + call h5close_f(error) + if (error /= 0) write(6,'(a,i5)') ' Error in h5close_f ',error + + call PETScFinalize(ierr) + CHKERRQ(ierr) + +#ifdef _OPENMP + call MPI_finalize(error) + if (error /= 0) write(6,'(a,i5)') ' Error in MPI_finalize',error +#endif + + call date_and_time(values = dateAndTime) + write(6,'(/,a)') ' DAMASK terminated on:' + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& + dateAndTime(2),'/',& + dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& + dateAndTime(6),':',& + dateAndTime(7) + + if (stop_id == 0 .and. ierr == 0 .and. error == 0) stop 0 ! normal termination + if (stop_id == 2 .and. ierr == 0 .and. error == 0) stop 2 ! not all incs converged + stop 1 ! error (message from IO_error) end subroutine quit From e30478127d5d0995b1ce27143b0b5a811a804ab8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 20:42:16 +0200 Subject: [PATCH 31/49] cleaned --- src/math.f90 | 2 +- src/mesh_marc.f90 | 78 +++++++++++++++++++++++------------------------ 2 files changed, 40 insertions(+), 40 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 324a629b2..6bdc78b9c 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -179,7 +179,7 @@ recursive subroutine math_sort(a, istart, iend, sortDim) e = ubound(a,2) endif - if(present(sortDim)) then + if(present(sortDim)) then d = sortDim else d = 1 diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 4a821eeba..3464f616e 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -497,7 +497,7 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileF mesh_mapFEtoCPelem(2,cpElem) = cpElem enddo -call math_sort(mesh_mapFEtoCPelem,1,size(mesh_mapFEtoCPelem,2)) +call math_sort(mesh_mapFEtoCPelem) end subroutine mesh_marc_map_elements @@ -532,7 +532,7 @@ subroutine mesh_marc_map_nodes(nNodes,fileUnit) endif enddo -620 call math_sort(mesh_mapFEtoCPnode,1,size(mesh_mapFEtoCPnode,2)) +620 call math_sort(mesh_mapFEtoCPnode) end subroutine mesh_marc_map_nodes @@ -1262,43 +1262,43 @@ end subroutine mesh_build_ipAreas !-------------------------------------------------------------------------------------------------- integer function mesh_FEasCP(what,myID) - character(len=*), intent(in) :: what - integer, intent(in) :: myID - - integer, dimension(:,:), pointer :: lookupMap - integer :: lower,upper,center - - mesh_FEasCP = 0 - select case(IO_lc(what(1:4))) - case('elem') - lookupMap => mesh_mapFEtoCPelem - case('node') - lookupMap => mesh_mapFEtoCPnode - case default - return - endselect - - lower = 1 - upper = int(size(lookupMap,2),pInt) - - if (lookupMap(1,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? - mesh_FEasCP = lookupMap(2,lower) - return - elseif (lookupMap(1,upper) == myID) then - mesh_FEasCP = lookupMap(2,upper) - return - endif - binarySearch: do while (upper-lower > 1) - center = (lower+upper)/2 - if (lookupMap(1,center) < myID) then - lower = center - elseif (lookupMap(1,center) > myID) then - upper = center - else - mesh_FEasCP = lookupMap(2,center) - exit - endif - enddo binarySearch + character(len=*), intent(in) :: what + integer, intent(in) :: myID + + integer, dimension(:,:), pointer :: lookupMap + integer :: lower,upper,center + + mesh_FEasCP = 0 + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1 + upper = int(size(lookupMap,2),pInt) + + if (lookupMap(1,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2,lower) + return + elseif (lookupMap(1,upper) == myID) then + mesh_FEasCP = lookupMap(2,upper) + return + endif + binarySearch: do while (upper-lower > 1) + center = (lower+upper)/2 + if (lookupMap(1,center) < myID) then + lower = center + elseif (lookupMap(1,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2,center) + exit + endif + enddo binarySearch end function mesh_FEasCP From 43a17a17a25027cab3e1c9ebda7034964f0919b9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 20:49:48 +0200 Subject: [PATCH 32/49] clearer logic, no outdated comments --- src/mesh_FEM.f90 | 130 ++++++++++++++++++++++------------------------- 1 file changed, 60 insertions(+), 70 deletions(-) diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index cd3fbd897..2fd63c0b3 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -8,11 +8,10 @@ module mesh #include #include #include - use prec - use mesh_base use PETScdmplex use PETScdmda use PETScis + use DAMASK_interface use IO use debug @@ -20,6 +19,8 @@ module mesh use numerics use FEsolving use FEM_Zoo + use prec + use mesh_base implicit none private @@ -35,13 +36,13 @@ module mesh mesh_maxNips !< max number of IPs in any CP element !!!! BEGIN DEPRECATED !!!!! - integer, dimension(:,:), allocatable, public, protected :: & + integer, dimension(:,:), allocatable :: & mesh_element !DEPRECATED - real(pReal), dimension(:,:), allocatable, public :: & + real(pReal), dimension(:,:), allocatable :: & mesh_node !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) - real(pReal), dimension(:,:), allocatable, public, protected :: & + real(pReal), dimension(:,:), allocatable :: & mesh_ipVolume, & !< volume associated with IP (initially!) mesh_node0 !< node x,y,z coordinates (initially!) @@ -176,15 +177,13 @@ subroutine mesh_init endif enddo close (FILEUNIT) - endif - - if (worldsize > 1) then - call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr) - CHKERRQ(ierr) - else call DMClone(globalMesh,geomMesh,ierr) CHKERRQ(ierr) + else + call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr) + CHKERRQ(ierr) endif + call DMDestroy(globalMesh,ierr); CHKERRQ(ierr) call DMGetStratumSize(geomMesh,'depth',dimPlex,mesh_NcpElems,ierr) @@ -255,75 +254,66 @@ end function mesh_cellCenterCoordinates !-------------------------------------------------------------------------------------------------- subroutine mesh_FEM_build_ipVolumes(dimPlex) - PetscInt :: dimPlex - PetscReal :: vol - PetscReal, target :: cent(dimPlex), norm(dimPlex) - PetscReal, pointer :: pCent(:), pNorm(:) - PetscInt :: cellStart, cellEnd, cell - PetscErrorCode :: ierr - - if (.not. allocated(mesh_ipVolume)) then - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) - mesh_ipVolume = 0.0_pReal - endif - - call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) - pCent => cent - pNorm => norm - do cell = cellStart, cellEnd-1 - call DMPlexComputeCellGeometryFVM(geomMesh,cell,vol,pCent,pNorm,ierr) - CHKERRQ(ierr) - mesh_ipVolume(:,cell+1) = vol/real(mesh_maxNips,pReal) - enddo + PetscInt :: dimPlex + PetscReal :: vol + PetscReal, target :: cent(dimPlex), norm(dimPlex) + PetscReal, pointer :: pCent(:), pNorm(:) + PetscInt :: cellStart, cellEnd, cell + PetscErrorCode :: ierr + + if (.not. allocated(mesh_ipVolume)) then + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) + mesh_ipVolume = 0.0_pReal + endif + + call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + pCent => cent + pNorm => norm + do cell = cellStart, cellEnd-1 + call DMPlexComputeCellGeometryFVM(geomMesh,cell,vol,pCent,pNorm,ierr) + CHKERRQ(ierr) + mesh_ipVolume(:,cell+1) = vol/real(mesh_maxNips,pReal) + enddo end subroutine mesh_FEM_build_ipVolumes !-------------------------------------------------------------------------------------------------- !> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' -! Called by all solvers in mesh_init in order to initialize the ip coordinates. -! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, -! so no need to use this subroutine anymore; Marc however only provides nodal displacements, -! so in this case the ip coordinates are always calculated on the basis of this subroutine. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, -! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. -! HAS TO BE CHANGED IN A LATER VERSION. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !-------------------------------------------------------------------------------------------------- subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints) - PetscInt, intent(in) :: dimPlex - PetscReal, intent(in) :: qPoints(mesh_maxNips*dimPlex) + PetscInt, intent(in) :: dimPlex + PetscReal, intent(in) :: qPoints(mesh_maxNips*dimPlex) + + PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), invcellJ(dimPlex*dimPlex) + PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) + PetscReal :: detJ + PetscInt :: cellStart, cellEnd, cell, qPt, dirI, dirJ, qOffset + PetscErrorCode :: ierr - PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), invcellJ(dimPlex*dimPlex) - PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) - PetscReal :: detJ - PetscInt :: cellStart, cellEnd, cell, qPt, dirI, dirJ, qOffset - PetscErrorCode :: ierr - - - allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) - - pV0 => v0 - pCellJ => cellJ - pInvcellJ => invcellJ - call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) - do cell = cellStart, cellEnd-1 !< loop over all elements - call DMPlexComputeCellGeometryAffineFEM(geomMesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) - CHKERRQ(ierr) - qOffset = 0 - do qPt = 1, mesh_maxNips - do dirI = 1, dimPlex - mesh_ipCoordinates(dirI,qPt,cell+1) = pV0(dirI) - do dirJ = 1, dimPlex - mesh_ipCoordinates(dirI,qPt,cell+1) = mesh_ipCoordinates(dirI,qPt,cell+1) + & - pCellJ((dirI-1)*dimPlex+dirJ)*(qPoints(qOffset+dirJ) + 1.0) - enddo - enddo - qOffset = qOffset + dimPlex - enddo - enddo + + allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + + pV0 => v0 + pCellJ => cellJ + pInvcellJ => invcellJ + call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexComputeCellGeometryAffineFEM(geomMesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + qOffset = 0 + do qPt = 1, mesh_maxNips + do dirI = 1, dimPlex + mesh_ipCoordinates(dirI,qPt,cell+1) = pV0(dirI) + do dirJ = 1, dimPlex + mesh_ipCoordinates(dirI,qPt,cell+1) = mesh_ipCoordinates(dirI,qPt,cell+1) + & + pCellJ((dirI-1)*dimPlex+dirJ)*(qPoints(qOffset+dirJ) + 1.0) + enddo + enddo + qOffset = qOffset + dimPlex + enddo + enddo end subroutine mesh_FEM_build_ipCoordinates From 860a6d5d499b80958a95e09f87b36805bb087c2e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 15 Jun 2019 22:37:31 +0200 Subject: [PATCH 33/49] copy and paste error --- src/FEsolving.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 index 98bab4569..63026b3a6 100644 --- a/src/FEsolving.f90 +++ b/src/FEsolving.f90 @@ -26,7 +26,7 @@ module FEsolving #if defined(Marc4DAMASK) || defined(Abaqus) logical, public, protected :: & - symmetricSolver = .false., & !< use a symmetric FEM solver + symmetricSolver = .false. !< use a symmetric FEM solver (only Abaqus) character(len=1024), public :: & modelName !< needs description logical, dimension(:,:), allocatable, public :: & From 02744406e8b589c2686b86e3799bf42f8f015e23 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 16 Jun 2019 02:11:09 +0200 Subject: [PATCH 34/49] was not used --- src/element.f90 | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/src/element.f90 b/src/element.f90 index 8da633082..d62b4fd93 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -137,21 +137,6 @@ module element 4 & ! 3D 8node ] !< number of cell nodes in a specific cell type - !integer, dimension(maxval(geomType)), parameter, private :: maxNodeAtIP = & ! Intel 16.0 complains - integer, dimension(10), parameter, private :: maxNnodeAtIP = & - [ & - 3, & - 1, & - 1, & - 2, & - 4, & - 1, & - 1, & - 8, & - 1, & - 4 & - ] !< maximum number of parent nodes that belong to an IP for a specific type of element - !integer, dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELL = & ! Intel 16.0 complains integer, dimension(4), parameter, private :: NCELLNODEPERCELL = & [ & From b7ac91480a4134a319449f21f901cd55c4b36053 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 28 Jun 2019 16:35:31 -0700 Subject: [PATCH 35/49] safe for DEBUG=ON and N_tr=N_tw=0 --- src/plastic_dislotwin.f90 | 37 +++++++++++++++++-------------------- 1 file changed, 17 insertions(+), 20 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index f6696cdcc..c8d2e4802 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -16,9 +16,7 @@ module plastic_dislotwin use config use lattice use discretization -#if defined(PETSc) || defined(DAMASK_HDF5) use results -#endif implicit none private @@ -340,14 +338,15 @@ subroutine plastic_dislotwin_init prm%r = math_expand(prm%r,prm%N_tw) else - allocate(prm%t_tw(0)) - allocate(prm%b_tw(0)) - allocate(prm%r(0)) + allocate(prm%t_tw (0)) + allocate(prm%b_tw (0)) + allocate(prm%r (0)) + allocate(prm%h_tw_tw(0,0)) endif !-------------------------------------------------------------------------------------------------- ! transformation related parameters - prm%N_tr = config%getInts('ntrans', defaultVal=emptyIntArray) + prm%N_tr = config%getInts('ntrans', defaultVal=emptyIntArray) prm%sum_N_tr = sum(prm%N_tr) if (prm%sum_N_tr > 0) then prm%b_tr = config%getFloats('transburgers') @@ -384,8 +383,10 @@ subroutine plastic_dislotwin_init prm%s = config%getFloats('s_trans',defaultVal=[0.0_pReal]) prm%s = math_expand(prm%s,prm%N_tr) else - allocate(prm%t_tr(0)) - allocate(prm%b_tr(0)) + allocate(prm%t_tr (0)) + allocate(prm%b_tr (0)) + allocate(prm%s (0)) + allocate(prm%h_tr_tr(0,0)) endif if (sum(prm%N_tw) > 0 .or. prm%sum_N_tr > 0) then @@ -826,18 +827,17 @@ subroutine plastic_dislotwin_dependentState(T,instance,of) real(pReal) :: & sumf_twin,SFE,sumf_trans real(pReal), dimension(param(instance)%sum_N_sl) :: & - inv_lambda_sl_sl, & !< 1/mean free distance between 2 forest dislocations seen by a moving dislocation - inv_lambda_sl_tw, & !< 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation - inv_lambda_sl_tr !< 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation + inv_lambda_sl_sl, & !< 1/mean free distance between 2 forest dislocations seen by a moving dislocation + inv_lambda_sl_tw, & !< 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation + inv_lambda_sl_tr !< 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation real(pReal), dimension(param(instance)%sum_N_tw) :: & - inv_lambda_tw_tw !< 1/mean free distance between 2 twin stacks from different systems seen by a growing twin + inv_lambda_tw_tw, & !< 1/mean free distance between 2 twin stacks from different systems seen by a growing twin + f_over_t_tw real(pReal), dimension(param(instance)%sum_N_tr) :: & - inv_lambda_tr_tr !< 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite - - real(pReal), dimension(:), allocatable :: & - x0, & - f_over_t_tw, & + inv_lambda_tr_tr, & !< 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite f_over_t_tr + real(pReal), dimension(:), allocatable :: & + x0 associate(prm => param(instance),& @@ -866,7 +866,6 @@ subroutine plastic_dislotwin_dependentState(T,instance,of) - !ToDo: needed? if (prm%sum_N_tw > 0) & inv_lambda_tw_tw = matmul(prm%h_tw_tw,f_over_t_tw)/(1.0_pReal-sumf_twin) @@ -875,7 +874,6 @@ subroutine plastic_dislotwin_dependentState(T,instance,of) inv_lambda_sl_tr = matmul(prm%h_sl_tr,f_over_t_tr)/(1.0_pReal-sumf_trans) - !ToDo: needed? if (prm%sum_N_tr > 0) & inv_lambda_tr_tr = matmul(prm%h_tr_tr,f_over_t_tr)/(1.0_pReal-sumf_trans) @@ -1224,7 +1222,6 @@ pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& ddot_gamma_dtau integer :: i,s1,s2 - associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) do i = 1, prm%sum_N_tr From 1d2a7d09172cc3c6f8e2c8645286f26d36676bcb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 28 Jun 2019 16:51:03 -0700 Subject: [PATCH 36/49] fixed copy and paste errors --- src/plastic_dislotwin.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index c8d2e4802..67faf8611 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -277,7 +277,7 @@ subroutine plastic_dislotwin_init prm%rho_mob_0 = math_expand(prm%rho_mob_0, prm%N_sl) prm%rho_dip_0 = math_expand(prm%rho_dip_0, prm%N_sl) prm%v0 = math_expand(prm%v0, prm%N_sl) - prm%b_sl = math_expand(prm%b_sl,prm%N_sl) + prm%b_sl = math_expand(prm%b_sl, prm%N_sl) prm%Delta_F = math_expand(prm%Delta_F, prm%N_sl) prm%CLambdaSlip = math_expand(prm%CLambdaSlip, prm%N_sl) prm%p = math_expand(prm%p, prm%N_sl) @@ -804,7 +804,7 @@ subroutine plastic_dislotwin_dotState(Mp,T,instance,of) dot%f_tw(:,of) = f_unrotated*dot_gamma_twin/prm%gamma_char call kinetics_trans(Mp,T,dot_gamma_sl,instance,of,dot_gamma_tr) - dot%f_tw(:,of) = f_unrotated*dot_gamma_tr + dot%f_tr(:,of) = f_unrotated*dot_gamma_tr end associate @@ -1246,7 +1246,7 @@ pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& significantStress: where(tau > tol_math_check) StressRatio_s = (dst%tau_hat_tr(:,of)/tau)**prm%s dot_gamma_tr = dst%f_tr(:,of) * Ndot0*exp(-StressRatio_s) - ddot_gamma_dtau = (dot_gamma_tr*prm%r/tau)*StressRatio_s + ddot_gamma_dtau = (dot_gamma_tr*prm%s/tau)*StressRatio_s else where significantStress dot_gamma_tr = 0.0_pReal ddot_gamma_dtau = 0.0_pReal From a88baf93b21dc8e6530fe024b4643e4ca2d971ec Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 28 Jun 2019 17:09:27 -0700 Subject: [PATCH 37/49] avoid division (mod) by zero --- src/grid/DAMASK_grid.f90 | 6 ++---- src/grid/spectral_utilities.f90 | 2 +- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index a55cbbe17..5d78f8f13 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -217,8 +217,7 @@ program DAMASK_spectral case('freq','frequency','outputfreq') ! frequency of result writings newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1) case('r','restart','restartwrite') ! frequency of writing restart information - newLoadCase%restartfrequency = & - max(0,IO_intValue(line,chunkPos,i+1)) + newLoadCase%restartfrequency = IO_intValue(line,chunkPos,i+1) case('guessreset','dropguessing') newLoadCase%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory case('euler') ! rotation of load case given in euler angles @@ -561,8 +560,7 @@ program DAMASK_spectral fileOffset = fileOffset + sum(outputSize) ! forward to current file position call CPFEM_results(totalIncsCounter,time) endif - if ( loadCases(currentLoadCase)%restartFrequency > 0 & ! writing of restart info requested ... - .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0) then ! ... and at frequency of writing restart information + if (mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0) then ! at frequency of writing restart information restartWrite = .true. ! set restart parameter for FEsolving lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write? endif diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 509ec9e77..7b468b4f4 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -98,7 +98,7 @@ module spectral_utilities real(pReal) :: time = 0.0_pReal !< length of increment integer :: incs = 0, & !< number of increments outputfrequency = 1, & !< frequency of result writes - restartfrequency = 0, & !< frequency of restart writes + restartfrequency = huge(0), & !< frequency of restart writes logscale = 0 !< linear/logarithmic time inc flag logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase integer(kind(FIELD_UNDEFINED_ID)), allocatable :: ID(:) From 4b10522bee228df137d606a3b7271af26137837b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 28 Jun 2019 17:52:38 -0700 Subject: [PATCH 38/49] catch user inputs that result in division by zero --- src/grid/DAMASK_grid.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 5d78f8f13..5beab767d 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -299,6 +299,7 @@ program DAMASK_spectral write(6,'(2x,a,i5)') 'increments: ', newLoadCase%incs if (newLoadCase%outputfrequency < 1) errorID = 836 ! non-positive result frequency write(6,'(2x,a,i5)') 'output frequency: ', newLoadCase%outputfrequency + if (newLoadCase%restartfrequency < 1) errorID = 836 ! non-positive restart frequency write(6,'(2x,a,i5)') 'restart frequency: ', newLoadCase%restartfrequency if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message endif reportAndCheck From c6c1d2ab8dab1022fa1c2f5db5829803bcefa5d9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 29 Jun 2019 10:01:18 -0700 Subject: [PATCH 39/49] polishing --- src/plastic_dislotwin.f90 | 36 +++++++++++++++--------------------- 1 file changed, 15 insertions(+), 21 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 67faf8611..9079a07de 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -72,7 +72,7 @@ module plastic_dislotwin aTol_rho, & !< absolute tolerance for integration of dislocation density aTol_f_tw, & !< absolute tolerance for integration of twin volume fraction aTol_f_tr, & !< absolute tolerance for integration of trans volume fraction - gamma_fcc_hex, & !< Free energy difference between austensite and martensite + gamma_fcc_hex, & !< Free energy difference between austensite and martensite i_tr, & !< h !< Stack height of hex nucleus real(pReal), dimension(:), allocatable :: & @@ -88,7 +88,7 @@ module plastic_dislotwin t_tw, & !< twin thickness [m] for each twin system CLambdaSlip, & !< Adj. parameter for distance between 2 forest dislocations for each slip system atomicVolume, & - t_tr, & !< martensite lamellar thickness [m] for each trans system and instance + t_tr, & !< martensite lamellar thickness [m] for each trans system and instance p, & !< p-exponent in glide velocity q, & !< q-exponent in glide velocity r, & !< r-exponent in twin nucleation rate @@ -864,28 +864,22 @@ subroutine plastic_dislotwin_dependentState(T,instance,of) if (prm%sum_N_tw > 0 .and. prm%sum_N_sl > 0) & inv_lambda_sl_tw = matmul(prm%h_sl_tw,f_over_t_tw)/(1.0_pReal-sumf_twin) - - inv_lambda_tw_tw = matmul(prm%h_tw_tw,f_over_t_tw)/(1.0_pReal-sumf_twin) - - if (prm%sum_N_tr > 0 .and. prm%sum_N_sl > 0) & inv_lambda_sl_tr = matmul(prm%h_sl_tr,f_over_t_tr)/(1.0_pReal-sumf_trans) - inv_lambda_tr_tr = matmul(prm%h_tr_tr,f_over_t_tr)/(1.0_pReal-sumf_trans) - if ((prm%sum_N_tw > 0) .or. (prm%sum_N_tr > 0)) then ! ToDo: Change order - dst%Lambda_sl(:,of) = & - prm%D/(1.0_pReal+prm%D*& - (inv_lambda_sl_sl + inv_lambda_sl_tw + inv_lambda_sl_tr)) - else - dst%Lambda_sl(:,of) = prm%D & - / (1.0_pReal+prm%D*inv_lambda_sl_sl) !!!!!! correct? - endif + if ((prm%sum_N_tw > 0) .or. (prm%sum_N_tr > 0)) then ! ToDo: better logic needed here + dst%Lambda_sl(:,of) = prm%D & + / (1.0_pReal+prm%D*(inv_lambda_sl_sl + inv_lambda_sl_tw + inv_lambda_sl_tr)) + else + dst%Lambda_sl(:,of) = prm%D & + / (1.0_pReal+prm%D*inv_lambda_sl_sl) !!!!!! correct? + endif dst%Lambda_tw(:,of) = prm%i_tw*prm%D/(1.0_pReal+prm%D*inv_lambda_tw_tw) @@ -896,12 +890,12 @@ subroutine plastic_dislotwin_dependentState(T,instance,of) !* threshold stress for growing twin/martensite if(prm%sum_N_tw == prm%sum_N_sl) & - dst%tau_hat_tw(:,of) = & - (SFE/(3.0_pReal*prm%b_tw)+ 3.0_pReal*prm%b_tw*prm%mu/(prm%L_tw*prm%b_sl)) ! slip burgers here correct? + dst%tau_hat_tw(:,of) = SFE/(3.0_pReal*prm%b_tw) & + + 3.0_pReal*prm%b_tw*prm%mu/(prm%L_tw*prm%b_sl) ! slip burgers here correct? if(prm%sum_N_tr == prm%sum_N_sl) & - dst%tau_hat_tr(:,of) = & - (SFE/(3.0_pReal*prm%b_tr) + 3.0_pReal*prm%b_tr*prm%mu/& - (prm%L_tr*prm%b_sl) + prm%h*prm%gamma_fcc_hex/ (3.0_pReal*prm%b_tr) ) + dst%tau_hat_tr(:,of) = SFE/(3.0_pReal*prm%b_tr) & + + 3.0_pReal*prm%b_tr*prm%mu/(prm%L_tr*prm%b_sl) & ! slip burgers here correct? + + prm%h*prm%gamma_fcc_hex/ (3.0_pReal*prm%b_tr) dst%f_tw(:,of) = (PI/4.0_pReal)*prm%t_tw*dst%Lambda_tw(:,of)**2.0_pReal @@ -1121,7 +1115,7 @@ pure subroutine kinetics_slip(Mp,T,instance,of, & end where significantStress end associate - + if(present(ddot_gamma_dtau_slip)) ddot_gamma_dtau_slip = ddot_gamma_dtau if(present(tau_slip)) tau_slip = tau From bf8ac403f1404a0c41c578269510c5586db5b6ed Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 29 Jun 2019 10:15:17 -0700 Subject: [PATCH 40/49] polishing, Part II --- src/plastic_dislotwin.f90 | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 9079a07de..b4c656d18 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -138,14 +138,14 @@ module plastic_dislotwin type :: tDislotwinMicrostructure real(pReal), dimension(:,:), allocatable :: & - Lambda_sl, & !* mean free path between 2 obstacles seen by a moving dislocation - Lambda_tw, & !* mean free path between 2 obstacles seen by a growing twin - Lambda_tr, &!* mean free path between 2 obstacles seen by a growing martensite + Lambda_sl, & !< mean free path between 2 obstacles seen by a moving dislocation + Lambda_tw, & !< mean free path between 2 obstacles seen by a growing twin + Lambda_tr, & !< mean free path between 2 obstacles seen by a growing martensite tau_pass, & tau_hat_tw, & tau_hat_tr, & - f_tw, & - f_tr, & + V_tw, & !< volume of a new twin + V_tr, & !< volume of a new martensite disc tau_r_tw, & !< stress to bring partials close together (twin) tau_r_tr !< stress to bring partials close together (trans) end type tDislotwinMicrostructure @@ -544,18 +544,18 @@ subroutine plastic_dislotwin_init dot%f_tr=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTol_f_tr - allocate(dst%Lambda_sl (prm%sum_N_sl, NipcMyPhase),source=0.0_pReal) - allocate(dst%tau_pass (prm%sum_N_sl, NipcMyPhase),source=0.0_pReal) + allocate(dst%Lambda_sl (prm%sum_N_sl,NipcMyPhase),source=0.0_pReal) + allocate(dst%tau_pass (prm%sum_N_sl,NipcMyPhase),source=0.0_pReal) - allocate(dst%Lambda_tw (prm%sum_N_tw, NipcMyPhase),source=0.0_pReal) - allocate(dst%tau_hat_tw (prm%sum_N_tw, NipcMyPhase),source=0.0_pReal) - allocate(dst%tau_r_tw (prm%sum_N_tw, NipcMyPhase),source=0.0_pReal) - allocate(dst%f_tw (prm%sum_N_tw, NipcMyPhase),source=0.0_pReal) + allocate(dst%Lambda_tw (prm%sum_N_tw,NipcMyPhase),source=0.0_pReal) + allocate(dst%tau_hat_tw (prm%sum_N_tw,NipcMyPhase),source=0.0_pReal) + allocate(dst%tau_r_tw (prm%sum_N_tw,NipcMyPhase),source=0.0_pReal) + allocate(dst%V_tw (prm%sum_N_tw,NipcMyPhase),source=0.0_pReal) allocate(dst%Lambda_tr (prm%sum_N_tr,NipcMyPhase),source=0.0_pReal) allocate(dst%tau_hat_tr (prm%sum_N_tr,NipcMyPhase),source=0.0_pReal) allocate(dst%tau_r_tr (prm%sum_N_tr,NipcMyPhase),source=0.0_pReal) - allocate(dst%f_tr (prm%sum_N_tr,NipcMyPhase),source=0.0_pReal) + allocate(dst%V_tr (prm%sum_N_tr,NipcMyPhase),source=0.0_pReal) plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally @@ -850,9 +850,9 @@ subroutine plastic_dislotwin_dependentState(T,instance,of) SFE = prm%SFE_0K + prm%dSFE_dT * T !* rescaled volume fraction for topology - f_over_t_tw = stt%f_tw(1:prm%sum_N_tw,of)/prm%t_tw !ToDo: this is per system - f_over_t_tr = sumf_trans/prm%t_tr !ToDo: But this not ... - !Todo: Physically ok, but naming could be adjusted + f_over_t_tw = stt%f_tw(1:prm%sum_N_tw,of)/prm%t_tw ! this is per system ... + f_over_t_tr = sumf_trans/prm%t_tr ! but this not + ! ToDo ...Physically correct, but naming could be adjusted forall (i = 1:prm%sum_N_sl) & @@ -898,8 +898,8 @@ subroutine plastic_dislotwin_dependentState(T,instance,of) + prm%h*prm%gamma_fcc_hex/ (3.0_pReal*prm%b_tr) - dst%f_tw(:,of) = (PI/4.0_pReal)*prm%t_tw*dst%Lambda_tw(:,of)**2.0_pReal - dst%f_tr(:,of) = (PI/4.0_pReal)*prm%t_tr*dst%Lambda_tr(:,of)**2.0_pReal + dst%V_tw(:,of) = (PI/4.0_pReal)*prm%t_tw*dst%Lambda_tw(:,of)**2.0_pReal + dst%V_tr(:,of) = (PI/4.0_pReal)*prm%t_tr*dst%Lambda_tr(:,of)**2.0_pReal x0 = prm%mu*prm%b_tw**2.0_pReal/(SFE*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) ! ToDo: In the paper, this is the burgers vector for slip and is the same for twin and trans @@ -1174,7 +1174,7 @@ pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& significantStress: where(tau > tol_math_check) StressRatio_r = (dst%tau_hat_tw(:,of)/tau)**prm%r - dot_gamma_twin = prm%gamma_char * dst%f_tw(:,of) * Ndot0*exp(-StressRatio_r) + dot_gamma_twin = prm%gamma_char * dst%V_tw(:,of) * Ndot0*exp(-StressRatio_r) ddot_gamma_dtau = (dot_gamma_twin*prm%r/tau)*StressRatio_r else where significantStress dot_gamma_twin = 0.0_pReal @@ -1239,7 +1239,7 @@ pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& significantStress: where(tau > tol_math_check) StressRatio_s = (dst%tau_hat_tr(:,of)/tau)**prm%s - dot_gamma_tr = dst%f_tr(:,of) * Ndot0*exp(-StressRatio_s) + dot_gamma_tr = dst%V_tr(:,of) * Ndot0*exp(-StressRatio_s) ddot_gamma_dtau = (dot_gamma_tr*prm%s/tau)*StressRatio_s else where significantStress dot_gamma_tr = 0.0_pReal From a04be84719e4d46a2316ab0daa12bdebb0a8bddc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 29 Jun 2019 10:26:29 -0700 Subject: [PATCH 41/49] avoid uninitialized array --- src/plastic_dislotwin.f90 | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index b4c656d18..30af6ed5d 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -309,23 +309,23 @@ subroutine plastic_dislotwin_init if (prm%sum_N_tw > 0) then prm%P_tw = lattice_SchmidMatrix_twin(prm%N_tw,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%h_tw_tw = lattice_interaction_TwinByTwin(prm%N_tw,& - config%getFloats('interaction_twintwin'), & - config%getString('lattice_structure')) + prm%h_tw_tw = lattice_interaction_TwinByTwin(prm%N_tw,& + config%getFloats('interaction_twintwin'), & + config%getString('lattice_structure')) - prm%b_tw = config%getFloats('twinburgers', requiredSize=size(prm%N_tw)) - prm%t_tw = config%getFloats('twinsize', requiredSize=size(prm%N_tw)) - prm%r = config%getFloats('r_twin', requiredSize=size(prm%N_tw)) + prm%b_tw = config%getFloats('twinburgers', requiredSize=size(prm%N_tw)) + prm%t_tw = config%getFloats('twinsize', requiredSize=size(prm%N_tw)) + prm%r = config%getFloats('r_twin', requiredSize=size(prm%N_tw)) prm%xc_twin = config%getFloat('xc_twin') - prm%L_tw = config%getFloat('l0_twin') + prm%L_tw = config%getFloat('l0_twin') prm%i_tw = config%getFloat('cmfptwin') - prm%gamma_char = lattice_characteristicShear_Twin(prm%N_tw,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%gamma_char= lattice_characteristicShear_Twin(prm%N_tw,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%C66_tw = lattice_C66_twin(prm%N_tw,prm%C66,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%C66_tw = lattice_C66_twin(prm%N_tw,prm%C66,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) if (.not. prm%fccTwinTransNucleation) then prm%dot_N_0_tw = config%getFloats('ndot0_twin') @@ -338,10 +338,11 @@ subroutine plastic_dislotwin_init prm%r = math_expand(prm%r,prm%N_tw) else - allocate(prm%t_tw (0)) - allocate(prm%b_tw (0)) - allocate(prm%r (0)) - allocate(prm%h_tw_tw(0,0)) + allocate(prm%gamma_char(0)) + allocate(prm%t_tw (0)) + allocate(prm%b_tw (0)) + allocate(prm%r (0)) + allocate(prm%h_tw_tw (0,0)) endif !-------------------------------------------------------------------------------------------------- @@ -1173,7 +1174,7 @@ pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& enddo significantStress: where(tau > tol_math_check) - StressRatio_r = (dst%tau_hat_tw(:,of)/tau)**prm%r + StressRatio_r = (dst%tau_hat_tw(:,of)/tau)**prm%r dot_gamma_twin = prm%gamma_char * dst%V_tw(:,of) * Ndot0*exp(-StressRatio_r) ddot_gamma_dtau = (dot_gamma_twin*prm%r/tau)*StressRatio_r else where significantStress From 7ad343c9b61e40a6b29d698ea11c82f4a9a3bd79 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 29 Jun 2019 15:06:47 -0700 Subject: [PATCH 42/49] polishing --- src/IO.f90 | 2 ++ src/grid/DAMASK_grid.f90 | 2 +- src/plastic_dislotwin.f90 | 4 ++-- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index d245cccb3..940fb2da9 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -783,6 +783,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'incomplete loadcase' case (838) msg = 'mixed boundary conditions allow rotation' + case (839) + msg = 'non-positive restart frequency in grid load case' case (841) msg = 'missing header length info in grid mesh' case (842) diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 5beab767d..ef863e017 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -299,7 +299,7 @@ program DAMASK_spectral write(6,'(2x,a,i5)') 'increments: ', newLoadCase%incs if (newLoadCase%outputfrequency < 1) errorID = 836 ! non-positive result frequency write(6,'(2x,a,i5)') 'output frequency: ', newLoadCase%outputfrequency - if (newLoadCase%restartfrequency < 1) errorID = 836 ! non-positive restart frequency + if (newLoadCase%restartfrequency < 1) errorID = 839 ! non-positive restart frequency write(6,'(2x,a,i5)') 'restart frequency: ', newLoadCase%restartfrequency if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message endif reportAndCheck diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 30af6ed5d..82498b0bf 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -1239,8 +1239,8 @@ pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& enddo significantStress: where(tau > tol_math_check) - StressRatio_s = (dst%tau_hat_tr(:,of)/tau)**prm%s - dot_gamma_tr = dst%V_tr(:,of) * Ndot0*exp(-StressRatio_s) + StressRatio_s = (dst%tau_hat_tr(:,of)/tau)**prm%s + dot_gamma_tr = dst%V_tr(:,of) * Ndot0*exp(-StressRatio_s) ddot_gamma_dtau = (dot_gamma_tr*prm%s/tau)*StressRatio_s else where significantStress dot_gamma_tr = 0.0_pReal From 619c67cc1940149346ab71fe4df18b6543d75e0b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 30 Jun 2019 01:29:36 +0200 Subject: [PATCH 43/49] fixed array access --- src/grid/DAMASK_grid.f90 | 3 ++- src/plastic_dislotwin.f90 | 10 ++++------ 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index ef863e017..edf26af19 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -300,7 +300,8 @@ program DAMASK_spectral if (newLoadCase%outputfrequency < 1) errorID = 836 ! non-positive result frequency write(6,'(2x,a,i5)') 'output frequency: ', newLoadCase%outputfrequency if (newLoadCase%restartfrequency < 1) errorID = 839 ! non-positive restart frequency - write(6,'(2x,a,i5)') 'restart frequency: ', newLoadCase%restartfrequency + if (newLoadCase%restartfrequency < huge(0)) & + write(6,'(2x,a,i5)') 'restart frequency: ', newLoadCase%restartfrequency if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message endif reportAndCheck loadCases = [loadCases,newLoadCase] ! load case is ok, append it diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 82498b0bf..344fb6c26 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -1159,12 +1159,11 @@ pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) - if (tau(i) < dst%tau_r_tw(i,of)) then + if (tau(i) < dst%tau_r_tw(i,of)) then ! ToDo: correct? Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,of)+stt%rho_dip(s2,of))+& abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,of)+stt%rho_dip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state (prm%L_tw*prm%b_sl(i))*& - (1.0_pReal-exp(-prm%V_cs/(kB*T)*& - (dst%tau_r_tw(i,of)-tau))) + (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tw(i,of)-tau(i)))) ! P_ncs else Ndot0=0.0_pReal end if @@ -1224,12 +1223,11 @@ pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) - if (tau(i) < dst%tau_r_tr(i,of)) then + if (tau(i) < dst%tau_r_tr(i,of)) then ! ToDo: correct? Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,of)+stt%rho_dip(s2,of))+& abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,of)+stt%rho_dip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state (prm%L_tr*prm%b_sl(i))*& - (1.0_pReal-exp(-prm%V_cs/(kB*T)*& - (dst%tau_r_tr(i,of)-tau))) + (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tr(i,of)-tau(i)))) ! P_ncs else Ndot0=0.0_pReal end if From c6a0d33b24c2c555fbf10903b714d7c650bc67ee Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 30 Jun 2019 22:46:18 +0200 Subject: [PATCH 44/49] [skip ci] updated version information after successful test of v2.0.3-610-gb175dec4 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index abe1abeac..1bbd825b2 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-559-g589f5343 +v2.0.3-610-gb175dec4 From 5ff4664b6d1a4c4d7bb9b8a0127f22198e96ff6b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 30 Jun 2019 22:09:51 -0700 Subject: [PATCH 45/49] polishing --- src/constitutive.f90 | 3 +-- src/crystallite.f90 | 6 ++---- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 4458cd6de..e627fa80c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -450,7 +450,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & dLi_dS(1:3,1:3,i,j) = matmul(matmul(Fi,dLi_dS(1:3,1:3,i,j)),FiInv)*detFi dLi_dFi(1:3,1:3,i,j) = dLi_dFi(1:3,1:3,i,j) + Li*FiInv(j,i) dLi_dFi(1:3,i,1:3,j) = dLi_dFi(1:3,i,1:3,j) + math_I3*temp_33(j,i) + Li*FiInv(j,i) - end do; end do + enddo; enddo end subroutine constitutive_LiAndItsTangents @@ -554,7 +554,6 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & E = 0.5_pReal*(matmul(transpose(Fe),Fe)-math_I3) !< Green-Lagrange strain in unloaded configuration S = math_mul3333xx33(C,matmul(matmul(transpose(Fi),E),Fi)) !< 2PK stress in lattice configuration in work conjugate with GL strain pulled back to lattice configuration - dS_dFe = 0.0_pReal forall (i=1:3, j=1:3) dS_dFe(i,j,1:3,1:3) = matmul(Fe,matmul(matmul(Fi,C(i,j,1:3,1:3)),transpose(Fi))) !< dS_ij/dFe_kl = C_ijmn * Fi_lm * Fi_on * Fe_ko dS_dFi(i,j,1:3,1:3) = 2.0_pReal*matmul(matmul(E,Fi),C(i,j,1:3,1:3)) !< dS_ij/dFi_kl = C_ijln * E_km * Fe_mn diff --git a/src/crystallite.f90 b/src/crystallite.f90 index d2e8ae97c..246cb7092 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1190,10 +1190,8 @@ logical function integrateStress(ipc,ip,el,timeFraction) Fg_new = crystallite_subF(1:3,1:3,ipc,ip,el) endif - - !* feed local variables - Lpguess = crystallite_Lp(1:3,1:3,ipc,ip,el) ! ... and take it as first guess - Liguess = crystallite_Li(1:3,1:3,ipc,ip,el) ! ... and take it as first guess + Lpguess = crystallite_Lp(1:3,1:3,ipc,ip,el) ! take as first guess + Liguess = crystallite_Li(1:3,1:3,ipc,ip,el) ! take as first guess Liguess_old = Liguess invFp_current = math_inv33(crystallite_subFp0(1:3,1:3,ipc,ip,el)) From 1401af46037c9e5db793215bdb24f63814c5dd02 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 30 Jun 2019 22:46:23 -0700 Subject: [PATCH 46/49] dislowtin test with better variables --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 372d3746b..18a976753 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 372d3746b2e4863e83fa34fe9a32082237cb63de +Subproject commit 18a976753be06aca6e15f580998e713daa08bb41 From ba32d8f17717fbd7e69ae5d42686a4780e163d71 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 1 Jul 2019 19:04:57 +0200 Subject: [PATCH 47/49] [skip ci] updated version information after successful test of v2.0.3-614-g4d6a047b --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 1bbd825b2..e15baa830 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-610-gb175dec4 +v2.0.3-614-g4d6a047b From 8800bf36fbb7a1e37629e744c44f774ec4b4caeb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 4 Jul 2019 09:21:11 -0700 Subject: [PATCH 48/49] [skip ci] name of IntelMPI Intel C compiler --- DAMASK_prerequisites.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DAMASK_prerequisites.sh b/DAMASK_prerequisites.sh index 5e96f4aee..2db3f7bb6 100755 --- a/DAMASK_prerequisites.sh +++ b/DAMASK_prerequisites.sh @@ -110,7 +110,7 @@ for executable in icc icpc ifort ;do done firstLevel "MPI Wrappers" -for executable in mpicc mpiCC mpic++ mpicpc mpicxx mpifort mpif90 mpif77; do +for executable in mpicc mpiCC mpiicc mpic++ mpicpc mpicxx mpifort mpif90 mpif77; do getDetails $executable '-show' done From 4340c558d7f1a35ba78ab415608cbecfc0dfcb81 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 5 Jul 2019 22:26:32 -0700 Subject: [PATCH 49/49] named as in DAMASK paper --- src/plastic_dislotwin.f90 | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 344fb6c26..43b379667 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -736,10 +736,12 @@ subroutine plastic_dislotwin_dotState(Mp,T,instance,of) of integer :: i - real(pReal) :: f_unrotated,& - VacancyDiffusion,& - rho_dip_distance, ClimbVelocity, & - tau + real(pReal) :: & + f_unrotated, & + VacancyDiffusion, & + rho_dip_distance, & + v_cl, & + tau real(pReal), dimension(param(instance)%sum_N_sl) :: & dot_rho_dip_formation, & dot_rho_dip_climb, & @@ -751,7 +753,7 @@ subroutine plastic_dislotwin_dotState(Mp,T,instance,of) dot_gamma_tr associate(prm => param(instance), stt => state(instance), & - dot => dotstate(instance), dst => dependentState(instance)) + dot => dotState(instance), dst => dependentState(instance)) f_unrotated = 1.0_pReal & - sum(stt%f_tw(1:prm%sum_N_tw,of)) & @@ -784,9 +786,9 @@ subroutine plastic_dislotwin_dotState(Mp,T,instance,of) if (dEq0(rho_dip_distance-rho_dip_distance_min(i))) then dot_rho_dip_climb(i) = 0.0_pReal else - ClimbVelocity = 3.0_pReal*prm%mu*VacancyDiffusion*prm%atomicVolume(i) & - / (2.0_pReal*PI*kB*T*(rho_dip_distance+rho_dip_distance_min(i))) - dot_rho_dip_climb(i) = 4.0_pReal*ClimbVelocity*stt%rho_dip(i,of) & + v_cl = 3.0_pReal*prm%mu*VacancyDiffusion*prm%atomicVolume(i) & + / (2.0_pReal*PI*kB*T*(rho_dip_distance+rho_dip_distance_min(i))) + dot_rho_dip_climb(i) = 4.0_pReal*v_cl*stt%rho_dip(i,of) & / (rho_dip_distance-rho_dip_distance_min(i)) endif endif significantSlipStress