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

Merge branch 'development' into misc-improvements

This commit is contained in:
Martin Diehl 2020-07-13 13:56:04 +02:00
parent dbca47f113 76ae160352
commit 696da9865b
44 changed files with 452 additions and 514 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
PRIVATE

@ -1 +1 @@
Subproject commit 464a0ebaf2e842d50d84a32c740638b25ae11354
Subproject commit 3fc9d58a35614fd8ffa1179e634431eb457d0150

2
VERSION
View File

@ -1 +1 @@
v2.0.3-2840-ge1bbaac0
v2.0.3-2872-g0a2d3046

24
examples/ConfigFiles/debug.config
View File

@ -1,24 +0,0 @@
### debugging parameters ###
# example:
# --------
# mesh basic extensive # switches on the "basic" and "extensive" debugging in mesh-related functions/subroutines
#
debug # debug.f90, possible values: basic, extensive
math # math.f90, possible value: basic
FEsolving # FEsolving.f90, possible value: basic
mesh # mesh.f90, possible value: basic, extensive
material # material.f90, possible values: basic, extensive
lattice # lattice.f90, possible value: basic
constitutive # constitutive_*.f90 possible values: basic, extensive, selective
crystallite # crystallite.f90 possible values: basic, extensive, selective
homogenization # homogenization_*.f90 possible values: basic, extensive, selective
CPFEM # CPFEM.f90 possible values: basic, extensive, selective
spectral # DAMASK_spectral.f90 possible values: basic, fft, restart, divergence, rotation, petsc
marc # MSC.MARC FEM solver possible values: basic
#
# Parameters for selective
element 1 # selected element for debugging (synonymous: "el", "e")
integrationpoint 1 # selected integration point for debugging (synonymous: "ip", "i")
grain 1 # selected grain at ip for debugging (synonymous: "gr", "g")

20
examples/ConfigFiles/debug.yaml Normal file
View File

@ -0,0 +1,20 @@
### debugging parameters ###
## case sensitive keys
# example:
# --------
# mesh: [basic, extensive] # switches on the "basic" and "extensive" debugging in mesh-related functions/subroutines
#
mesh: [basic,extensive] # mesh.f90, possible value: basic, extensive
material: [basic, extensive] # material.f90, possible values: basic, extensive
constitutive: [basic, extensive, selective] # constitutive_*.f90 possible values: basic, extensive, selective
crystallite: [basic, extensive, selective] # crystallite.f90 possible values: basic, extensive, selective
homogenization: [basic, extensive, selective] # homogenization_*.f90 possible values: basic, extensive, selective
cpfem: [basic, extensive, selective] # CPFEM.f90 possible values: basic, extensive, selective
grid: [basic, fft, restart, divergence, rotation, petsc] # DAMASK_spectral.f90 possible values: basic, fft, restart, divergence, rotation, petsc
marc: [basic] # MSC.MARC FEM solver possible values: basic
#
# Parameters for selective
element: 1 # selected element for debugging
integrationpoint: 1 # selected integration point for debugging
grain: 1 # selected grain at ip for debugging

75
examples/ConfigFiles/numerics.config
View File

@ -1,75 +0,0 @@
### numerical parameters ###
relevantStrain 1.0e-7 # strain increment considered significant (used by crystallite to determine whether strain inc is considered significant)
defgradTolerance 1.0e-7 # deviation of deformation gradient that is still allowed (used by CPFEM to determine outdated ffn1)
iJacoStiffness 1 # frequency of stiffness update
iJacoLpresiduum 1 # frequency of Jacobian update of residuum in Lp
pert_Fg 1.0e-7 # deformation gradient perturbation for grain tangent
pert_method 1 # perturbation method (1 = forward, 2 = backward or 3 = central)
integrator 1 # integration method (1 = Fixed Point Iteration, 2 = Euler, 3 = Adaptive Euler, 4 = classical 4th order Runge-Kutta, 5 = 5th order Runge-Kutta Cash-Karp)
integratorStiffness 1 # integration method used for stiffness (1 = Fixed Point Iteration, 2 = Euler, 3 = Adaptive Euler, 4 = classical 4th order Runge-Kutta, 5 = 5th order Runge-Kutta Cash-Karp)
unitlength 1 # physical length of one computational length unit
usepingpong 1 # use the ping pong (collect <-> calc) scheme
## crystallite numerical parameters ##
nCryst 20 # crystallite loop limit (only for debugging info, loop limit is determined by "subStepMinCryst")
subStepMinCryst 1.0e-3 # minimum (relative) size of sub-step allowed during cutback in crystallite
subStepSizeCryst 0.25 # size of substep when cutback introduced in crystallite (value between 0 and 1)
stepIncreaseCryst 1.5 # increase of next substep size when previous substep converged in crystallite (value higher than 1)
nState 10 # state loop limit
nStress 40 # stress loop limit
rTol_crystalliteState 1.0e-6 # relative tolerance in crystallite state loop (abs tol provided by constitutive law)
rTol_crystalliteStress 1.0e-6 # relative tolerance in crystallite stress loop (Lp residuum)
aTol_crystalliteStress 1.0e-8 # absolute tolerance in crystallite stress loop (Lp residuum!)
rTol_crystalliteTemperature 1.0e-6 # relative tolerance in crystallite state/temperature loop
## homogenization numerical parameters ##
nHomog 20 # homogenization loop limit (only for debugging info, loop limit is determined by "subStepMinHomog")
subStepMinHomog 1.0e-3 # minimum (relative) size of sub-step allowed during cutback in homogenization
subStepSizeHomog 0.25 # size of substep when cutback introduced in homogenization (value between 0 and 1)
stepIncreaseHomog 1.5 # increase of next substep size when previous substep converged in homogenization (value higher than 1)
nMPstate 10 # materialpoint state loop limit
## RGC scheme numerical parameters ##
aTol_RGC 1.0e+4 # absolute tolerance of RGC residuum (in Pa)
rTol_RGC 1.0e-3 # relative ...
aMax_RGC 1.0e+10 # absolute upper-limit of RGC residuum (in Pa)
rMax_RGC 1.0e+2 # relative ...
perturbPenalty_RGC 1.0e-7 # perturbation for computing penalty tangent
maxRelaxation_RGC 1.0e+0 # threshold of maximum relaxation vector increment (if exceed this then cutback)
relevantMismatch_RGC 1.0e-5 # minimum threshold of mismatch
viscosityPower_RGC 1.0e+0 # power (sensitivity rate) of numerical viscosity in RGC scheme
viscosityModulus_RGC 0.0e+0 # stress modulus of RGC numerical viscosity (zero = without numerical viscosity)
# suggestion: larger than the aTol_RGC but still far below the expected flow stress of material
refRelaxationRate_RGC 1.0e-3 # reference rate of relaxation (about the same magnitude as straining rate, possibly a bit higher)
maxVolDiscrepancy_RGC 1.0e-5 # maximum allowable relative volume discrepancy
volDiscrepancyMod_RGC 1.0e+12
discrepancyPower_RGC 5.0
random_seed 0 # any integer larger than zero seeds the random generator, otherwise random seeding
## spectral parameters ##
err_div_tolAbs 1.0e-3 # absolute tolerance for fulfillment of stress equilibrium
err_div_tolRel 5.0e-4 # relative tolerance for fulfillment of stress equilibrium
err_curl_tolAbs 1.0e-12 # absolute tolerance for fulfillment of strain compatibility
err_curl_tolRel 5.0e-4 # relative tolerance for fulfillment of strain compatibility
err_stress_tolAbs 1.0e3 # absolute tolerance for fulfillment of stress BC
err_stress_tolRel 0.01 # relative tolerance for fulfillment of stress BC
fftw_timelimit -1.0 # timelimit of plan creation for FFTW, see manual on www.fftw.org, Default -1.0: disable timelimit
rotation_tol 1.0e-12 # tolerance of rotation specified in loadcase, Default 1.0e-12: first guess
fftw_plan_mode FFTW_PATIENT # reads the planing-rigor flag, see manual on www.fftw.org, Default FFTW_PATIENT: use patient planner flag
itmax 250 # Maximum iteration number
itmin 2 # Minimum iteration number
maxCutBack 3 # maximum cut back level (0: 1, 1: 0.5, 2: 0.25, etc)
memory_efficient 1 # Precalculate Gamma-operator (81 double per point)
update_gamma 0 # Update Gamma-operator with current dPdF (not possible if memory_efficient=1)
divergence_correction 2 # Use size-independent divergence criterion
spectralsolver basicPETSc # Type of spectral solver (basicPETSc/polarisation)
spectralfilter none # Type of filtering method to mitigate Gibb's phenomenon (none, cosine, ...)
petsc_options -snes_type ngmres -snes_ngmres_anderson # PetSc solver options
regridMode 0 # 0: no regrid; 1: regrid if DAMASK doesn't converge; 2: regrid if DAMASK or BVP Solver doesn't converge
polarAlpha 1.0 # polarization scheme parameter 0.0 < alpha < 2.0. alpha = 1.0 ==> AL scheme, alpha = 2.0 ==> accelerated scheme
polarBeta 1.0 # polarization scheme parameter 0.0 < beta < 2.0. beta = 1.0 ==> AL scheme, beta = 2.0 ==> accelerated scheme

89
examples/ConfigFiles/numerics.yaml Normal file
View File

@ -0,0 +1,89 @@
# Available numerical parameters
# Case sensitive keys
homogenization:
mech:
RGC:
atol: 1.0e+4 # absolute tolerance of RGC residuum (in Pa)
rtol: 1.0e-3 # relative ...
amax: 1.0e+10 # absolute upper-limit of RGC residuum (in Pa)
rmax: 1.0e+2 # relative ...
perturbpenalty: 1.0e-7 # perturbation for computing penalty tangent
relevantmismatch: 1.0e-5 # minimum threshold of mismatch
viscositypower: 1.0e+0 # power (sensitivity rate) of numerical viscosity in RGC scheme
viscositymodulus: 0.0e+0 # stress modulus of RGC numerical viscosity (zero = without numerical viscosity)
# suggestion: larger than the aTol_RGC but still far below the expected flow stress of material
refrelaxationrate: 1.0e-3 # reference rate of relaxation (about the same magnitude as straining rate, possibly a bit higher)
maxrelaxationrate: 1.0e+0 # threshold of maximum relaxation vector increment (if exceed this then cutback)
maxvoldiscrepancy: 1.0e-5 # maximum allowable relative volume discrepancy
voldiscrepancymod: 1.0e+12
discrepancypower: 5.0
generic:
subStepMin: 1.0e-3 # minimum (relative) size of sub-step allowed during cutback in homogenization
subStepSize: 0.25 # size of substep when cutback introduced in homogenization (value between 0 and 1)
stepIncrease: 1.5 # increase of next substep size when previous substep converged in homogenization (value higher than 1)
nMPstate: 10 # materialpoint state loop limit
grid:
eps_div_atol: 1.0e-3 # absolute tolerance for fulfillment of stress equilibrium
eps_div_rtol: 5.0e-4 # relative tolerance for fulfillment of stress equilibrium
eps_curl_atol: 1.0e-12 # absolute tolerance for fulfillment of strain compatibility
eps_curl_rtol: 5.0e-4 # relative tolerance for fulfillment of strain compatibility
eps_stress_atol: 1.0e3 # absolute tolerance for fulfillment of stress BC
eps_stress_rtol: 0.01 # relative tolerance for fulfillment of stress BC
eps_damage_atol: 1.0e-2 # absolute tolerance for damage evolution
eps_damage_rtol: 1.0e-6 # relative tolerance for damage evolution
eps_thermal_atol: 1.0e-2 # absolute tolerance for thermal equilibrium
eps_thermal_rtol: 1.0e-6 # relative tolerance for thermal equilibrium
itmax: 250 # Maximum iteration number
itmin: 2 # Minimum iteration number
fftw_timelimit: -1.0 # timelimit of plan creation for FFTW, see manual on www.fftw.org, Default -1.0: disable timelimit
fftw_plan_mode: FFTW_PATIENT # reads the planing-rigor flag, see manual on www.fftw.org, Default FFTW_PATIENT: use patient planner flag
maxCutBack: 3 # maximum cut back level (0: 1, 1: 0.5, 2: 0.25, etc)
maxStaggeredIter: 10 # max number of field level staggered iterations
memory_efficient: 1 # Precalculate Gamma-operator (81 double per point)
update_gamma: false # Update Gamma-operator with current dPdF (not possible if memory_efficient=1)
divergence_correction: 2 # Use size-independent divergence criterion
derivative: continuous # Approximation used for derivatives in Fourier space
solver: Basic # Type of spectral solver (BasicPETSc/Polarisation/FEM)
petsc_options: -snes_type ngmres -snes_ngmres_anderson # PetSc solver options
alpha: 1.0 # polarization scheme parameter 0.0 < alpha < 2.0. alpha = 1.0 ==> AL scheme, alpha = 2.0 ==> accelerated scheme
beta: 1.0 # polarization scheme parameter 0.0 < beta < 2.0. beta = 1.0 ==> AL scheme, beta = 2.0 ==> accelerated scheme
mesh:
maxCutBack: 3 # maximum cut back level (0: 1, 1: 0.5, 2: 0.25, etc)
maxStaggeredIter: 10 # max number of field level staggered iterations
structorder: 2 # order of displacement shape functions (when mesh is defined)
bbarstabilisation: false
integrationorder: 2 # order of quadrature rule required (when mesh is defined)
itmax: 250 # Maximum iteration number
itmin: 2 # Minimum iteration number
eps_struct_atol: 1.0e-10 # absolute tolerance for mechanical equilibrium
eps_struct_rtol: 1.0e-4 # relative tolerance for mechanical equilibrium
crystallite:
subStepMin: 1.0e-3 # minimum (relative) size of sub-step allowed during cutback in crystallite
subStepSize: 0.25 # size of substep when cutback introduced in crystallite (value between 0 and 1)
stepIncrease: 1.5 # increase of next substep size when previous substep converged in crystallite (value higher than 1)
subStepSizeLp: 0.5 # size of first substep when cutback in Lp calculation
subStepSizeLi: 0.5 # size of first substep when cutback in Li calculation
nState: 10 # state loop limit
nStress: 40 # stress loop limit
rtol_State: 1.0e-6 # relative tolerance in crystallite state loop (abs tol provided by constitutive law)
rtol_Stress: 1.0e-6 # relative tolerance in crystallite stress loop (Lp residuum)
atol_Stress: 1.0e-8 # absolute tolerance in crystallite stress loop (Lp residuum!)
integrator: FPI # integration method (FPI = Fixed Point Iteration, Euler = Euler, AdaptiveEuler = Adaptive Euler, RK4 = classical 4th order Runge-Kutta, RKCK45 = 5th order Runge-Kutta Cash-Karp)
iJacoLpresiduum: 1 # frequency of Jacobian update of residuum in Lp
commercialFEM:
ijacostiffness: 1 # frequency of stiffness update
unitlength: 1 # physical length of one computational length unit
generic:
charLength: 1.0 # characteristic length scale for gradient problems.
random_seed: 0 # fixed seeding for pseudo-random number generator, Default 0: use random seed.
residualStiffness: 1.0e-6 # non-zero residual damage.

40
src/CPFEM.f90
View File

@ -50,7 +50,19 @@ module CPFEM
end type tNumerics
type(tNumerics), private :: num
type, private :: tDebugOptions
logical :: &
basic, &
extensive, &
selective
integer:: &
element, &
ip
end type tDebugOptions
type(tDebugOptions), private :: debugCPFEM
public :: &
CPFEM_general, &
CPFEM_initAll, &
@ -93,7 +105,8 @@ end subroutine CPFEM_initAll
subroutine CPFEM_init
class(tNode), pointer :: &
num_commercialFEM
num_commercialFEM, &
debug_CPFEM
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
flush(6)
@ -107,9 +120,18 @@ subroutine CPFEM_init
num_commercialFEM => numerics_root%get('commercialFEM',defaultVal=emptyDict)
num%iJacoStiffness = num_commercialFEM%get_asInt('ijacostiffness',defaultVal=1)
if (num%iJacoStiffness < 1) call IO_error(301,ext_msg='iJacoStiffness')
!------------------------------------------------------------------------------
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then
!------------------------------------------------------------------------------
! read debug options
debug_CPFEM => debug_root%get('cpfem',defaultVal=emptyList)
debugCPFEM%basic = debug_CPFEM%contains('basic')
debugCPFEM%extensive = debug_CPFEM%contains('extensive')
debugCPFEM%selective = debug_CPFEM%contains('selective')
debugCPFEM%element = debug_root%get_asInt('element',defaultVal = 1)
debugCPFEM%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1)
if(debugCPFEM%basic) then
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_knownGood: ', shape(CPFEM_dcsdE_knownGood)
@ -150,8 +172,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
elCP = mesh_FEM2DAMASK_elem(elFE)
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt &
.and. elCP == debug_e .and. ip == debug_i) then
if (debugCPFEM%basic .and. elCP == debugCPFEM%element .and. ip == debugCPFEM%ip) then
write(6,'(/,a)') '#############################################'
write(6,'(a1,a22,1x,i8,a13)') '#','element', elCP, '#'
write(6,'(a1,a22,1x,i8,a13)') '#','ip', ip, '#'
@ -189,7 +210,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
updateJaco = mod(cycleCounter,num%iJacoStiffness) == 0
FEsolving_execElem = elCP
FEsolving_execIP = ip
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) &
if (debugCPFEM%extensive) &
write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip
call materialpoint_stressAndItsTangent(updateJaco, dt)
@ -226,9 +247,8 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
endif terminalIllness
endif validCalculation
if ((iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) &
.and. ((debug_e == elCP .and. debug_i == ip) &
.or. .not. iand(debug_level(debug_CPFEM), debug_levelSelective) /= 0_pInt)) then
if (debugCPFEM%extensive &
.and. (debugCPFEM%element == elCP .and. debugCPFEM%ip == ip) .or. .not. debugCPFEM%selective) then
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
write(6,'(a,i8,1x,i2,/,6(12x,6(f10.3,1x)/))') &

12
src/DAMASK_marc.f90
View File

@ -176,6 +176,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
use prec
use DAMASK_interface
use numerics
use YAML_types
use FEsolving
use debug
use discretization_marc
@ -252,9 +253,12 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
logical, save :: &
lastIncConverged = .false., & !< needs description
outdatedByNewInc = .false., & !< needs description
CPFEM_init_done = .false. !< remember whether init has been done already
if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0) then
CPFEM_init_done = .false., & !< remember whether init has been done already
debug_basic = .true.
class(tNode), pointer :: &
debug_Marc ! pointer to Marc debug options
if(debug_basic) then
write(6,'(a,/,i8,i8,i2)') ' MSC.MARC information on shape of element(2), IP:', m, nn
write(6,'(a,2(i1))') ' Jacobian: ', ngens,ngens
write(6,'(a,i1)') ' Direct stress: ', ndi
@ -275,6 +279,8 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
if (.not. CPFEM_init_done) then
CPFEM_init_done = .true.
call CPFEM_initAll
debug_Marc => debug_root%get('marc',defaultVal=emptyList)
debug_basic = debug_Marc%contains('basic')
endif
computationMode = 0 ! save initialization value, since it does not result in any calculation

40
src/config.f90
View File

@ -4,7 +4,6 @@
!> @details Reads the material configuration file, where solverJobName.materialConfig takes
!! precedence over material.config. Stores the raw strings and the positions of delimiters for the
!! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture'
!! Reads numerics.config and debug.config
!--------------------------------------------------------------------------------------------------
module config
use prec
@ -24,10 +23,7 @@ module config
config_homogenization, &
config_texture, &
config_crystallite
type(tPartitionedStringList), public, protected :: &
config_debug
character(len=pStringLen), public, protected, allocatable, dimension(:) :: &
config_name_phase, & !< name of each phase
config_name_homogenization, & !< name of each homogenization
@ -53,11 +49,14 @@ subroutine config_init
line, &
part
character(len=pStringLen), dimension(:), allocatable :: fileContent
logical :: fileExists
class(tNode), pointer :: &
debug_material
logical :: fileExists
write(6,'(/,a)') ' <<<+- config init -+>>>'; flush(6)
verbose = iand(debug_level(debug_material),debug_levelBasic) /= 0
debug_material => debug_root%get('material',defaultVal=emptyList)
verbose = debug_material%contains('basic')
inquire(file=trim(getSolverJobName())//'.materialConfig',exist=fileExists)
if(fileExists) then
@ -109,13 +108,6 @@ subroutine config_init
if (.not. allocated(config_texture) .or. size(config_texture) < 1) &
call IO_error(160,ext_msg='<texture>')
inquire(file='debug.config', exist=fileExists)
if (fileExists) then
write(6,'(/,a)') ' reading debug.config'; flush(6)
fileContent = IO_read_ASCII('debug.config')
call parse_debugAndNumericsConfig(config_debug,fileContent)
endif
contains
@ -238,23 +230,6 @@ subroutine parse_materialConfig(sectionNames,part,line, &
end subroutine parse_materialConfig
!--------------------------------------------------------------------------------------------------
!> @brief parses the material.config file
!--------------------------------------------------------------------------------------------------
subroutine parse_debugAndNumericsConfig(config_list, &
fileContent)
type(tPartitionedStringList), intent(out) :: config_list
character(len=pStringLen), dimension(:), intent(in) :: fileContent
integer :: i
do i = 1, size(fileContent)
call config_list%add(trim(adjustl(fileContent(i))))
enddo
end subroutine parse_debugAndNumericsConfig
end subroutine config_init
@ -279,9 +254,6 @@ subroutine config_deallocate(what)
case('material.config/texture')
deallocate(config_texture)
case('debug.config')
call config_debug%free
case default
call IO_error(0,ext_msg='config_deallocate')

24
src/constitutive.f90
View File

@ -317,6 +317,20 @@ module constitutive
end interface
type :: tDebugOptions
logical :: &
basic, &
extensive, &
selective
integer :: &
element, &
ip, &
grain
end type tDebugOptions
type(tDebugOptions) :: debugConstitutive
public :: &
plastic_nonlocal_updateCompatibility, &
constitutive_init, &
@ -341,6 +355,16 @@ subroutine constitutive_init
integer :: &
ph, & !< counter in phase loop
s !< counter in source loop
class (tNode), pointer :: &
debug_constitutive
debug_constitutive => debug_root%get('constitutive', defaultVal=emptyList)
debugConstitutive%basic = debug_constitutive%contains('basic')
debugConstitutive%extensive = debug_constitutive%contains('extensive')
debugConstitutive%selective = debug_constitutive%contains('selective')
debugConstitutive%element = debug_root%get_asInt('element',defaultVal = 1)
debugConstitutive%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1)
debugConstitutive%grain = debug_root%get_asInt('grain',defaultVal = 1)
!--------------------------------------------------------------------------------------------------
! initialized plasticity

5
src/constitutive_plastic_disloUCLA.f90
View File

@ -91,14 +91,13 @@ module subroutine plastic_disloUCLA_init
character(len=pStringLen) :: &
extmsg = ''
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_DISLOUCLA_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_DISLOUCLA_LABEL//' init -+>>>'
write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78:242–256, 2016'
write(6,'(a)') ' https://dx.doi.org/10.1016/j.ijplas.2015.09.002'
Ninstance = count(phase_plasticity == PLASTICITY_DISLOUCLA_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(param(Ninstance))
allocate(state(Ninstance))

6
src/constitutive_plastic_dislotwin.f90
View File

@ -138,7 +138,7 @@ module subroutine plastic_dislotwin_init
character(len=pStringLen) :: &
extmsg = ''
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_LABEL//' init -+>>>'
write(6,'(/,a)') ' Ma and Roters, Acta Materialia 52(12):3603–3612, 2004'
write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2004.04.012'
@ -150,9 +150,7 @@ module subroutine plastic_dislotwin_init
write(6,'(a,/)') ' https://doi.org/10.1016/j.actamat.2016.07.032'
Ninstance = count(phase_plasticity == PLASTICITY_DISLOTWIN_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(param(Ninstance))
allocate(state(Ninstance))

15
src/constitutive_plastic_isotropic.f90
View File

@ -61,14 +61,13 @@ module subroutine plastic_isotropic_init
character(len=pStringLen) :: &
extmsg = ''
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_ISOTROPIC_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_ISOTROPIC_LABEL//' init -+>>>'
write(6,'(/,a)') ' Maiti and Eisenlohr, Scripta Materialia 145:37–40, 2018'
write(6,'(a)') ' https://doi.org/10.1016/j.scriptamat.2017.09.047'
Ninstance = count(phase_plasticity == PLASTICITY_ISOTROPIC_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(param(Ninstance))
allocate(state(Ninstance))
@ -84,8 +83,8 @@ module subroutine plastic_isotropic_init
prm%output = config%getStrings('(output)',defaultVal=emptyStringArray)
#ifdef DEBUG
if (p==material_phaseAt(debug_g,debug_e)) &
prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e)
if (p==material_phaseAt(debugConstitutive%grain,debugConstitutive%element)) &
prm%of_debug = material_phasememberAt(debugConstitutive%grain,debugConstitutive%ip,debugConstitutive%element)
#endif
xi_0 = config%getFloat('tau0')
@ -183,8 +182,7 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
Lp = dot_gamma/prm%M * Mp_dev/norm_Mp_dev
#ifdef DEBUG
if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0 &
.and. (of == prm%of_debug .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0)) then
if (debugConstitutive%extensive .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then
write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CONST isotropic >> Tstar (dev) / MPa', &
transpose(Mp_dev)*1.0e-6_pReal
write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Mp_dev*1.0e-6_pReal
@ -239,8 +237,7 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of)
* tr * abs(tr)**(prm%n-1.0_pReal)
#ifdef DEBUG
if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0 &
.and. (of == prm%of_debug .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0)) then
if (debugConstitutive%extensive .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 >> gdot', prm%dot_gamma_0 * (3.0_pReal*prm%M*stt%xi(of))**(-prm%n) &
* tr * abs(tr)**(prm%n-1.0_pReal)

14
src/constitutive_plastic_kinehardening.f90
View File

@ -74,11 +74,10 @@ module subroutine plastic_kinehardening_init
character(len=pStringLen) :: &
extmsg = ''
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_KINEHARDENING_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_KINEHARDENING_LABEL//' init -+>>>'
Ninstance = count(phase_plasticity == PLASTICITY_KINEHARDENING_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(param(Ninstance))
allocate(state(Ninstance))
@ -96,8 +95,8 @@ module subroutine plastic_kinehardening_init
prm%output = config%getStrings('(output)',defaultVal=emptyStringArray)
#ifdef DEBUG
if (p==material_phaseAt(debug_g,debug_e)) then
prm%of_debug = material_phasememberAt(debug_g,debug_i,debug_e)
if (p==material_phaseAt(debugConstitutive%grain,debugConstitutive%element)) then
prm%of_debug = material_phasememberAt(debugConstitutive%grain,debugConstitutive%ip,debugConstitutive%element)
endif
#endif
@ -328,9 +327,8 @@ module subroutine plastic_kinehardening_deltaState(Mp,instance,of)
dEq0(gdot_pos+gdot_neg,1e-10_pReal)) ! current sense of shear direction
#ifdef DEBUG
if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0 &
.and. (of == prm%of_debug &
.or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0)) then
if (debugConstitutive%extensive &
.and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then
write(6,'(a)') '======= kinehardening delta state ======='
write(6,*) sense,state(instance)%sense(:,of)
endif

5
src/constitutive_plastic_none.f90
View File

@ -19,11 +19,10 @@ module subroutine plastic_none_init
p, &
NipcMyPhase
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_NONE_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_NONE_LABEL//' init -+>>>'
Ninstance = count(phase_plasticity == PLASTICITY_NONE_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
do p = 1, size(phase_plasticity)
if (phase_plasticity(p) /= PLASTICITY_NONE_ID) cycle

29
src/constitutive_plastic_nonlocal.f90
View File

@ -147,7 +147,7 @@ submodule(constitutive) plastic_nonlocal
v_scr_neg
end type tNonlocalState
type(tNonlocalState), allocatable, dimension(:) :: &
type(tNonlocalState), allocatable, dimension(:) :: &
deltaState, &
dotState, &
state, &
@ -179,7 +179,7 @@ module subroutine plastic_nonlocal_init
type(tInitialParameters) :: &
ini
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_LABEL//' init -+>>>'
write(6,'(/,a)') ' Reuber et al., Acta Materialia 71:333–348, 2014'
write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2014.03.012'
@ -188,8 +188,7 @@ module subroutine plastic_nonlocal_init
write(6,'(a)') ' http://publications.rwth-aachen.de/record/229993'
Ninstance = count(phase_plasticity == PLASTICITY_NONLOCAL_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(param(Ninstance))
allocate(state(Ninstance))
@ -710,9 +709,9 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el)
endif
#ifdef DEBUG
if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0 &
.and. ((debug_e == el .and. debug_i == ip)&
.or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0)) then
if (debugConstitutive%extensive &
.and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip)&
.or. .not. debugConstitutive%selective)) then
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(f10.5,1x))') '<< CONST >> tauThreshold / MPa', dst%tau_pass(:,of)*1e-6
@ -927,9 +926,9 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el)
del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns])
#ifdef DEBUG
if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0 &
.and. ((debug_e == el .and. debug_i == ip)&
.or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0 )) then
if (debugConstitutive%extensive &
.and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip)&
.or. .not. debugConstitutive%selective)) then
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
endif
@ -1016,9 +1015,9 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, &
gdot = rhoSgl(:,1:4) * v * spread(prm%burgers,2,4)
#ifdef DEBUG
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0 &
.and. ((debug_e == el .and. debug_i == ip)&
.or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0 )) then
if (debugConstitutive%basic &
.and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip) &
.or. .not. debugConstitutive%selective)) then
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
endif
@ -1127,7 +1126,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, &
if ( any(rho(:,mob) + rhoDot(:,1:4) * timestep < -prm%atol_rho) &
.or. any(rho(:,dip) + rhoDot(:,9:10) * timestep < -prm%atol_rho)) then
#ifdef DEBUG
if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) 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)') '<< CONST >> enforcing cutback !!!'
endif
@ -1239,7 +1238,7 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el)
.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)
#ifdef DEBUG
if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) then
if (debugConstitutive%extensive) then
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 ', &
maxval(abs(v0), abs(gdot) > 0.0_pReal &

5
src/constitutive_plastic_phenopowerlaw.f90
View File

@ -83,11 +83,10 @@ module subroutine plastic_phenopowerlaw_init
character(len=pStringLen) :: &
extmsg = ''
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_PHENOPOWERLAW_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_PHENOPOWERLAW_LABEL//' init -+>>>'
Ninstance = count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(param(Ninstance))
allocate(state(Ninstance))

58
src/crystallite.f90
View File

@ -23,7 +23,6 @@ module crystallite
use discretization
use lattice
use results
use YAML_types
implicit none
private
@ -98,6 +97,19 @@ module crystallite
type(tNumerics) :: num ! numerics parameters. Better name?
type :: tDebugOptions
logical :: &
basic, &
extensive, &
selective
integer :: &
element, &
ip, &
grain
end type tDebugOptions
type(tDebugOptions) :: debugCrystallite
procedure(integrateStateFPI), pointer :: integrateState
public :: &
@ -130,9 +142,19 @@ subroutine crystallite_init
myNcomponents !< number of components at current IP
class(tNode), pointer :: &
num_crystallite
num_crystallite, &
debug_crystallite ! pointer to debug options for crystallite
write(6,'(/,a)') ' <<<+- crystallite init -+>>>'
debug_crystallite => debug_root%get('crystallite', defaultVal=emptyList)
debugCrystallite%basic = debug_crystallite%contains('basic')
debugCrystallite%extensive = debug_crystallite%contains('extensive')
debugCrystallite%selective = debug_crystallite%contains('selective')
debugCrystallite%element = debug_root%get_asInt('element', defaultVal=1)
debugCrystallite%ip = debug_root%get_asInt('integrationpoint', defaultVal=1)
debugCrystallite%grain = debug_root%get_asInt('grain', defaultVal=1)
cMax = homogenization_maxNgrains
iMax = discretization_nIP
eMax = discretization_nElem
@ -269,7 +291,7 @@ subroutine crystallite_init
call crystallite_stressTangent
#ifdef DEBUG
if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) then
if (debugCrystallite%basic) then
write(6,'(a42,1x,i10)') ' # of elements: ', eMax
write(6,'(a42,1x,i10)') ' # of integration points/element: ', iMax
write(6,'(a42,1x,i10)') 'max # of constituents/integration point: ', cMax
@ -297,26 +319,32 @@ function crystallite_stress()
startIP, endIP, &
s
logical, dimension(homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: todo !ToDo: need to set some values to false for different Ngrains
todo = .false.
#ifdef DEBUG
if (iand(debug_level(debug_crystallite),debug_levelSelective) /= 0 &
.and. FEsolving_execElem(1) <= debug_e &
.and. debug_e <= FEsolving_execElem(2)) then
if (debugCrystallite%selective &
.and. FEsolving_execElem(1) <= debugCrystallite%element &
.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 ', &
debug_e,debug_i, debug_g
debugCrystallite%element,debugCrystallite%ip, debugCrystallite%grain
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST stress >> F ', &
transpose(crystallite_partionedF(1:3,1:3,debug_g,debug_i,debug_e))
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 ', &
transpose(crystallite_partionedF0(1:3,1:3,debug_g,debug_i,debug_e))
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', &
transpose(crystallite_partionedFp0(1:3,1:3,debug_g,debug_i,debug_e))
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', &
transpose(crystallite_partionedFi0(1:3,1:3,debug_g,debug_i,debug_e))
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', &
transpose(crystallite_partionedLp0(1:3,1:3,debug_g,debug_i,debug_e))
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', &
transpose(crystallite_partionedLi0(1:3,1:3,debug_g,debug_i,debug_e))
transpose(crystallite_partionedLi0(1:3,1:3,debugCrystallite%grain, &
debugCrystallite%ip,debugCrystallite%element))
endif
#endif
@ -362,7 +390,7 @@ function crystallite_stress()
NiterationCrystallite = NiterationCrystallite + 1
#ifdef DEBUG
if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0) &
if (debugCrystallite%extensive) &
write(6,'(a,i6)') '<< CRYST stress >> crystallite iteration ',NiterationCrystallite
#endif
!$OMP PARALLEL DO PRIVATE(formerSubStep)

192
src/debug.f90
View File

@ -8,51 +8,15 @@
module debug
use prec
use IO
use YAML_types
use YAML_parse
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
integer, parameter, private :: &
debug_MAXNTYPE = debug_MARC !< must be set to the maximum defined debug type
class(tNode), pointer, protected, public :: &
debug_root !< root pointer storing the debug YAML structure
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
#ifdef PETSc
character(len=1024), parameter, public :: &
PETSCDEBUG = ' -snes_view -snes_monitor '
#endif
public :: debug_init
contains
@ -63,11 +27,9 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine debug_init
character(len=pStringLen), dimension(:), allocatable :: fileContent
integer :: i, what, j
integer, allocatable, dimension(:) :: chunkPos
character(len=pStringLen) :: tag, line
character(len=:), allocatable :: &
debug_input, &
debug_inFlow
logical :: fexist
write(6,'(/,a)') ' <<<+- debug init -+>>>'
@ -75,144 +37,14 @@ subroutine debug_init
write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m'
#endif
inquire(file='debug.config', exist=fexist)
debug_root => emptyDict
inquire(file='debug.yaml', 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
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 ('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"
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'
debug_input = IO_read('debug.yaml')
debug_inFlow = to_flow(debug_input)
debug_root => parse_flow(debug_inFlow)
endif fileExists
!--------------------------------------------------------------------------------------------------
! output switched on (debug level for debug must be extensive)
if (iand(debug_level(debug_debug),debug_LEVELEXTENSIVE) /= 0) then
do i = 1, debug_MAXNTYPE
select case(i)
case (debug_DEBUG)
tag = ' Debug'
case (debug_MATH)
tag = ' Math'
case (debug_FESOLVING)
tag = ' FEsolving'
case (debug_MESH)
tag = ' Mesh'
case (debug_MATERIAL)
tag = ' Material'
case (debug_LATTICE)
tag = ' Lattice'
case (debug_CONSTITUTIVE)
tag = ' Constitutive'
case (debug_CRYSTALLITE)
tag = ' Crystallite'
case (debug_HOMOGENIZATION)
tag = ' Homogenizaiton'
case (debug_CPFEM)
tag = ' CPFEM'
case (debug_SPECTRAL)
tag = ' Spectral solver'
case (debug_MARC)
tag = ' MSC.MARC FEM solver'
end select
if(debug_level(i) /= 0) then
write(6,'(3a)') ' debug level for ', trim(tag), ':'
if(iand(debug_level(i),debug_LEVELBASIC) /= 0) write(6,'(a)') ' basic'
if(iand(debug_level(i),debug_LEVELEXTENSIVE) /= 0) write(6,'(a)') ' extensive'
if(iand(debug_level(i),debug_LEVELSELECTIVE) /= 0) then
write(6,'(a)') ' selective on:'
write(6,'(a24,1x,i8)') ' element: ',debug_e
write(6,'(a24,1x,i8)') ' ip: ',debug_i
write(6,'(a24,1x,i8)') ' grain: ',debug_g
endif
if(iand(debug_level(i),debug_SPECTRALRESTART) /= 0) write(6,'(a)') ' restart'
if(iand(debug_level(i),debug_SPECTRALFFTW) /= 0) write(6,'(a)') ' FFTW'
if(iand(debug_level(i),debug_SPECTRALDIVERGENCE)/= 0) write(6,'(a)') ' divergence'
if(iand(debug_level(i),debug_SPECTRALROTATION) /= 0) write(6,'(a)') ' rotation'
if(iand(debug_level(i),debug_SPECTRALPETSC) /= 0) write(6,'(a)') ' PETSc'
endif
enddo
endif
end subroutine debug_init
end module debug

11
src/grid/DAMASK_grid.f90
View File

@ -24,7 +24,6 @@ program DAMASK_grid
use grid_damage_spectral
use grid_thermal_spectral
use results
use YAML_types
implicit none
@ -93,7 +92,8 @@ program DAMASK_grid
external :: &
quit
class (tNode), pointer :: &
num_grid
num_grid, &
debug_grid ! pointer to grid debug options
!--------------------------------------------------------------------------------------------------
! init DAMASK (all modules)
@ -124,6 +124,7 @@ program DAMASK_grid
!--------------------------------------------------------------------------------------------------
! assign mechanics solver depending on selected type
debug_grid => debug_root%get('grid',defaultVal=emptyList)
select case (trim(num_grid%get_asString('solver', defaultVal = 'Basic')))
case ('Basic')
mech_init => grid_mech_spectral_basic_init
@ -133,7 +134,7 @@ program DAMASK_grid
mech_restartWrite => grid_mech_spectral_basic_restartWrite
case ('Polarisation')
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) &
if(debug_grid%contains('basic')) &
call IO_warning(42, ext_msg='debug Divergence')
mech_init => grid_mech_spectral_polarisation_init
mech_forward => grid_mech_spectral_polarisation_forward
@ -142,7 +143,7 @@ program DAMASK_grid
mech_restartWrite => grid_mech_spectral_polarisation_restartWrite
case ('FEM')
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) &
if(debug_grid%contains('basic')) &
call IO_warning(42, ext_msg='debug Divergence')
mech_init => grid_mech_FEM_init
mech_forward => grid_mech_FEM_forward
@ -340,7 +341,7 @@ program DAMASK_grid
writeHeader: if (interface_restartInc < 1) then
open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file
if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) &
if (debug_grid%contains('basic')) &
write(6,'(/,a)') ' header of statistics file written out'
flush(6)
else writeHeader

14
src/grid/discretization_grid.f90
View File

@ -57,7 +57,10 @@ subroutine discretization_grid_init(restart)
microstructureAt, &
homogenizationAt
integer :: j
integer :: &
j, &
debug_element, &
debug_ip
integer(C_INTPTR_T) :: &
devNull, z, z_offset
@ -83,6 +86,11 @@ subroutine discretization_grid_init(restart)
myGrid = [grid(1:2),grid3]
mySize = [geomSize(1:2),size3]
!-------------------------------------------------------------------------------------------------
! debug parameters
debug_element = debug_root%get_asInt('element',defaultVal=1)
debug_ip = debug_root%get_asInt('integrationpoint',defaultVal=1)
!--------------------------------------------------------------------------------------------------
! general discretization
microstructureAt = microstructureAt(product(grid(1:2))*grid3Offset+1: &
@ -120,8 +128,8 @@ subroutine discretization_grid_init(restart)
!--------------------------------------------------------------------------------------------------
! sanity checks for debugging
if (debug_e < 1 .or. debug_e > product(myGrid)) call IO_error(602,ext_msg='element') ! selected element does not exist
if (debug_i /= 1) call IO_error(602,ext_msg='IP') ! selected IP does not exist
if (debug_element < 1 .or. debug_element > product(myGrid)) call IO_error(602,ext_msg='element') ! selected element does not exist
if (debug_ip /= 1) call IO_error(602,ext_msg='IP') ! selected IP does not exist
end subroutine discretization_grid_init

13
src/grid/grid_mech_FEM.f90
View File

@ -16,7 +16,6 @@ module grid_mech_FEM
use math
use spectral_utilities
use FEsolving
use YAML_types
use numerics
use homogenization
use discretization
@ -45,6 +44,8 @@ module grid_mech_FEM
end type tNumerics
type(tNumerics), private :: num
logical, private:: &
debugRotation
!--------------------------------------------------------------------------------------------------
! PETSc data
@ -115,13 +116,19 @@ subroutine grid_mech_FEM_init
character(len=pStringLen) :: &
fileName
class(tNode), pointer :: &
num_grid
num_grid, &
debug_grid
real(pReal), dimension(3,3,3,3) :: devNull
PetscScalar, pointer, dimension(:,:,:,:) :: &
u_current,u_lastInc
write(6,'(/,a)') ' <<<+- grid_mech_FEM init -+>>>'; flush(6)
!-----------------------------------------------------------------------------------------------
! debugging options
debug_grid => debug_root%get('grid', defaultVal=emptyList)
debugRotation = debug_grid%contains('rotation')
!-------------------------------------------------------------------------------------------------
! read numerical parameter and do sanity checks
num_grid => numerics_root%get('grid',defaultVal=emptyDict)
@ -510,7 +517,7 @@ subroutine formResidual(da_local,x_local, &
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter+1, '≤', num%itmax
if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) &
if (debugRotation) &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &

14
src/grid/grid_mech_spectral_basic.f90
View File

@ -21,7 +21,6 @@ module grid_mech_spectral_basic
use homogenization
use discretization_grid
use debug
use YAML_types
implicit none
private
@ -44,6 +43,9 @@ module grid_mech_spectral_basic
type(tNumerics) :: num ! numerics parameters. Better name?
logical, private:: &
debugRotation
!--------------------------------------------------------------------------------------------------
! PETSc data
DM :: da
@ -97,7 +99,8 @@ subroutine grid_mech_spectral_basic_init
real(pReal), dimension(3,3) :: &
temp33_Real = 0.0_pReal
class (tNode), pointer :: &
num_grid
num_grid, &
debug_grid
PetscErrorCode :: ierr
PetscScalar, pointer, dimension(:,:,:,:) :: &
@ -116,6 +119,11 @@ subroutine grid_mech_spectral_basic_init
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
!-------------------------------------------------------------------------------------------------
! debugging options
debug_grid => debug_root%get('grid', defaultVal=emptyList)
debugRotation = debug_grid%contains('rotation')
!-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks
num_grid => numerics_root%get('grid',defaultVal=emptyDict)
@ -469,7 +477,7 @@ subroutine formResidual(in, F, &
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) &
if (debugRotation) &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &

14
src/grid/grid_mech_spectral_polarisation.f90
View File

@ -22,7 +22,6 @@ module grid_mech_spectral_polarisation
use homogenization
use discretization_grid
use debug
use YAML_types
implicit none
private
@ -50,6 +49,8 @@ module grid_mech_spectral_polarisation
type(tNumerics) :: num ! numerics parameters. Better name?
logical, private :: debugRotation
!--------------------------------------------------------------------------------------------------
! PETSc data
DM :: da
@ -109,7 +110,8 @@ subroutine grid_mech_spectral_polarisation_init
real(pReal), dimension(3,3) :: &
temp33_Real = 0.0_pReal
class (tNode), pointer :: &
num_grid
num_grid, &
debug_grid
PetscErrorCode :: ierr
PetscScalar, pointer, dimension(:,:,:,:) :: &
@ -127,6 +129,11 @@ subroutine grid_mech_spectral_polarisation_init
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
!------------------------------------------------------------------------------------------------
! debugging options
debug_grid => debug_root%get('grid',defaultVal=emptyList)
debugRotation = debug_grid%contains('rotation')
!-------------------------------------------------------------------------------------------------
! read numerical parameters
num_grid => numerics_root%get('grid',defaultVal=emptyDict)
@ -547,12 +554,13 @@ subroutine formResidual(in, FandF_tau, &
call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr)
if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1 ! new increment
!--------------------------------------------------------------------------------------------------
! begin of new iteration
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) &
if(debugRotation) &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &

16
src/grid/spectral_utilities.f90
View File

@ -19,7 +19,6 @@ module spectral_utilities
use config
use discretization
use homogenization
use YAML_types
implicit none
private
@ -188,8 +187,11 @@ subroutine spectral_utilities_init
scalarSize = 1_C_INTPTR_T, &
vecSize = 3_C_INTPTR_T, &
tensorSize = 9_C_INTPTR_T
class(tNode), pointer :: &
num_grid
character(len=*), parameter :: &
PETSCDEBUG = ' -snes_view -snes_monitor '
class(tNode) , pointer :: &
num_grid, &
debug_grid ! pointer to grid debug options
write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>'
@ -207,9 +209,11 @@ subroutine spectral_utilities_init
!--------------------------------------------------------------------------------------------------
! set debugging parameters
debugGeneral = iand(debug_level(debug_SPECTRAL),debug_LEVELBASIC) /= 0
debugRotation = iand(debug_level(debug_SPECTRAL),debug_SPECTRALROTATION) /= 0
debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0
debug_grid => debug_root%get('grid',defaultVal=emptyList)
debugGeneral = debug_grid%contains('basic')
debugRotation = debug_grid%contains('rotation')
debugPETSc = debug_grid%contains('petsc')
if(debugPETSc) write(6,'(3(/,a),/)') &
' Initializing PETSc with debug options: ', &

67
src/homogenization.f90
View File

@ -23,7 +23,6 @@ module homogenization
use damage_local
use damage_nonlocal
use results
use YAML_types
implicit none
private
@ -52,6 +51,19 @@ module homogenization
type(tNumerics) :: num
type :: tDebugOptions
logical :: &
basic, &
extensive, &
selective
integer :: &
element, &
ip, &
grain
end type tDebugOptions
type(tDebugOptions) :: debugHomog
interface
module subroutine mech_none_init
@ -98,19 +110,18 @@ module homogenization
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
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
@ -137,7 +148,21 @@ subroutine homogenization_init
class (tNode) , pointer :: &
num_homog, &
num_homogMech, &
num_homogGeneric
num_homogGeneric, &
debug_homogenization
debug_homogenization => debug_root%get('homogenization', defaultVal=emptyList)
debugHomog%basic = debug_homogenization%contains('basic')
debugHomog%extensive = debug_homogenization%contains('extensive')
debugHomog%selective = debug_homogenization%contains('selective')
debugHomog%element = debug_root%get_asInt('element',defaultVal = 1)
debugHomog%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1)
debugHomog%grain = debug_root%get_asInt('grain',defaultVal = 1)
if (debugHomog%grain < 1 &
.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_homogMech => num_homog%get('mech',defaultVal=emptyDict)
@ -166,9 +191,6 @@ subroutine homogenization_init
write(6,'(/,a)') ' <<<+- homogenization init -+>>>'; 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)
num%nMPstate = num_homogGeneric%get_asInt ('nMPstate', defaultVal=10)
num%subStepMinHomog = num_homogGeneric%get_asFloat('subStepMin', defaultVal=1.0e-3_pReal)
num%subStepSizeHomog = num_homogGeneric%get_asFloat('subStepSize', defaultVal=0.25_pReal)
@ -207,13 +229,14 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
doneAndHappy
#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 (debugHomog%basic) then
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', &
transpose(materialpoint_F0(1:3,1:3,debug_i,debug_e))
transpose(materialpoint_F0(1:3,1:3,debugHomog%ip,debugHomog%element))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< HOMOG >> F', &
transpose(materialpoint_F(1:3,1:3,debug_i,debug_e))
transpose(materialpoint_F(1:3,1:3,debugHomog%ip,debugHomog%element))
endif
#endif
@ -272,9 +295,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
if (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
if (debugHomog%extensive &
.and. ((e == debugHomog%element .and. i == debugHomog%ip) &
.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', &
subFrac(i,e), 'to current subFrac', &
subFrac(i,e)+subStep(i,e),'in materialpoint_stressAndItsTangent at el ip',e,i
@ -331,9 +354,9 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
subStep(i,e) = num%subStepSizeHomog * 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
if (debugHomog%extensive &
.and. ((e == debugHomog%element .and. i == debugHomog%ip) &
.or. .not. debugHomog%selective)) then
write(6,'(a,1x,f12.8,a,i8,1x,i2/)') &
'<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new subStep:',&
subStep(i,e),' at el ip',e,i

43
src/homogenization_mech_RGC.f90
View File

@ -89,7 +89,7 @@ module subroutine mech_RGC_init(num_homogMech)
class (tNode), pointer :: &
num_RGC ! pointer to RGC numerics data
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>'; flush(6)
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'
@ -98,8 +98,7 @@ module subroutine mech_RGC_init(num_homogMech)
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
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(param(Ninstance))
allocate(state(Ninstance))
@ -145,8 +144,8 @@ module subroutine mech_RGC_init(num_homogMech)
config => config_homogenization(h))
#ifdef DEBUG
if (h==material_homogenizationAt(debug_e)) then
prm%of_debug = material_homogenizationMemberAt(debug_i,debug_e)
if (h==material_homogenizationAt(debugHomog%element)) then
prm%of_debug = material_homogenizationMemberAt(debugHomog%ip,debugHomog%element)
endif
#endif
@ -230,7 +229,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
#ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then
if (debugHomog%extensive) 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)
@ -293,7 +292,7 @@ module procedure mech_RGC_updateState
drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of)
#ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then
if (debugHomog%extensive) 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)
@ -311,7 +310,7 @@ module procedure mech_RGC_updateState
call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of)
#ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then
if (debugHomog%extensive) 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)
@ -359,7 +358,7 @@ module procedure mech_RGC_updateState
enddo
#ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then
if (debugHomog%extensive) 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,*)' '
@ -373,7 +372,7 @@ module procedure mech_RGC_updateState
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
if (debugHomog%extensive .and. prm%of_debug == of) then
stresLoc = maxloc(abs(P))
residLoc = maxloc(abs(tract))
write(6,'(1x,a)')' '
@ -393,7 +392,7 @@ module procedure mech_RGC_updateState
if (residMax < num%rtol*stresMax .or. residMax < num%atol) then
mech_RGC_updateState = .true.
#ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) &
if (debugHomog%extensive .and. prm%of_debug == of) &
write(6,'(1x,a55,/)')'... done and happy'; flush(6)
#endif
@ -413,7 +412,7 @@ module procedure mech_RGC_updateState
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
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,3(1x,e15.8))')'Magnitude mismatch: ',dst%mismatch(1,of), &
dst%mismatch(2,of), &
@ -434,7 +433,7 @@ module procedure mech_RGC_updateState
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) &
if (debugHomog%extensive .and. prm%of_debug == of) &
write(6,'(1x,a,/)') '... broken'; flush(6)
#endif
@ -442,7 +441,7 @@ module procedure mech_RGC_updateState
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) &
if (debugHomog%extensive .and. prm%of_debug == of) &
write(6,'(1x,a,/)') '... not yet done'; flush(6)
#endif
@ -499,7 +498,7 @@ module procedure mech_RGC_updateState
enddo
#ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0) then
if (debugHomog%extensive) 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)
@ -559,7 +558,7 @@ module procedure mech_RGC_updateState
enddo
#ifdef DEBUG
if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then
if (debugHomog%extensive) 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)
@ -578,7 +577,7 @@ module procedure mech_RGC_updateState
enddo
#ifdef DEBUG
if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then
if (debugHomog%extensive) 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)
@ -593,7 +592,7 @@ module procedure mech_RGC_updateState
allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix
#ifdef DEBUG
if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then
if (debugHomog%extensive) 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)
@ -609,7 +608,7 @@ module procedure mech_RGC_updateState
call math_invert(jnverse,error,jmatrix)
#ifdef DEBUG
if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then
if (debugHomog%extensive) 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)
@ -636,7 +635,7 @@ module procedure mech_RGC_updateState
endif
#ifdef DEBUG
if (iand(debug_homogenization, debug_levelExtensive) > 0) then
if (debugHomog%extensive) 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)
@ -686,7 +685,7 @@ module procedure mech_RGC_updateState
associate(prm => param(instance))
#ifdef DEBUG
debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of
debugActive = debugHomog%extensive .and. prm%of_debug == of
if (debugActive) then
write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el
@ -796,7 +795,7 @@ module procedure mech_RGC_updateState
gVol(i)*transpose(math_inv33(fDef(:,:,i)))
#ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 &
if (debugHomog%extensive &
.and. param(instance)%of_debug == of) then
write(6,'(1x,a30,i2)')'Volume penalty of grain: ',i
write(6,*) transpose(vPen(:,:,i))

3
src/homogenization_mech_isostrain.f90
View File

@ -38,8 +38,7 @@ module subroutine mech_isostrain_init
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_LABEL//' init -+>>>'
Ninstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)
if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(param(Ninstance)) ! one container of parameters per instance

5
src/homogenization_mech_none.f90
View File

@ -18,11 +18,10 @@ module subroutine mech_none_init
h, &
NofMyHomog
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>'
Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID)
if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
do h = 1, size(homogenization_type)
if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle

6
src/kinematics_cleavage_opening.f90
View File

@ -8,7 +8,6 @@ module kinematics_cleavage_opening
use prec
use IO
use config
use debug
use math
use lattice
use material
@ -49,11 +48,10 @@ subroutine kinematics_cleavage_opening_init
integer, dimension(:), allocatable :: N_cl !< active number of cleavage systems per family
character(len=pStringLen) :: extmsg = ''
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_CLEAVAGE_OPENING_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_CLEAVAGE_OPENING_LABEL//' init -+>>>'
Ninstance = count(phase_kinematics == KINEMATICS_CLEAVAGE_OPENING_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0)
allocate(param(Ninstance))

6
src/kinematics_slipplane_opening.f90
View File

@ -8,7 +8,6 @@ module kinematics_slipplane_opening
use prec
use config
use IO
use debug
use math
use lattice
use material
@ -52,11 +51,10 @@ subroutine kinematics_slipplane_opening_init
integer, dimension(:), allocatable :: N_sl
real(pReal), dimension(:,:), allocatable :: d,n,t
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_SLIPPLANE_OPENING_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_SLIPPLANE_OPENING_LABEL//' init -+>>>'
Ninstance = count(phase_kinematics == KINEMATICS_SLIPPLANE_OPENING_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0)
allocate(param(Ninstance))

6
src/kinematics_thermal_expansion.f90
View File

@ -7,7 +7,6 @@ module kinematics_thermal_expansion
use prec
use IO
use config
use debug
use math
use lattice
use material
@ -43,11 +42,10 @@ subroutine kinematics_thermal_expansion_init
integer :: Ninstance,p,i
real(pReal), dimension(:), allocatable :: temp
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>'
Ninstance = count(phase_kinematics == KINEMATICS_thermal_expansion_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(kinematics_thermal_expansion_instance(size(config_phase)), source=0)
allocate(param(Ninstance))

13
src/marc/discretization_marc.f90
View File

@ -13,7 +13,6 @@ module discretization_marc
use IO
use debug
use numerics
use YAML_types
use FEsolving
use element
use discretization
@ -58,7 +57,8 @@ subroutine discretization_marc_init
homogenizationAt
integer:: &
Nnodes, & !< total number of nodes in the mesh
Nelems !< total number of elements in the mesh
Nelems, & !< total number of elements in the mesh
debug_e, debug_i
real(pReal), dimension(:,:), allocatable :: &
IP_reshaped
@ -73,7 +73,14 @@ subroutine discretization_marc_init
num_commercialFEM
write(6,'(/,a)') ' <<<+- discretization_marc init -+>>>'; flush(6)
!---------------------------------------------------------------------------------
! read debug parameters
debug_e = debug_root%get_asInt('element',defaultVal=1)
debug_i = debug_root%get_asInt('integrationpoint',defaultVal=1)
!--------------------------------------------------------------------------------
! read numerics parameter and do sanity check
num_commercialFEM => numerics_root%get('commercialFEM',defaultVal = emptyDict)
mesh_unitlength = num_commercialFEM%get_asFloat('unitlength',defaultVal=1.0_pReal) ! set physical extent of a length unit in mesh
if (mesh_unitlength <= 0.0_pReal) call IO_error(301,ext_msg='unitlength')

15
src/material.f90
View File

@ -215,22 +215,23 @@ subroutine material_init(restart)
integer, dimension(:), allocatable :: &
CounterPhase, &
CounterHomogenization
myDebug = debug_level(debug_material)
class(tNode), pointer :: &
debug_material ! pointer to material debug options
write(6,'(/,a)') ' <<<+- material init -+>>>'; flush(6)
debug_material => debug_root%get('material',defaultVal=emptyList)
call material_parsePhase()
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase parsed'; flush(6)
if (debug_material%contains('basic')) write(6,'(a)') ' Phase parsed'; flush(6)
call material_parseMicrostructure()
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6)
if (debug_material%contains('basic')) write(6,'(a)') ' Microstructure parsed'; flush(6)
call material_parseHomogenization()
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6)
if (debug_material%contains('basic')) write(6,'(a)') ' Homogenization parsed'; flush(6)
call material_parseTexture()
if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture parsed'; flush(6)
if (debug_material%contains('basic')) write(6,'(a)') ' Texture parsed'; flush(6)
material_Nphase = size(config_phase)
material_Nhomogenization = size(config_homogenization)
@ -266,7 +267,7 @@ subroutine material_init(restart)
enddo
if(homogenization_maxNgrains > size(microstructure_phase,1)) call IO_error(148)
debugOut: if (iand(myDebug,debug_levelExtensive) /= 0) then
debugOut: if (debug_material%contains('extensive')) then
write(6,'(/,a,/)') ' MATERIAL configuration'
write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains'
do h = 1,size(config_homogenization)

1
src/mesh/DAMASK_mesh.f90
View File

@ -16,7 +16,6 @@ program DAMASK_mesh
use CPFEM2
use FEsolving
use numerics
use YAML_types
use discretization_mesh
use FEM_Utilities
use mesh_mech_FEM

11
src/mesh/FEM_utilities.f90
View File

@ -15,7 +15,6 @@ module FEM_utilities
use FEsolving
use homogenization
use numerics
use YAML_types
use debug
use math
use discretization_mesh
@ -104,8 +103,12 @@ subroutine FEM_utilities_init
character(len=pStringLen) :: petsc_optionsOrder
class(tNode), pointer :: &
num_mesh
num_mesh, &
debug_mesh ! pointer to mesh debug options
integer :: structOrder !< order of displacement shape functions
character(len=*), parameter :: &
PETSCDEBUG = ' -snes_view -snes_monitor '
PetscErrorCode :: ierr
write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>'
@ -115,7 +118,9 @@ subroutine FEM_utilities_init
!--------------------------------------------------------------------------------------------------
! set debugging parameters
debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0
debug_mesh => debug_root%get('mesh',defaultVal=emptyList)
debugPETSc = debug_mesh%contains('petsc')
if(debugPETSc) write(6,'(3(/,a),/)') &
' Initializing PETSc with debug options: ', &
trim(PETScDebug), &

14
src/mesh/discretization_mesh.f90
View File

@ -68,7 +68,8 @@ subroutine discretization_mesh_init(restart)
integer, allocatable, dimension(:) :: chunkPos
integer :: dimPlex, &
mesh_Nnodes, & !< total number of nodes in mesh
j, l
j, l, &
debug_element, debug_ip
PetscSF :: sf
DM :: globalMesh
PetscInt :: nFaceSets
@ -85,9 +86,16 @@ subroutine discretization_mesh_init(restart)
write(6,'(/,a)') ' <<<+- mesh init -+>>>'
!--------------------------------------------------------------------------------
! read numerics parameter
num_mesh => numerics_root%get('mesh',defaultVal=emptyDict)
integrationOrder = num_mesh%get_asInt('integrationorder',defaultVal = 2)
!---------------------------------------------------------------------------------
! read debug parameters
debug_element = debug_root%get_asInt('element',defaultVal=1)
debug_ip = debug_root%get_asInt('integrationpoint',defaultVal=1)
call DMPlexCreateFromFile(PETSC_COMM_WORLD,geometryFile,PETSC_TRUE,globalMesh,ierr)
CHKERRQ(ierr)
@ -164,8 +172,8 @@ subroutine discretization_mesh_init(restart)
CHKERRQ(ierr)
end do
if (debug_e < 1 .or. debug_e > mesh_NcpElems) call IO_error(602,ext_msg='element')
if (debug_i < 1 .or. debug_i > mesh_maxNips) call IO_error(602,ext_msg='IP')
if (debug_element < 1 .or. debug_element > mesh_NcpElems) call IO_error(602,ext_msg='element')
if (debug_ip < 1 .or. debug_ip > mesh_maxNips) call IO_error(602,ext_msg='IP')
FEsolving_execElem = [1,mesh_NcpElems] ! parallel loop bounds set to comprise all DAMASK elements
FEsolving_execIP = [1,mesh_maxNips]

1
src/mesh/mesh_mech_FEM.f90
View File

@ -19,7 +19,6 @@ module mesh_mech_FEM
use discretization_mesh
use DAMASK_interface
use numerics
use YAML_types
use FEM_quadrature
use homogenization
use math

6
src/source_damage_anisoBrittle.f90
View File

@ -6,7 +6,6 @@
!--------------------------------------------------------------------------------------------------
module source_damage_anisoBrittle
use prec
use debug
use IO
use math
use discretization
@ -59,11 +58,10 @@ subroutine source_damage_anisoBrittle_init
integer, dimension(:), allocatable :: N_cl
character(len=pStringLen) :: extmsg = ''
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>'
Ninstance = count(phase_source == SOURCE_DAMAGE_ANISOBRITTLE_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(source_damage_anisoBrittle_offset (size(config_phase)), source=0)
allocate(source_damage_anisoBrittle_instance(size(config_phase)), source=0)

6
src/source_damage_anisoDuctile.f90
View File

@ -6,7 +6,6 @@
!--------------------------------------------------------------------------------------------------
module source_damage_anisoDuctile
use prec
use debug
use IO
use math
use discretization
@ -52,11 +51,10 @@ subroutine source_damage_anisoDuctile_init
integer, dimension(:), allocatable :: N_sl
character(len=pStringLen) :: extmsg = ''
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>'
Ninstance = count(phase_source == SOURCE_DAMAGE_ANISODUCTILE_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(source_damage_anisoDuctile_offset (size(config_phase)), source=0)
allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0)

6
src/source_damage_isoBrittle.f90
View File

@ -6,7 +6,6 @@
!--------------------------------------------------------------------------------------------------
module source_damage_isoBrittle
use prec
use debug
use IO
use math
use discretization
@ -50,11 +49,10 @@ subroutine source_damage_isoBrittle_init
integer :: Ninstance,sourceOffset,NipcMyPhase,p
character(len=pStringLen) :: extmsg = ''
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>'
Ninstance = count(phase_source == SOURCE_DAMAGE_ISOBRITTLE_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(source_damage_isoBrittle_offset (size(config_phase)), source=0)
allocate(source_damage_isoBrittle_instance(size(config_phase)), source=0)

6
src/source_damage_isoDuctile.f90
View File

@ -6,7 +6,6 @@
!--------------------------------------------------------------------------------------------------
module source_damage_isoDuctile
use prec
use debug
use IO
use discretization
use material
@ -49,11 +48,10 @@ subroutine source_damage_isoDuctile_init
integer :: Ninstance,sourceOffset,NipcMyPhase,p
character(len=pStringLen) :: extmsg = ''
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>'
Ninstance = count(phase_source == SOURCE_DAMAGE_ISODUCTILE_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(source_damage_isoDuctile_offset (size(config_phase)), source=0)
allocate(source_damage_isoDuctile_instance(size(config_phase)), source=0)

6
src/source_thermal_dissipation.f90
View File

@ -6,7 +6,6 @@
!--------------------------------------------------------------------------------------------------
module source_thermal_dissipation
use prec
use debug
use discretization
use material
use config
@ -41,11 +40,10 @@ subroutine source_thermal_dissipation_init
integer :: Ninstance,sourceOffset,NipcMyPhase,p
write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_dissipation_label//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_dissipation_label//' init -+>>>'
Ninstance = count(phase_source == SOURCE_THERMAL_DISSIPATION_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(source_thermal_dissipation_offset (size(config_phase)), source=0)
allocate(source_thermal_dissipation_instance(size(config_phase)), source=0)

6
src/source_thermal_externalheat.f90
View File

@ -6,7 +6,6 @@
!--------------------------------------------------------------------------------------------------
module source_thermal_externalheat
use prec
use debug
use discretization
use material
use config
@ -45,11 +44,10 @@ subroutine source_thermal_externalheat_init
integer :: Ninstance,sourceOffset,NipcMyPhase,p
write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_externalheat_label//' init -+>>>'; flush(6)
write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_externalheat_label//' init -+>>>'
Ninstance = count(phase_source == SOURCE_thermal_externalheat_ID)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6)
allocate(source_thermal_externalheat_offset (size(config_phase)), source=0)
allocate(source_thermal_externalheat_instance(size(config_phase)), source=0)