'num' structure for data to avoid multiple reading of parameters
This commit is contained in:
parent
fdf7887b47
commit
692fc98fd5
|
@ -5,7 +5,6 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
module CPFEM
|
||||
use prec
|
||||
use numerics
|
||||
use debug
|
||||
use FEsolving
|
||||
use math
|
||||
|
@ -45,6 +44,13 @@ module CPFEM
|
|||
CPFEM_BACKUPJACOBIAN = 2_pInt**2_pInt, &
|
||||
CPFEM_RESTOREJACOBIAN = 2_pInt**3_pInt
|
||||
|
||||
type, private :: tNumerics
|
||||
integer :: &
|
||||
iJacoStiffness !< frequency of stiffness update
|
||||
end type tNumerics
|
||||
|
||||
type(tNumerics), private :: num
|
||||
|
||||
public :: &
|
||||
CPFEM_general, &
|
||||
CPFEM_initAll, &
|
||||
|
@ -86,6 +92,9 @@ end subroutine CPFEM_initAll
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine CPFEM_init
|
||||
|
||||
class(tNode), pointer :: &
|
||||
num_commercialFEM
|
||||
|
||||
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
|
||||
flush(6)
|
||||
|
||||
|
@ -93,6 +102,13 @@ subroutine CPFEM_init
|
|||
allocate(CPFEM_dcsdE( 6,6,discretization_nIP,discretization_nElem), source= 0.0_pReal)
|
||||
allocate(CPFEM_dcsdE_knownGood(6,6,discretization_nIP,discretization_nElem), source= 0.0_pReal)
|
||||
|
||||
!------------------------------------------------------------------------------
|
||||
! read numerical parameters and do sanity check
|
||||
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
|
||||
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs)
|
||||
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE)
|
||||
|
@ -125,21 +141,12 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
|
|||
H
|
||||
|
||||
integer(pInt) elCP, & ! crystal plasticity element number
|
||||
i, j, k, l, m, n, ph, homog, mySource, &
|
||||
iJacoStiffness !< frequency of stiffness update
|
||||
i, j, k, l, m, n, ph, homog, mySource
|
||||
logical updateJaco ! flag indicating if Jacobian has to be updated
|
||||
|
||||
real(pReal), parameter :: ODD_STRESS = 1e15_pReal, & !< return value for stress if terminallyIll
|
||||
ODD_JACOBIAN = 1e50_pReal !< return value for jacobian if terminallyIll
|
||||
|
||||
class(tNode), pointer :: &
|
||||
num_commercialFEM
|
||||
|
||||
!------------------------------------------------------------------------------
|
||||
! read numerical parameters and do sanity check
|
||||
num_commercialFEM => numerics_root%get('commercialFEM',defaultVal=emptyDict)
|
||||
iJacoStiffness = num_commercialFEM%get_asInt('ijacostiffness',defaultVal=1)
|
||||
if (iJacoStiffness < 1) call IO_error(301,ext_msg='iJacoStiffness')
|
||||
|
||||
elCP = mesh_FEM2DAMASK_elem(elFE)
|
||||
|
||||
|
@ -179,7 +186,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
|
|||
CPFEM_dcsde(1:6,1:6,ip,elCP) = ODD_JACOBIAN * math_identity2nd(6)
|
||||
|
||||
else validCalculation
|
||||
updateJaco = mod(cycleCounter,iJacoStiffness) == 0
|
||||
updateJaco = mod(cycleCounter,num%iJacoStiffness) == 0
|
||||
FEsolving_execElem = elCP
|
||||
FEsolving_execIP = ip
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) &
|
||||
|
|
|
@ -23,9 +23,16 @@ module damage_local
|
|||
output
|
||||
end type tParameters
|
||||
|
||||
type, private :: tNumerics
|
||||
real(pReal) :: &
|
||||
residualStiffness !< non-zero residual damage
|
||||
end type tNumerics
|
||||
|
||||
type(tparameters), dimension(:), allocatable :: &
|
||||
param
|
||||
|
||||
type(tNumerics), private :: num
|
||||
|
||||
public :: &
|
||||
damage_local_init, &
|
||||
damage_local_updateState, &
|
||||
|
@ -40,9 +47,17 @@ contains
|
|||
subroutine damage_local_init
|
||||
|
||||
integer :: Ninstance,NofMyHomog,h
|
||||
class(tNode), pointer :: num_generic
|
||||
|
||||
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>'; flush(6)
|
||||
|
||||
!----------------------------------------------------------------------------------------------
|
||||
! read numerics parameter and do sanity check
|
||||
num_generic => numerics_root%get('generic',defaultVal=emptyDict)
|
||||
num%residualStiffness = num_generic%get_asFloat('residualStiffness', defaultVal=1.0e-6_pReal)
|
||||
if (num%residualStiffness < 0.0_pReal) call IO_error(301,ext_msg='residualStiffness')
|
||||
!----------------------------------------------------------------------------------------------
|
||||
|
||||
Ninstance = count(damage_type == DAMAGE_local_ID)
|
||||
allocate(param(Ninstance))
|
||||
|
||||
|
@ -85,20 +100,14 @@ function damage_local_updateState(subdt, ip, el)
|
|||
homog, &
|
||||
offset
|
||||
real(pReal) :: &
|
||||
phi, phiDot, dPhiDot_dPhi, &
|
||||
residualStiffness !< non-zero residual damage
|
||||
class(tNode), pointer :: &
|
||||
num_generic
|
||||
phi, phiDot, dPhiDot_dPhi
|
||||
|
||||
num_generic => numerics_root%get('generic',defaultVal=emptyDict)
|
||||
residualStiffness = num_generic%get_asFloat('residualStiffness', defaultVal=1.0e-6_pReal)
|
||||
if (residualStiffness < 0.0_pReal) call IO_error(301,ext_msg='residualStiffness')
|
||||
|
||||
|
||||
homog = material_homogenizationAt(el)
|
||||
offset = material_homogenizationMemberAt(ip,el)
|
||||
phi = damageState(homog)%subState0(1,offset)
|
||||
call damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
|
||||
phi = max(residualStiffness,min(1.0_pReal,phi + subdt*phiDot))
|
||||
phi = max(num%residualStiffness,min(1.0_pReal,phi + subdt*phiDot))
|
||||
|
||||
damage_local_updateState = [ abs(phi - damageState(homog)%state(1,offset)) &
|
||||
<= 1.0e-2_pReal &
|
||||
|
|
|
@ -24,8 +24,15 @@ module damage_nonlocal
|
|||
output
|
||||
end type tParameters
|
||||
|
||||
type, private :: tNumerics
|
||||
real(pReal) :: &
|
||||
charLength !< characteristic length scale for gradient problems
|
||||
end type tNumerics
|
||||
|
||||
type(tparameters), dimension(:), allocatable :: &
|
||||
param
|
||||
type(tNumerics), private :: &
|
||||
num
|
||||
|
||||
public :: &
|
||||
damage_nonlocal_init, &
|
||||
|
@ -44,9 +51,17 @@ contains
|
|||
subroutine damage_nonlocal_init
|
||||
|
||||
integer :: Ninstance,NofMyHomog,h
|
||||
|
||||
class(tNode), pointer :: &
|
||||
num_generic
|
||||
|
||||
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>'; flush(6)
|
||||
|
||||
!------------------------------------------------------------------------------------
|
||||
! read numerics parameter
|
||||
num_generic => numerics_root%get('generic',defaultVal= emptyDict)
|
||||
num%charLength = num_generic%get_asFloat('charLength',defaultVal=1.0_pReal)
|
||||
!------------------------------------------------------------------------------------
|
||||
|
||||
Ninstance = count(damage_type == DAMAGE_nonlocal_ID)
|
||||
allocate(param(Ninstance))
|
||||
|
||||
|
@ -139,13 +154,6 @@ function damage_nonlocal_getDiffusion(ip,el)
|
|||
integer :: &
|
||||
homog, &
|
||||
grain
|
||||
real(pReal) :: &
|
||||
charLength !< characteristic length scale for gradient problems
|
||||
class(tNode), pointer :: &
|
||||
num_generic
|
||||
|
||||
num_generic => numerics_root%get('generic',defaultVal= emptyDict)
|
||||
charLength = num_generic%get_asFloat('charLength',defaultVal=1.0_pReal)
|
||||
|
||||
homog = material_homogenizationAt(el)
|
||||
damage_nonlocal_getDiffusion = 0.0_pReal
|
||||
|
@ -155,7 +163,7 @@ function damage_nonlocal_getDiffusion(ip,el)
|
|||
enddo
|
||||
|
||||
damage_nonlocal_getDiffusion = &
|
||||
charLength**2*damage_nonlocal_getDiffusion/real(homogenization_Ngrains(homog),pReal)
|
||||
num%charLength**2*damage_nonlocal_getDiffusion/real(homogenization_Ngrains(homog),pReal)
|
||||
|
||||
end function damage_nonlocal_getDiffusion
|
||||
|
||||
|
|
|
@ -61,7 +61,6 @@ program DAMASK_grid
|
|||
i, j, k, l, field, &
|
||||
errorID = 0, &
|
||||
cutBackLevel = 0, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
|
||||
maxCutBack, & !< max number of cut backs
|
||||
stepFraction = 0 !< fraction of current time interval
|
||||
integer :: &
|
||||
currentLoadcase = 0, & !< current load case
|
||||
|
@ -69,12 +68,18 @@ program DAMASK_grid
|
|||
totalIncsCounter = 0, & !< total # of increments
|
||||
statUnit = 0, & !< file unit for statistics output
|
||||
stagIter, &
|
||||
stagItMax, & !< max number of field level staggered iterations
|
||||
nActiveFields = 0
|
||||
character(len=pStringLen), dimension(:), allocatable :: fileContent
|
||||
character(len=pStringLen) :: &
|
||||
incInfo, &
|
||||
loadcase_string
|
||||
type :: tNumerics
|
||||
integer :: &
|
||||
maxCutBack, & !< max number of cut backs
|
||||
stagItMax !< max number of field level staggered iterations
|
||||
end type tNumerics
|
||||
|
||||
type(tNumerics) :: num
|
||||
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
|
||||
type(tLoadCase) :: newLoadCase
|
||||
type(tSolutionState), allocatable, dimension(:) :: solres
|
||||
|
@ -114,11 +119,11 @@ program DAMASK_grid
|
|||
!-------------------------------------------------------------------------------------------------
|
||||
! reading field paramters from numerics file and do sanity checks
|
||||
num_grid => numerics_root%get('grid', defaultVal=emptyDict)
|
||||
stagItMax = num_grid%get_asInt('maxStaggeredIter',defaultVal=10)
|
||||
maxCutBack = num_grid%get_asInt('maxCutBack',defaultVal=3)
|
||||
num%stagItMax = num_grid%get_asInt('maxStaggeredIter',defaultVal=10)
|
||||
num%maxCutBack = num_grid%get_asInt('maxCutBack',defaultVal=3)
|
||||
|
||||
if (stagItMax < 0) call IO_error(301,ext_msg='maxStaggeredIter')
|
||||
if (maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack')
|
||||
if (num%stagItMax < 0) call IO_error(301,ext_msg='maxStaggeredIter')
|
||||
if (num%maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack')
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! assign mechanics solver depending on selected type
|
||||
|
@ -449,7 +454,7 @@ program DAMASK_grid
|
|||
|
||||
enddo
|
||||
stagIter = stagIter + 1
|
||||
stagIterate = stagIter < stagItMax &
|
||||
stagIterate = stagIter < num%stagItMax &
|
||||
.and. all(solres(:)%converged) &
|
||||
.and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration
|
||||
enddo
|
||||
|
@ -468,7 +473,7 @@ program DAMASK_grid
|
|||
solres%converged, solres%iterationsNeeded
|
||||
flush(statUnit)
|
||||
endif
|
||||
elseif (cutBackLevel < maxCutBack) then ! further cutbacking tolerated?
|
||||
elseif (cutBackLevel < num%maxCutBack) then ! further cutbacking tolerated?
|
||||
cutBack = .true.
|
||||
stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator
|
||||
cutBackLevel = cutBackLevel + 1
|
||||
|
|
17
src/math.f90
17
src/math.f90
|
@ -72,6 +72,14 @@ module math
|
|||
3,2, &
|
||||
3,3 &
|
||||
],shape(MAPPLAIN)) !< arrangement in Plain notation
|
||||
|
||||
type, private :: tNumerics
|
||||
integer :: &
|
||||
randomSeed !< fixed seeding for pseudo-random number generator, Default 0: use random seed
|
||||
|
||||
end type
|
||||
|
||||
type(tNumerics), private :: num
|
||||
|
||||
interface math_eye
|
||||
module procedure math_identity2nd
|
||||
|
@ -91,8 +99,7 @@ subroutine math_init
|
|||
|
||||
real(pReal), dimension(4) :: randTest
|
||||
integer :: &
|
||||
randSize, &
|
||||
randomSeed !< fixed seeding for pseudo-random number generator, Default 0: use random seed
|
||||
randSize
|
||||
integer, dimension(:), allocatable :: randInit
|
||||
class(tNode), pointer :: &
|
||||
num_generic
|
||||
|
@ -100,12 +107,12 @@ subroutine math_init
|
|||
write(6,'(/,a)') ' <<<+- math init -+>>>'; flush(6)
|
||||
|
||||
num_generic => numerics_root%get('generic',defaultVal=emptyDict)
|
||||
randomSeed = num_generic%get_asInt('random_seed', defaultVal = 0)
|
||||
num%randomSeed = num_generic%get_asInt('random_seed', defaultVal = 0)
|
||||
|
||||
call random_seed(size=randSize)
|
||||
allocate(randInit(randSize))
|
||||
if (randomSeed > 0) then
|
||||
randInit = randomSeed
|
||||
if (num%randomSeed > 0) then
|
||||
randInit = num%randomSeed
|
||||
else
|
||||
call random_seed()
|
||||
call random_seed(get = randInit)
|
||||
|
|
Loading…
Reference in New Issue