From 57c6271894b29ab0e7fe47ed6433370744c9003d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Jan 2019 09:33:47 +0100 Subject: [PATCH] using less global variables --- src/homogenization.f90 | 10 +++---- src/homogenization_RGC.f90 | 60 ++++++++++++++++++++------------------ 2 files changed, 36 insertions(+), 34 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index aadc7ee89..6c968f723 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -792,7 +792,7 @@ function homogenization_updateState(ip,el) homogenization_type, & thermal_type, & damage_type, & - homogenization_maxNgrains, & + homogenization_Ngrains, & HOMOGENIZATION_RGC_ID, & THERMAL_adiabatic_ID, & DAMAGE_local_ID @@ -819,12 +819,12 @@ function homogenization_updateState(ip,el) case (HOMOGENIZATION_RGC_ID) chosenHomogenization homogenization_updateState = & homogenization_updateState .and. & - homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), & - crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), & - crystallite_partionedF0(1:3,1:3,1:homogenization_maxNgrains,ip,el),& + homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & + crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el),& materialpoint_subF(1:3,1:3,ip,el),& materialpoint_subdt(ip,el), & - crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), & + crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), & ip, & el) end select chosenHomogenization diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 6c67249d0..8a101eb72 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -332,8 +332,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) use material, only: & material_homogenizationAt, & homogenization_typeInstance, & - mappingHomogenization, & - homogenization_maxNgrains + mappingHomogenization use numerics, only: & absTol_RGC, & relTol_RGC, & @@ -347,30 +346,33 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: & + real(pReal), dimension (:,:,:), intent(in) :: & P,& !< array of P F,& !< array of F F0 !< array of initial F - real(pReal), dimension (3,3,3,3,homogenization_maxNgrains), intent(in) :: dPdF !< array of current grain stiffness - real(pReal), dimension (3,3), intent(in) :: avgF !< average F - real(pReal), intent(in) :: dt !< time increment - integer(pInt), intent(in) :: & + real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< array of current grain stiffness + real(pReal), dimension (3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer(pInt), intent(in) :: & ip, & !< integration point number el !< element number logical, dimension(2) :: homogenization_RGC_updateState + integer(pInt), dimension (4) :: intFaceN,intFaceP,faceID integer(pInt), dimension (3) :: nGDim,iGr3N,iGr3P,stresLoc - integer(pInt), dimension (2) :: residLoc - integer(pInt) instance,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain, of - real(pReal), dimension (3,3,homogenization_maxNgrains) :: R,pF,pR,D,pD - real(pReal), dimension (3,homogenization_maxNgrains) :: NN,devNull33 - real(pReal), dimension (3) :: normP,normN,mornP,mornN - real(pReal) :: residMax,stresMax,devNull - logical error - + integer(pInt) :: instance,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain, of + real(pReal), dimension (3,3,size(P,3)) :: R,pF,pR,D,pD + real(pReal), dimension (3,size(P,3)) :: NN,devNull + real(pReal), dimension (3) :: normP,normN,mornP,mornN + real(pReal) :: residMax,stresMax + logical :: error real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix real(pReal), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax +#ifdef DEBUG + integer(pInt), dimension (3) :: stresLoc + integer(pInt), dimension (2) :: residLoc +#endif zeroTimeStep: if(dEq0(dt)) then homogenization_RGC_updateState = .true. ! pretend everything is fine and return @@ -475,13 +477,13 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) !-------------------------------------------------------------------------------------------------- ! convergence check for stress residual stresMax = maxval(abs(P)) ! get the maximum of first Piola-Kirchhoff (material) stress - stresLoc = int(maxloc(abs(P)),pInt) ! get the location of the maximum stress residMax = maxval(abs(tract)) ! get the maximum of the residual - residLoc = int(maxloc(abs(tract)),pInt) ! get the position of the maximum residual #ifdef DEBUG if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt & .and. debug_e == el .and. debug_i == ip) then + stresLoc = int(maxloc(abs(P)),pInt) ! get the location of the maximum stress + residLoc = int(maxloc(abs(tract)),pInt) ! get the position of the maximum residual write(6,'(1x,a)')' ' write(6,'(1x,a,1x,i2,1x,i4)')'RGC residual check ...',ip,el write(6,'(1x,a15,1x,e15.8,1x,a7,i3,1x,a12,i2,i2)')'Max stress: ',stresMax, & @@ -637,8 +639,8 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) p_relax(ipert) = relax(ipert) + pPert_RGC ! perturb the relaxation vector stt%relaxationVector(:,of) = p_relax call grainDeformation(pF,avgF,instance,of) ! rain deformation from perturbed state - call stressPenalty(pR,DevNull33, avgF,pF,ip,el,instance,of) ! stress penalty due to interface mismatch from perturbed state - call volumePenalty(pD,devNull, avgF,pF,nGrain,instance,of) ! stress penalty due to volume discrepancy from perturbed state + call stressPenalty(pR,DevNull, avgF,pF,ip,el,instance,of) ! stress penalty due to interface mismatch from perturbed state + call volumePenalty(pD,devNull(1,1), avgF,pF,nGrain,instance,of) ! stress penalty due to volume discrepancy from perturbed state !-------------------------------------------------------------------------------------------------- ! computing the global stress residual array from the perturbed state @@ -774,12 +776,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) xSmoo_RGC implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: rPen !< stress-like penalty - real(pReal), dimension (3,homogenization_maxNgrains), intent(out) :: nMis !< total amount of mismatch + real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty + real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef !< deformation gradients - real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor - integer(pInt), intent(in) :: ip,el,instance,of + real(pReal), dimension (:,:,:), intent(in) :: fDef !< deformation gradients + real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor + integer(pInt), intent(in) :: ip,el,instance,of integer(pInt), dimension (4) :: intFace integer(pInt), dimension (3) :: iGrain3,iGNghb3,nGDim @@ -894,17 +896,17 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) volDiscrPow_RGC implicit none - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(out) :: vPen ! stress-like penalty due to volume - real(pReal), intent(out) :: vDiscrep ! total volume discrepancy + real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume + real(pReal), intent(out) :: vDiscrep ! total volume discrepancy - real(pReal), dimension (3,3,homogenization_maxNgrains), intent(in) :: fDef ! deformation gradients - real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient + real(pReal), dimension (:,:,:), intent(in) :: fDef ! deformation gradients + real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient integer(pInt), intent(in) :: & Ngrain, & instance, & of - real(pReal), dimension (homogenization_maxNgrains) :: gVol + real(pReal), dimension(size(vPen,3)) :: gVol integer(pInt) :: i !--------------------------------------------------------------------------------------------------