223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

avoid variable name conflict with a module name

This commit is contained in:
Sharan Roongta 2020-07-02 01:25:24 +02:00
parent 2056b4223a
commit 699af6a3f1
8 changed files with 107 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/CPFEM.f90
View File

@ -54,13 +54,14 @@ module CPFEM
type, private :: tDebugOptions type, private :: tDebugOptions
logical :: & logical :: &
basic, & basic, &
extensive extensive, &
selective
integer:: & integer:: &
element, & element, &
ip ip
end type tDebugOptions end type tDebugOptions
type(tDebugOptions), private :: debug type(tDebugOptions), private :: debugCPFEM
public :: & public :: &
CPFEM_general, & CPFEM_general, &
@ -124,13 +125,13 @@ subroutine CPFEM_init
! read debug options ! read debug options
debug_CPFEM => debug_root%get('cpfem',defaultVal=emptyList) debug_CPFEM => debug_root%get('cpfem',defaultVal=emptyList)
debug%basic = debug_CPFEM%contains('basic') debugCPFEM%basic = debug_CPFEM%contains('basic')
debug%extensive = debug_CPFEM%contains('extensive') debugCPFEM%extensive = debug_CPFEM%contains('extensive')
debug%selective = debug_CPFEM%contains('selective') debugCPFEM%selective = debug_CPFEM%contains('selective')
debug%element = debug_root%get_asInt('element',defaultVal = 1) debugCPFEM%element = debug_root%get_asInt('element',defaultVal = 1)
debug%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1) debugCPFEM%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1)
if(debug%basic) then if(debugCPFEM%basic) then
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs) write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs)
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE) write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE)
write(6,'(a32,1x,6(i8,1x),/)') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood) write(6,'(a32,1x,6(i8,1x),/)') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood)
@ -171,8 +172,8 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
elCP = mesh_FEM2DAMASK_elem(elFE) elCP = mesh_FEM2DAMASK_elem(elFE)
if (debug%basic .and. elCP == debug%element & if (debugCPFEM%basic .and. elCP == debugCPFEM%element &
.and. ip == debug%ip) then .and. ip == debugCPFEM%ip) then
write(6,'(/,a)') '#############################################' write(6,'(/,a)') '#############################################'
write(6,'(a1,a22,1x,i8,a13)') '#','element', elCP, '#' write(6,'(a1,a22,1x,i8,a13)') '#','element', elCP, '#'
write(6,'(a1,a22,1x,i8,a13)') '#','ip', ip, '#' write(6,'(a1,a22,1x,i8,a13)') '#','ip', ip, '#'
@ -210,7 +211,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
updateJaco = mod(cycleCounter,num%iJacoStiffness) == 0 updateJaco = mod(cycleCounter,num%iJacoStiffness) == 0
FEsolving_execElem = elCP FEsolving_execElem = elCP
FEsolving_execIP = ip FEsolving_execIP = ip
if (debug%extensive) & if (debugCPFEM%extensive) &
write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip
call materialpoint_stressAndItsTangent(updateJaco, dt) call materialpoint_stressAndItsTangent(updateJaco, dt)
@ -247,9 +248,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
endif terminalIllness endif terminalIllness
endif validCalculation endif validCalculation
if (debug%extensive & if (debugCPFEM%extensive &
.and. (debug%element == elCP .and. debug%ip == ip) & .and. (debugCPFEM%element == elCP .and. debugCPFEM%ip == ip) &
.or. .not. debug%selective) then .or. .not. debugCPFEM%selective) then
write(6,'(a,i8,1x,i2,/,12x,6(f10.3,1x)/)') & write(6,'(a,i8,1x,i2,/,12x,6(f10.3,1x)/)') &
'<< CPFEM >> stress/MPa at elFE ip ', elFE, ip, CPFEM_cs(1:6,ip,elCP)*1.0e-6_pReal '<< CPFEM >> stress/MPa at elFE ip ', elFE, ip, CPFEM_cs(1:6,ip,elCP)*1.0e-6_pReal
write(6,'(a,i8,1x,i2,/,6(12x,6(f10.3,1x)/))') & write(6,'(a,i8,1x,i2,/,6(12x,6(f10.3,1x)/))') &

14
src/constitutive.f90
View File

@ -329,7 +329,7 @@ module constitutive
grain grain
end type tDebugOptions end type tDebugOptions
type(tDebugOptions) :: debug type(tDebugOptions) :: debugConstitutive
public :: & public :: &
plastic_nonlocal_updateCompatibility, & plastic_nonlocal_updateCompatibility, &
@ -359,12 +359,12 @@ subroutine constitutive_init
debug_constitutive debug_constitutive
debug_constitutive => debug_root%get('constitutuve', defaultVal=emptyList) debug_constitutive => debug_root%get('constitutuve', defaultVal=emptyList)
debug%basic = debug_constitutive%contains('basic') debugConstitutive%basic = debug_constitutive%contains('basic')
debug%extensive = debug_constitutive%contains('extensive') debugConstitutive%extensive = debug_constitutive%contains('extensive')
debug%selective = debug_constitutive%contains('selective') debugConstitutive%selective = debug_constitutive%contains('selective')
debug%element = debug_root%get_asInt('element',defaultVal = 1) debugConstitutive%element = debug_root%get_asInt('element',defaultVal = 1)
debug%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1) debugConstitutive%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1)
debug%grain = debug_root%get_asInt('grain',defaultVal = 1) debugConstitutive%grain = debug_root%get_asInt('grain',defaultVal = 1)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

12
src/constitutive_plastic_isotropic.f90
View File

@ -83,8 +83,8 @@ module subroutine plastic_isotropic_init
prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) prm%output = config%getStrings('(output)',defaultVal=emptyStringArray)
#ifdef DEBUG #ifdef DEBUG
if (p==material_phaseAt(debug%grain,debug%element)) & if (p==material_phaseAt(debugConstitutive%grain,debugConstitutive%element)) &
prm%of_debug = material_phasememberAt(debug%grain,debug%ip,debug%element) prm%of_debug = material_phasememberAt(debugConstitutive%grain,debugConstitutive%ip,debugConstitutive%element)
#endif #endif
xi_0 = config%getFloat('tau0') xi_0 = config%getFloat('tau0')
@ -182,8 +182,8 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
Lp = dot_gamma/prm%M * Mp_dev/norm_Mp_dev Lp = dot_gamma/prm%M * Mp_dev/norm_Mp_dev
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive & if (debugConstitutive%extensive &
.and. (of == prm%of_debug .or. .not. debug%selective)) then .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then
write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CONST isotropic >> Tstar (dev) / MPa', & write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CONST isotropic >> Tstar (dev) / MPa', &
transpose(Mp_dev)*1.0e-6_pReal transpose(Mp_dev)*1.0e-6_pReal
write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Mp_dev*1.0e-6_pReal write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Mp_dev*1.0e-6_pReal
@ -238,8 +238,8 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of)
* tr * abs(tr)**(prm%n-1.0_pReal) * tr * abs(tr)**(prm%n-1.0_pReal)
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive & if (debugConstitutive%extensive &
.and. (of == prm%of_debug .or. .not. debug%selective)) then .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then
write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> pressure / MPa', tr/3.0_pReal*1.0e-6_pReal write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> pressure / MPa', tr/3.0_pReal*1.0e-6_pReal
write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> gdot', prm%dot_gamma_0 * (3.0_pReal*prm%M*stt%xi(of))**(-prm%n) & write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> gdot', prm%dot_gamma_0 * (3.0_pReal*prm%M*stt%xi(of))**(-prm%n) &
* tr * abs(tr)**(prm%n-1.0_pReal) * tr * abs(tr)**(prm%n-1.0_pReal)

8
src/constitutive_plastic_kinehardening.f90
View File

@ -95,8 +95,8 @@ module subroutine plastic_kinehardening_init
prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) prm%output = config%getStrings('(output)',defaultVal=emptyStringArray)
#ifdef DEBUG #ifdef DEBUG
if (p==material_phaseAt(debug%grain,debug%element)) then if (p==material_phaseAt(debugConstitutive%grain,debugConstitutive%element)) then
prm%of_debug = material_phasememberAt(debug%grain,debug%ip,debug%element) prm%of_debug = material_phasememberAt(debugConstitutive%grain,debugConstitutive%ip,debugConstitutive%element)
endif endif
#endif #endif
@ -327,9 +327,9 @@ module subroutine plastic_kinehardening_deltaState(Mp,instance,of)
dEq0(gdot_pos+gdot_neg,1e-10_pReal)) ! current sense of shear direction dEq0(gdot_pos+gdot_neg,1e-10_pReal)) ! current sense of shear direction
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive & if (debugConstitutive%extensive &
.and. (of == prm%of_debug & .and. (of == prm%of_debug &
.or. .not. debug%selective)) then .or. .not. debugConstitutive%selective)) then
write(6,'(a)') '======= kinehardening delta state =======' write(6,'(a)') '======= kinehardening delta state ======='
write(6,*) sense,state(instance)%sense(:,of) write(6,*) sense,state(instance)%sense(:,of)
endif endif

22
src/constitutive_plastic_nonlocal.f90
View File

@ -709,9 +709,9 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el)
endif endif
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive & if (debugConstitutive%extensive &
.and. ((debug%element == el .and. debug%ip == ip)& .and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip)&
.or. .not. debug%selective)) then .or. .not. debugConstitutive%selective)) then
write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_microstructure at el ip ',el,ip write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_microstructure at el ip ',el,ip
write(6,'(a,/,12x,12(e10.3,1x))') '<< CONST >> rhoForest', stt%rho_forest(:,of) write(6,'(a,/,12x,12(e10.3,1x))') '<< CONST >> rhoForest', stt%rho_forest(:,of)
write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', dst%tau_pass(:,of)*1e-6 write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', dst%tau_pass(:,of)*1e-6
@ -926,9 +926,9 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el)
del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns])
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive & if (debugConstitutive%extensive &
.and. ((debug%element == el .and. debug%ip == ip)& .and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip)&
.or. .not. debug%selective)) then .or. .not. debugConstitutive%selective)) then
write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation remobilization', deltaRhoRemobilization(:,1:8) write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation remobilization', deltaRhoRemobilization(:,1:8)
write(6,'(a,/,10(12x,12(e12.5,1x),/),/)') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress write(6,'(a,/,10(12x,12(e12.5,1x),/),/)') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress
endif endif
@ -1015,9 +1015,9 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, &
gdot = rhoSgl(:,1:4) * v * spread(prm%burgers,2,4) gdot = rhoSgl(:,1:4) * v * spread(prm%burgers,2,4)
#ifdef DEBUG #ifdef DEBUG
if (debug%basic & if (debugConstitutive%basic &
.and. ((debug%element == el .and. debug%ip == ip) & .and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip) &
.or. .not. debug%selective)) then .or. .not. debugConstitutive%selective)) then
write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> rho / 1/m^2', rhoSgl, rhoDip write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> rho / 1/m^2', rhoSgl, rhoDip
write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> gdot / 1/s',gdot write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> gdot / 1/s',gdot
endif endif
@ -1126,7 +1126,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, &
if ( any(rho(:,mob) + rhoDot(:,1:4) * timestep < -prm%atol_rho) & if ( any(rho(:,mob) + rhoDot(:,1:4) * timestep < -prm%atol_rho) &
.or. any(rho(:,dip) + rhoDot(:,9:10) * timestep < -prm%atol_rho)) then .or. any(rho(:,dip) + rhoDot(:,9:10) * timestep < -prm%atol_rho)) then
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugConstitutive%extensive) then
write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip
write(6,'(a)') '<< CONST >> enforcing cutback !!!' write(6,'(a)') '<< CONST >> enforcing cutback !!!'
endif endif
@ -1238,7 +1238,7 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el)
.and. prm%CFLfactor * abs(v0) * timestep & .and. prm%CFLfactor * abs(v0) * timestep &
> IPvolume(ip,el) / maxval(IParea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here) > IPvolume(ip,el) / maxval(IParea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here)
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugConstitutive%extensive) then
write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip
write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', & write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', &
maxval(abs(v0), abs(gdot) > 0.0_pReal & maxval(abs(v0), abs(gdot) > 0.0_pReal &

44
src/crystallite.f90
View File

@ -109,7 +109,7 @@ module crystallite
grain grain
end type tDebugOptions end type tDebugOptions
type(tDebugOptions) :: debug type(tDebugOptions) :: debugCrystallite
procedure(integrateStateFPI), pointer :: integrateState procedure(integrateStateFPI), pointer :: integrateState
@ -150,12 +150,12 @@ subroutine crystallite_init
write(6,'(/,a)') ' <<<+- crystallite init -+>>>' write(6,'(/,a)') ' <<<+- crystallite init -+>>>'
debug_crystallite => debug_root%get('crystallite', defaultVal=emptyList) debug_crystallite => debug_root%get('crystallite', defaultVal=emptyList)
debug%basic = debug_crystallite%contains('basic') debugCrystallite%basic = debug_crystallite%contains('basic')
debug%extensive = debug_crystallite%contains('extensive') debugCrystallite%extensive = debug_crystallite%contains('extensive')
debug%selective = debug_crystallite%contains('selective') debugCrystallite%selective = debug_crystallite%contains('selective')
debug%element = debug_root%get_asInt('element', defaultVal=1) debugCrystallite%element = debug_root%get_asInt('element', defaultVal=1)
debug%ip = debug_root%get_asInt('integrationpoint', defaultVal=1) debugCrystallite%ip = debug_root%get_asInt('integrationpoint', defaultVal=1)
debug%grain = debug_root%get_asInt('grain', defaultVal=1) debugCrystallite%grain = debug_root%get_asInt('grain', defaultVal=1)
cMax = homogenization_maxNgrains cMax = homogenization_maxNgrains
iMax = discretization_nIP iMax = discretization_nIP
@ -293,7 +293,7 @@ subroutine crystallite_init
call crystallite_stressTangent call crystallite_stressTangent
#ifdef DEBUG #ifdef DEBUG
if (debug%basic) then if (debugCrystallite%basic) then
write(6,'(a42,1x,i10)') ' # of elements: ', eMax write(6,'(a42,1x,i10)') ' # of elements: ', eMax
write(6,'(a42,1x,i10)') ' # of integration points/element: ', iMax write(6,'(a42,1x,i10)') ' # of integration points/element: ', iMax
write(6,'(a42,1x,i10)') 'max # of constituents/integration point: ', cMax write(6,'(a42,1x,i10)') 'max # of constituents/integration point: ', cMax
@ -324,23 +324,29 @@ function crystallite_stress()
todo = .false. todo = .false.
#ifdef DEBUG #ifdef DEBUG
if (debug%selective & if (debugCrystallite%selective &
.and. FEsolving_execElem(1) <= debug%element & .and. FEsolving_execElem(1) <= debugCrystallite%element &
.and. debug%element <= FEsolving_execElem(2)) then .and. debugCrystallite%element <= FEsolving_execElem(2)) then
write(6,'(/,a,i8,1x,i2,1x,i3)') '<< CRYST stress >> boundary and initial values at el ip ipc ', & write(6,'(/,a,i8,1x,i2,1x,i3)') '<< CRYST stress >> boundary and initial values at el ip ipc ', &
debug%element,debug%ip, debug%grain debugCrystallite%element,debugCrystallite%ip, debugCrystallite%grain
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> F ', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> F ', &
transpose(crystallite_partionedF(1:3,1:3,debug%grain,debug%ip,debug%element)) transpose(crystallite_partionedF(1:3,1:3,debugCrystallite%grain, &
debugCrystallite%ip,debugCrystallite%element))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> F0 ', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> F0 ', &
transpose(crystallite_partionedF0(1:3,1:3,debug%grain,debug%ip,debug%element)) transpose(crystallite_partionedF0(1:3,1:3,debugCrystallite%grain, &
debugCrystallite%ip,debugCrystallite%element))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Fp0', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Fp0', &
transpose(crystallite_partionedFp0(1:3,1:3,debug%grain,debug%ip,debug%element)) transpose(crystallite_partionedFp0(1:3,1:3,debugCrystallite%grain, &
debugCrystallite%ip,debugCrystallite%element))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Fi0', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Fi0', &
transpose(crystallite_partionedFi0(1:3,1:3,debug%grain,debug%ip,debug%element)) transpose(crystallite_partionedFi0(1:3,1:3,debugCrystallite%grain, &
debugCrystallite%ip,debugCrystallite%element))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Lp0', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Lp0', &
transpose(crystallite_partionedLp0(1:3,1:3,debug%grain,debug%ip,debug%element)) transpose(crystallite_partionedLp0(1:3,1:3,debugCrystallite%grain, &
debugCrystallite%ip,debugCrystallite%element))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Li0', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> Li0', &
transpose(crystallite_partionedLi0(1:3,1:3,debug%grain,debug%ip,debug%element)) transpose(crystallite_partionedLi0(1:3,1:3,debugCrystallite%grain, &
debugCrystallite%ip,debugCrystallite%element))
endif endif
#endif #endif
@ -386,7 +392,7 @@ function crystallite_stress()
NiterationCrystallite = NiterationCrystallite + 1 NiterationCrystallite = NiterationCrystallite + 1
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) & if (debugCrystallite%extensive) &
write(6,'(a,i6)') '<< CRYST stress >> crystallite iteration ',NiterationCrystallite write(6,'(a,i6)') '<< CRYST stress >> crystallite iteration ',NiterationCrystallite
#endif #endif
!$OMP PARALLEL DO PRIVATE(formerSubStep) !$OMP PARALLEL DO PRIVATE(formerSubStep)

39
src/homogenization.f90
View File

@ -63,7 +63,7 @@ module homogenization
grain grain
end type tDebugOptions end type tDebugOptions
type(tDebugOptions) :: debug type(tDebugOptions) :: debugHomog
interface interface
@ -153,15 +153,16 @@ subroutine homogenization_init
debug_homogenization debug_homogenization
debug_homogenization => debug_root%get('homogenization', defaultVal=emptyList) debug_homogenization => debug_root%get('homogenization', defaultVal=emptyList)
debug%basic = debug_homogenization%contains('basic') debugHomog%basic = debug_homogenization%contains('basic')
debug%extensive = debug_homogenization%contains('extensive') debugHomog%extensive = debug_homogenization%contains('extensive')
debug%selective = debug_homogenization%contains('selective') debugHomog%selective = debug_homogenization%contains('selective')
debug%element = debug_root%get_asInt('element',defaultVal = 1) debugHomog%element = debug_root%get_asInt('element',defaultVal = 1)
debug%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1) debugHomog%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1)
debug%grain = debug_root%get_asInt('grain',defaultVal = 1) debugHomog%grain = debug_root%get_asInt('grain',defaultVal = 1)
if (debug%grain < 1 .or. debug%grain > homogenization_Ngrains(material_homogenizationAt(debug%element))) & if (debugHomog%grain < 1 &
call IO_error(602,ext_msg='constituent', el=debug%element, g=debug%grain) .or. debugHomog%grain > homogenization_Ngrains(material_homogenizationAt(debugHomog%element))) &
call IO_error(602,ext_msg='constituent', el=debugHomog%element, g=debugHomog%grain)
num_homog => numerics_root%get('homogenization',defaultVal=emptyDict) num_homog => numerics_root%get('homogenization',defaultVal=emptyDict)
@ -230,13 +231,13 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
#ifdef DEBUG #ifdef DEBUG
if (debug%basic) then if (debugHomog%basic) then
write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debug%element, debug%ip write(6,'(/a,i5,1x,i2)') '<< HOMOG >> Material Point start at el ip ', debugHomog%element, debugHomog%ip
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F0', &
transpose(materialpoint_F0(1:3,1:3,debug%ip,debug%element)) transpose(materialpoint_F0(1:3,1:3,debugHomog%ip,debugHomog%element))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', & write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', &
transpose(materialpoint_F(1:3,1:3,debug%ip,debug%element)) transpose(materialpoint_F(1:3,1:3,debugHomog%ip,debugHomog%element))
endif endif
#endif #endif
@ -295,9 +296,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
if (converged(i,e)) then if (converged(i,e)) then
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive & if (debugHomog%extensive &
.and. ((e == debug%element .and. i == debug%ip) & .and. ((e == debugHomog%element .and. i == debugHomog%ip) &
.or. .not. debug%selective)) then .or. .not. debugHomog%selective)) then
write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,i8,1x,i2/)') '<< HOMOG >> winding forward from', & write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,i8,1x,i2/)') '<< HOMOG >> winding forward from', &
subFrac(i,e), 'to current subFrac', & subFrac(i,e), 'to current subFrac', &
subFrac(i,e)+subStep(i,e),'in materialpoint_stressAndItsTangent at el ip',e,i subFrac(i,e)+subStep(i,e),'in materialpoint_stressAndItsTangent at el ip',e,i
@ -354,9 +355,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
subStep(i,e) = num%subStepSizeHomog * subStep(i,e) ! crystallite had severe trouble, so do a significant cutback subStep(i,e) = num%subStepSizeHomog * subStep(i,e) ! crystallite had severe trouble, so do a significant cutback
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive & if (debugHomog%extensive &
.and. ((e == debug%element .and. i == debug%ip) & .and. ((e == debugHomog%element .and. i == debugHomog%ip) &
.or. .not. debug%selective)) then .or. .not. debugHomog%selective)) then
write(6,'(a,1x,f12.8,a,i8,1x,i2/)') & write(6,'(a,1x,f12.8,a,i8,1x,i2/)') &
'<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new subStep:',& '<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new subStep:',&
subStep(i,e),' at el ip',e,i subStep(i,e),' at el ip',e,i

38
src/homogenization_mech_RGC.f90
View File

@ -143,8 +143,8 @@ module subroutine mech_RGC_init(num_homogMech)
config => config_homogenization(h)) config => config_homogenization(h))
#ifdef DEBUG #ifdef DEBUG
if (h==material_homogenizationAt(debug%element)) then if (h==material_homogenizationAt(debugHomog%element)) then
prm%of_debug = material_homogenizationMemberAt(debug%ip,debug%element) prm%of_debug = material_homogenizationMemberAt(debugHomog%ip,debugHomog%element)
endif endif
#endif #endif
@ -228,7 +228,7 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugHomog%extensive) then
write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain
do i = 1,3 do i = 1,3
write(6,'(1x,3(e15.8,1x))')(F(i,j,iGrain), j = 1,3) write(6,'(1x,3(e15.8,1x))')(F(i,j,iGrain), j = 1,3)
@ -291,7 +291,7 @@ module procedure mech_RGC_updateState
drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of)
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugHomog%extensive) then
write(6,'(1x,a30)')'Obtained state: ' write(6,'(1x,a30)')'Obtained state: '
do i = 1,size(stt%relaxationVector(:,of)) do i = 1,size(stt%relaxationVector(:,of))
write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of)
@ -309,7 +309,7 @@ module procedure mech_RGC_updateState
call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of) call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of)
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugHomog%extensive) then
do iGrain = 1,nGrain do iGrain = 1,nGrain
write(6,'(1x,a30,1x,i3,1x,a4,3(1x,e15.8))')'Mismatch magnitude of grain(',iGrain,') :',& 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) NN(1,iGrain),NN(2,iGrain),NN(3,iGrain)
@ -357,7 +357,7 @@ module procedure mech_RGC_updateState
enddo enddo
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugHomog%extensive) then
write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum 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,'(1x,3(e15.8,1x))')(tract(iNum,j), j = 1,3)
write(6,*)' ' write(6,*)' '
@ -371,7 +371,7 @@ module procedure mech_RGC_updateState
residMax = maxval(abs(tract)) ! get the maximum of the residual residMax = maxval(abs(tract)) ! get the maximum of the residual
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive .and. prm%of_debug == of) then if (debugHomog%extensive .and. prm%of_debug == of) then
stresLoc = maxloc(abs(P)) stresLoc = maxloc(abs(P))
residLoc = maxloc(abs(tract)) residLoc = maxloc(abs(tract))
write(6,'(1x,a)')' ' write(6,'(1x,a)')' '
@ -391,7 +391,7 @@ module procedure mech_RGC_updateState
if (residMax < num%rtol*stresMax .or. residMax < num%atol) then if (residMax < num%rtol*stresMax .or. residMax < num%atol) then
mech_RGC_updateState = .true. mech_RGC_updateState = .true.
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive .and. prm%of_debug == of) & if (debugHomog%extensive .and. prm%of_debug == of) &
write(6,'(1x,a55,/)')'... done and happy'; flush(6) write(6,'(1x,a55,/)')'... done and happy'; flush(6)
#endif #endif
@ -411,7 +411,7 @@ module procedure mech_RGC_updateState
dst%relaxationRate_max(of) = maxval(abs(drelax))/dt dst%relaxationRate_max(of) = maxval(abs(drelax))/dt
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive .and. prm%of_debug == of) then if (debugHomog%extensive .and. prm%of_debug == of) then
write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',stt%work(of) 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), & write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',dst%mismatch(1,of), &
dst%mismatch(2,of), & dst%mismatch(2,of), &
@ -432,7 +432,7 @@ module procedure mech_RGC_updateState
mech_RGC_updateState = [.true.,.false.] ! with direct cut-back mech_RGC_updateState = [.true.,.false.] ! with direct cut-back
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive .and. prm%of_debug == of) & if (debugHomog%extensive .and. prm%of_debug == of) &
write(6,'(1x,a,/)') '... broken'; flush(6) write(6,'(1x,a,/)') '... broken'; flush(6)
#endif #endif
@ -440,7 +440,7 @@ module procedure mech_RGC_updateState
else ! proceed with computing the Jacobian and state update else ! proceed with computing the Jacobian and state update
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive .and. prm%of_debug == of) & if (debugHomog%extensive .and. prm%of_debug == of) &
write(6,'(1x,a,/)') '... not yet done'; flush(6) write(6,'(1x,a,/)') '... not yet done'; flush(6)
#endif #endif
@ -497,7 +497,7 @@ module procedure mech_RGC_updateState
enddo enddo
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugHomog%extensive) then
write(6,'(1x,a30)')'Jacobian matrix of stress' write(6,'(1x,a30)')'Jacobian matrix of stress'
do i = 1,3*nIntFaceTot do i = 1,3*nIntFaceTot
write(6,'(1x,100(e11.4,1x))')(smatrix(i,j), j = 1,3*nIntFaceTot) write(6,'(1x,100(e11.4,1x))')(smatrix(i,j), j = 1,3*nIntFaceTot)
@ -557,7 +557,7 @@ module procedure mech_RGC_updateState
enddo enddo
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugHomog%extensive) then
write(6,'(1x,a30)')'Jacobian matrix of penalty' write(6,'(1x,a30)')'Jacobian matrix of penalty'
do i = 1,3*nIntFaceTot do i = 1,3*nIntFaceTot
write(6,'(1x,100(e11.4,1x))')(pmatrix(i,j), j = 1,3*nIntFaceTot) write(6,'(1x,100(e11.4,1x))')(pmatrix(i,j), j = 1,3*nIntFaceTot)
@ -576,7 +576,7 @@ module procedure mech_RGC_updateState
enddo enddo
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugHomog%extensive) then
write(6,'(1x,a30)')'Jacobian matrix of penalty' write(6,'(1x,a30)')'Jacobian matrix of penalty'
do i = 1,3*nIntFaceTot do i = 1,3*nIntFaceTot
write(6,'(1x,100(e11.4,1x))')(rmatrix(i,j), j = 1,3*nIntFaceTot) write(6,'(1x,100(e11.4,1x))')(rmatrix(i,j), j = 1,3*nIntFaceTot)
@ -591,7 +591,7 @@ module procedure mech_RGC_updateState
allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugHomog%extensive) then
write(6,'(1x,a30)')'Jacobian matrix (total)' write(6,'(1x,a30)')'Jacobian matrix (total)'
do i = 1,3*nIntFaceTot do i = 1,3*nIntFaceTot
write(6,'(1x,100(e11.4,1x))')(jmatrix(i,j), j = 1,3*nIntFaceTot) write(6,'(1x,100(e11.4,1x))')(jmatrix(i,j), j = 1,3*nIntFaceTot)
@ -607,7 +607,7 @@ module procedure mech_RGC_updateState
call math_invert(jnverse,error,jmatrix) call math_invert(jnverse,error,jmatrix)
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugHomog%extensive) then
write(6,'(1x,a30)')'Jacobian inverse' write(6,'(1x,a30)')'Jacobian inverse'
do i = 1,3*nIntFaceTot do i = 1,3*nIntFaceTot
write(6,'(1x,100(e11.4,1x))')(jnverse(i,j), j = 1,3*nIntFaceTot) write(6,'(1x,100(e11.4,1x))')(jnverse(i,j), j = 1,3*nIntFaceTot)
@ -634,7 +634,7 @@ module procedure mech_RGC_updateState
endif endif
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive) then if (debugHomog%extensive) then
write(6,'(1x,a30)')'Returned state: ' write(6,'(1x,a30)')'Returned state: '
do i = 1,size(stt%relaxationVector(:,of)) do i = 1,size(stt%relaxationVector(:,of))
write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of) write(6,'(1x,2(e15.8,1x))') stt%relaxationVector(i,of)
@ -684,7 +684,7 @@ module procedure mech_RGC_updateState
associate(prm => param(instance)) associate(prm => param(instance))
#ifdef DEBUG #ifdef DEBUG
debugActive = debug%extensive .and. prm%of_debug == of debugActive = debugHomog%extensive .and. prm%of_debug == of
if (debugActive) then if (debugActive) then
write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el
@ -794,7 +794,7 @@ module procedure mech_RGC_updateState
gVol(i)*transpose(math_inv33(fDef(:,:,i))) gVol(i)*transpose(math_inv33(fDef(:,:,i)))
#ifdef DEBUG #ifdef DEBUG
if (debug%extensive & if (debugHomog%extensive &
.and. param(instance)%of_debug == of) then .and. param(instance)%of_debug == of) then
write(6,'(1x,a30,i2)')'Volume penalty of grain: ',i write(6,'(1x,a30,i2)')'Volume penalty of grain: ',i
write(6,*) transpose(vPen(:,:,i)) write(6,*) transpose(vPen(:,:,i))