Merge branch 'marc-mesh-simplification' into development
This commit is contained in:
Martin Diehl
commit
589f534334
2
PRIVATE
2
PRIVATE
|
|
@ -1 +1 @@
|
|||
Subproject commit 64cda1c010d500f662cd9a298c7b7ad10ab91c3c
|
||||
Subproject commit 93bc0c8a1de2944add043b58159bf9b6e4193752
|
||||
|
|
@ -267,7 +267,7 @@ class Test():
|
|||
logging.critical('Current2Current: Unable to copy file "{}"'.format(f))
|
||||
raise
|
||||
|
||||
def execute_inCurrentDir(self,cmd,streamIn=None):
|
||||
def execute_inCurrentDir(self,cmd,streamIn=None,env=None):
|
||||
|
||||
logging.info(cmd)
|
||||
out,error = damask.util.execute(cmd,streamIn,self.dirCurrent())
|
||||
|
|
|
|||
|
|
@ -97,14 +97,17 @@ def strikeout(what):
|
|||
# -----------------------------
|
||||
def execute(cmd,
|
||||
streamIn = None,
|
||||
wd = './'):
|
||||
wd = './',
|
||||
env = None):
|
||||
"""Executes a command in given directory and returns stdout and stderr for optional stdin"""
|
||||
initialPath = os.getcwd()
|
||||
os.chdir(wd)
|
||||
myEnv = os.environ if env is None else env
|
||||
process = subprocess.Popen(shlex.split(cmd),
|
||||
stdout = subprocess.PIPE,
|
||||
stderr = subprocess.PIPE,
|
||||
stdin = subprocess.PIPE)
|
||||
stdin = subprocess.PIPE,
|
||||
env = myEnv)
|
||||
out,error = [i for i in (process.communicate() if streamIn is None
|
||||
else process.communicate(streamIn.read().encode('utf-8')))]
|
||||
out = out.decode('utf-8').replace('\x08','')
|
||||
|
|
|
|||
203
src/CPFEM.f90
203
src/CPFEM.f90
|
|
@ -5,9 +5,27 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
module CPFEM
|
||||
use prec
|
||||
use numerics
|
||||
use debug
|
||||
use FEsolving
|
||||
use math
|
||||
use mesh
|
||||
use material
|
||||
use config
|
||||
use crystallite
|
||||
use homogenization
|
||||
use IO
|
||||
use discretization
|
||||
use DAMASK_interface
|
||||
use numerics
|
||||
use HDF5_utilities
|
||||
use results
|
||||
use lattice
|
||||
use constitutive
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
real(pReal), parameter, private :: &
|
||||
CPFEM_odd_stress = 1e15_pReal, & !< return value for stress in case of ping pong dummy cycle
|
||||
CPFEM_odd_jacobian = 1e50_pReal !< return value for jacobian in case of ping pong dummy cycle
|
||||
|
|
@ -55,38 +73,6 @@ contains
|
|||
!> @brief call (thread safe) all module initializations
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine CPFEM_initAll(el,ip)
|
||||
use numerics, only: &
|
||||
numerics_init
|
||||
use debug, only: &
|
||||
debug_init
|
||||
use config, only: &
|
||||
config_init
|
||||
use FEsolving, only: &
|
||||
FE_init
|
||||
use math, only: &
|
||||
math_init
|
||||
use mesh, only: &
|
||||
mesh_init
|
||||
use material, only: &
|
||||
material_init
|
||||
#ifdef DAMASK_HDF5
|
||||
use HDF5_utilities, only: &
|
||||
HDF5_utilities_init
|
||||
use results, only: &
|
||||
results_init
|
||||
#endif
|
||||
use lattice, only: &
|
||||
lattice_init
|
||||
use constitutive, only: &
|
||||
constitutive_init
|
||||
use crystallite, only: &
|
||||
crystallite_init
|
||||
use homogenization, only: &
|
||||
homogenization_init
|
||||
use IO, only: &
|
||||
IO_init
|
||||
use DAMASK_interface
|
||||
|
||||
integer(pInt), intent(in) :: el, & !< FE el number
|
||||
ip !< FE integration point number
|
||||
|
||||
|
|
@ -100,12 +86,12 @@ subroutine CPFEM_initAll(el,ip)
|
|||
call config_init
|
||||
call math_init
|
||||
call FE_init
|
||||
call mesh_init(ip, el)
|
||||
call lattice_init
|
||||
#ifdef DAMASK_HDF5
|
||||
call HDF5_utilities_init
|
||||
call results_init
|
||||
#endif
|
||||
call mesh_init(ip, el)
|
||||
call lattice_init
|
||||
call material_init
|
||||
call constitutive_init
|
||||
call crystallite_init
|
||||
|
|
@ -122,42 +108,15 @@ end subroutine CPFEM_initAll
|
|||
!> @brief allocate the arrays defined in module CPFEM and initialize them
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine CPFEM_init
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_CPFEM, &
|
||||
debug_levelBasic, &
|
||||
debug_levelExtensive
|
||||
use FEsolving, only: &
|
||||
symmetricSolver, &
|
||||
restartRead, &
|
||||
modelName
|
||||
use mesh, only: &
|
||||
theMesh
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
homogState, &
|
||||
phase_plasticity, &
|
||||
plasticState
|
||||
use config, only: &
|
||||
material_Nhomogenization
|
||||
use crystallite, only: &
|
||||
crystallite_F0, &
|
||||
crystallite_Fp0, &
|
||||
crystallite_Lp0, &
|
||||
crystallite_Fi0, &
|
||||
crystallite_Li0, &
|
||||
crystallite_S0
|
||||
|
||||
integer :: k,l,m,ph,homog
|
||||
|
||||
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
|
||||
flush(6)
|
||||
|
||||
allocate(CPFEM_cs( 6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
|
||||
allocate(CPFEM_dcsdE( 6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
|
||||
allocate(CPFEM_dcsdE_knownGood(6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal)
|
||||
allocate(CPFEM_cs( 6,discretization_nIP,discretization_nElem), source= 0.0_pReal)
|
||||
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)
|
||||
|
||||
! *** restore the last converged values of each essential variable from the binary file
|
||||
!if (restartRead) then
|
||||
|
|
@ -238,86 +197,6 @@ end subroutine CPFEM_init
|
|||
!> @brief perform initialization at first call, update variables and call the actual material model
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyStress, jacobian)
|
||||
use numerics, only: &
|
||||
defgradTolerance, &
|
||||
iJacoStiffness
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_CPFEM, &
|
||||
debug_levelBasic, &
|
||||
debug_levelExtensive, &
|
||||
debug_levelSelective, &
|
||||
debug_stressMaxLocation, &
|
||||
debug_stressMinLocation, &
|
||||
debug_jacobianMaxLocation, &
|
||||
debug_jacobianMinLocation, &
|
||||
debug_stressMax, &
|
||||
debug_stressMin, &
|
||||
debug_jacobianMax, &
|
||||
debug_jacobianMin, &
|
||||
debug_e, &
|
||||
debug_i
|
||||
use FEsolving, only: &
|
||||
terminallyIll, &
|
||||
FEsolving_execElem, &
|
||||
FEsolving_execIP, &
|
||||
restartWrite
|
||||
use math, only: &
|
||||
math_identity2nd, &
|
||||
math_det33, &
|
||||
math_delta, &
|
||||
math_sym3333to66, &
|
||||
math_66toSym3333, &
|
||||
math_sym33to6, &
|
||||
math_6toSym33
|
||||
use mesh, only: &
|
||||
mesh_FEasCP, &
|
||||
theMesh, &
|
||||
mesh_element
|
||||
use material, only: &
|
||||
microstructure_elemhomo, &
|
||||
plasticState, &
|
||||
sourceState, &
|
||||
homogState, &
|
||||
thermalState, &
|
||||
damageState, &
|
||||
phaseAt, phasememberAt, &
|
||||
material_phase, &
|
||||
phase_plasticity, &
|
||||
temperature, &
|
||||
thermalMapping, &
|
||||
thermal_type, &
|
||||
THERMAL_conduction_ID, &
|
||||
phase_Nsources, &
|
||||
material_homogenizationAt
|
||||
use config, only: &
|
||||
material_Nhomogenization
|
||||
use crystallite, only: &
|
||||
crystallite_partionedF,&
|
||||
crystallite_F0, &
|
||||
crystallite_Fp0, &
|
||||
crystallite_Fp, &
|
||||
crystallite_Fi0, &
|
||||
crystallite_Fi, &
|
||||
crystallite_Lp0, &
|
||||
crystallite_Lp, &
|
||||
crystallite_Li0, &
|
||||
crystallite_Li, &
|
||||
crystallite_dPdF, &
|
||||
crystallite_S0, &
|
||||
crystallite_S
|
||||
use homogenization, only: &
|
||||
materialpoint_F, &
|
||||
materialpoint_F0, &
|
||||
materialpoint_P, &
|
||||
materialpoint_dPdF, &
|
||||
materialpoint_results, &
|
||||
materialpoint_sizeResults, &
|
||||
materialpoint_stressAndItsTangent, &
|
||||
materialpoint_postResults
|
||||
use IO, only: &
|
||||
IO_warning
|
||||
use DAMASK_interface
|
||||
|
||||
integer(pInt), intent(in) :: elFE, & !< FE element number
|
||||
ip !< integration point number
|
||||
|
|
@ -380,7 +259,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
|
|||
enddo; enddo
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
|
||||
write(6,'(a)') '<< CPFEM >> aging states'
|
||||
if (debug_e <= theMesh%Nelems .and. debug_i <= theMesh%elem%nIPs) then
|
||||
if (debug_e <= discretization_nElem .and. debug_i <=discretization_nIP) then
|
||||
write(6,'(a,1x,i8,1x,i2,1x,i4,/,(12x,6(e20.8,1x)),/)') &
|
||||
'<< CPFEM >> aged state of elFE ip grain',debug_e, debug_i, 1, &
|
||||
plasticState(phaseAt(1,debug_i,debug_e))%state(:,phasememberAt(1,debug_i,debug_e))
|
||||
|
|
@ -464,7 +343,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
|
|||
!* If no parallel execution is required, there is no need to collect FEM input
|
||||
|
||||
if (.not. parallelExecution) then
|
||||
chosenThermal1: select case (thermal_type(mesh_element(3,elCP)))
|
||||
chosenThermal1: select case (thermal_type(material_homogenizationAt(elCP)))
|
||||
case (THERMAL_conduction_ID) chosenThermal1
|
||||
temperature(material_homogenizationAt(elCP))%p(thermalMapping(material_homogenizationAt(elCP))%p(ip,elCP)) = &
|
||||
temperature_inp
|
||||
|
|
@ -477,7 +356,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
|
|||
if (rnd < 0.5_pReal) rnd = rnd - 1.0_pReal
|
||||
CPFEM_cs(1:6,ip,elCP) = rnd * CPFEM_odd_stress
|
||||
CPFEM_dcsde(1:6,1:6,ip,elCP) = CPFEM_odd_jacobian * math_identity2nd(6)
|
||||
chosenThermal2: select case (thermal_type(mesh_element(3,elCP)))
|
||||
chosenThermal2: select case (thermal_type(material_homogenizationAt(elCP)))
|
||||
case (THERMAL_conduction_ID) chosenThermal2
|
||||
temperature(material_homogenizationAt(elCP))%p(thermalMapping(material_homogenizationAt(elCP))%p(ip,elCP)) = &
|
||||
temperature_inp
|
||||
|
|
@ -520,15 +399,12 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
|
|||
if (.not. parallelExecution) then
|
||||
FEsolving_execElem(1) = elCP
|
||||
FEsolving_execElem(2) = elCP
|
||||
if (.not. microstructure_elemhomo(mesh_element(4,elCP)) .or. & ! calculate unless homogeneous
|
||||
(microstructure_elemhomo(mesh_element(4,elCP)) .and. ip == 1_pInt)) then ! and then only first ip
|
||||
FEsolving_execIP(1,elCP) = ip
|
||||
FEsolving_execIP(2,elCP) = ip
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) &
|
||||
write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip
|
||||
call materialpoint_stressAndItsTangent(updateJaco, dt) ! calculate stress and its tangent
|
||||
call materialpoint_postResults()
|
||||
endif
|
||||
FEsolving_execIP(1,elCP) = ip
|
||||
FEsolving_execIP(2,elCP) = ip
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) &
|
||||
write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip
|
||||
call materialpoint_stressAndItsTangent(updateJaco, dt) ! calculate stress and its tangent
|
||||
call materialpoint_postResults()
|
||||
|
||||
!* parallel computation and calulation not yet done
|
||||
|
||||
|
|
@ -551,13 +427,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
|
|||
|
||||
else terminalIllness
|
||||
|
||||
if (microstructure_elemhomo(mesh_element(4,elCP)) .and. ip > 1_pInt) then ! me homogenous? --> copy from first ip
|
||||
materialpoint_P(1:3,1:3,ip,elCP) = materialpoint_P(1:3,1:3,1,elCP)
|
||||
materialpoint_F(1:3,1:3,ip,elCP) = materialpoint_F(1:3,1:3,1,elCP)
|
||||
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,elCP) = materialpoint_dPdF(1:3,1:3,1:3,1:3,1,elCP)
|
||||
materialpoint_results(1:materialpoint_sizeResults,ip,elCP) = &
|
||||
materialpoint_results(1:materialpoint_sizeResults,1,elCP)
|
||||
endif
|
||||
|
||||
! translate from P to CS
|
||||
Kirchhoff = matmul(materialpoint_P(1:3,1:3,ip,elCP), transpose(materialpoint_F(1:3,1:3,ip,elCP)))
|
||||
|
|
@ -632,14 +501,6 @@ end subroutine CPFEM_general
|
|||
!> @brief triggers writing of the results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine CPFEM_results(inc,time)
|
||||
#ifdef DAMASK_HDF5
|
||||
use results
|
||||
use HDF5_utilities
|
||||
#endif
|
||||
use constitutive, only: &
|
||||
constitutive_results
|
||||
use crystallite, only: &
|
||||
crystallite_results
|
||||
|
||||
integer(pInt), intent(in) :: inc
|
||||
real(pReal), intent(in) :: time
|
||||
|
|
|
|||
410
src/CPFEM2.f90
410
src/CPFEM2.f90
|
|
@ -4,14 +4,35 @@
|
|||
!> @brief needs a good name and description
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module CPFEM2
|
||||
use prec
|
||||
use numerics
|
||||
use debug
|
||||
use config
|
||||
use FEsolving
|
||||
use math
|
||||
use mesh
|
||||
use material
|
||||
use lattice
|
||||
use IO
|
||||
use HDF5
|
||||
use DAMASK_interface
|
||||
use results
|
||||
use discretization
|
||||
use HDF5_utilities
|
||||
use homogenization
|
||||
use constitutive
|
||||
use crystallite
|
||||
#ifdef FEM
|
||||
use FEM_Zoo
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
private
|
||||
implicit none
|
||||
private
|
||||
|
||||
public :: &
|
||||
CPFEM_age, &
|
||||
CPFEM_initAll, &
|
||||
CPFEM_results
|
||||
public :: &
|
||||
CPFEM_age, &
|
||||
CPFEM_initAll, &
|
||||
CPFEM_results
|
||||
|
||||
contains
|
||||
|
||||
|
|
@ -19,65 +40,29 @@ contains
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief call (thread safe) all module initializations
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine CPFEM_initAll()
|
||||
use prec, only: &
|
||||
prec_init
|
||||
use numerics, only: &
|
||||
numerics_init
|
||||
use debug, only: &
|
||||
debug_init
|
||||
use config, only: &
|
||||
config_init
|
||||
use FEsolving, only: &
|
||||
FE_init
|
||||
use math, only: &
|
||||
math_init
|
||||
use mesh, only: &
|
||||
mesh_init
|
||||
use material, only: &
|
||||
material_init
|
||||
use HDF5_utilities, only: &
|
||||
HDF5_utilities_init
|
||||
use results, only: &
|
||||
results_init
|
||||
use lattice, only: &
|
||||
lattice_init
|
||||
use constitutive, only: &
|
||||
constitutive_init
|
||||
use crystallite, only: &
|
||||
crystallite_init
|
||||
use homogenization, only: &
|
||||
homogenization_init, &
|
||||
materialpoint_postResults
|
||||
use IO, only: &
|
||||
IO_init
|
||||
use DAMASK_interface
|
||||
#ifdef FEM
|
||||
use FEM_Zoo, only: &
|
||||
FEM_Zoo_init
|
||||
#endif
|
||||
subroutine CPFEM_initAll
|
||||
|
||||
call DAMASK_interface_init ! Spectral and FEM interface to commandline
|
||||
call prec_init
|
||||
call IO_init
|
||||
call DAMASK_interface_init ! Spectral and FEM interface to commandline
|
||||
call prec_init
|
||||
call IO_init
|
||||
#ifdef FEM
|
||||
call FEM_Zoo_init
|
||||
call FEM_Zoo_init
|
||||
#endif
|
||||
call numerics_init
|
||||
call debug_init
|
||||
call config_init
|
||||
call math_init
|
||||
call FE_init
|
||||
call mesh_init
|
||||
call lattice_init
|
||||
call HDF5_utilities_init
|
||||
call results_init
|
||||
call material_init
|
||||
call constitutive_init
|
||||
call crystallite_init
|
||||
call homogenization_init
|
||||
call materialpoint_postResults
|
||||
call CPFEM_init
|
||||
call numerics_init
|
||||
call debug_init
|
||||
call config_init
|
||||
call math_init
|
||||
call FE_init
|
||||
call mesh_init
|
||||
call lattice_init
|
||||
call HDF5_utilities_init
|
||||
call results_init
|
||||
call material_init
|
||||
call constitutive_init
|
||||
call crystallite_init
|
||||
call homogenization_init
|
||||
call materialpoint_postResults
|
||||
call CPFEM_init
|
||||
|
||||
end subroutine CPFEM_initAll
|
||||
|
||||
|
|
@ -85,86 +70,51 @@ end subroutine CPFEM_initAll
|
|||
!> @brief allocate the arrays defined in module CPFEM and initialize them
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine CPFEM_init
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use numerics, only: &
|
||||
worldrank
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_CPFEM, &
|
||||
debug_levelBasic, &
|
||||
debug_levelExtensive
|
||||
use FEsolving, only: &
|
||||
restartRead
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
homogState, &
|
||||
phase_plasticity, &
|
||||
plasticState
|
||||
use config, only: &
|
||||
material_Nhomogenization
|
||||
use crystallite, only: &
|
||||
crystallite_F0, &
|
||||
crystallite_Fp0, &
|
||||
crystallite_Lp0, &
|
||||
crystallite_Fi0, &
|
||||
crystallite_Li0, &
|
||||
crystallite_S0
|
||||
use hdf5
|
||||
use HDF5_utilities, only: &
|
||||
HDF5_openFile, &
|
||||
HDF5_closeFile, &
|
||||
HDF5_openGroup, &
|
||||
HDF5_closeGroup, &
|
||||
HDF5_read
|
||||
use DAMASK_interface, only: &
|
||||
getSolverJobName
|
||||
|
||||
|
||||
integer :: ph,homog
|
||||
character(len=1024) :: rankStr, PlasticItem, HomogItem
|
||||
integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID
|
||||
integer :: ph,homog
|
||||
character(len=1024) :: rankStr, PlasticItem, HomogItem
|
||||
integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID
|
||||
|
||||
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
|
||||
flush(6)
|
||||
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
|
||||
flush(6)
|
||||
|
||||
! *** restore the last converged values of each essential variable from the binary file
|
||||
if (restartRead) then
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0) then
|
||||
write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from hdf5 file'
|
||||
flush(6)
|
||||
endif
|
||||
|
||||
write(rankStr,'(a1,i0)')'_',worldrank
|
||||
! *** restore the last converged values of each essential variable from the binary file
|
||||
if (restartRead) then
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0) then
|
||||
write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from hdf5 file'
|
||||
flush(6)
|
||||
endif
|
||||
|
||||
write(rankStr,'(a1,i0)')'_',worldrank
|
||||
|
||||
fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5')
|
||||
|
||||
call HDF5_read(fileHandle,material_phase, 'recordedPhase')
|
||||
call HDF5_read(fileHandle,crystallite_F0, 'convergedF')
|
||||
call HDF5_read(fileHandle,crystallite_Fp0, 'convergedFp')
|
||||
call HDF5_read(fileHandle,crystallite_Fi0, 'convergedFi')
|
||||
call HDF5_read(fileHandle,crystallite_Lp0, 'convergedLp')
|
||||
call HDF5_read(fileHandle,crystallite_Li0, 'convergedLi')
|
||||
call HDF5_read(fileHandle,crystallite_S0, 'convergedS')
|
||||
fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5')
|
||||
|
||||
groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases')
|
||||
do ph = 1,size(phase_plasticity)
|
||||
write(PlasticItem,*) ph,'_'
|
||||
call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
|
||||
enddo
|
||||
call HDF5_closeGroup(groupPlasticID)
|
||||
|
||||
groupHomogID = HDF5_openGroup(fileHandle,'HomogStates')
|
||||
do homog = 1, material_Nhomogenization
|
||||
write(HomogItem,*) homog,'_'
|
||||
call HDF5_read(groupHomogID,homogState(homog)%state0, trim(HomogItem)//'convergedStateHomog')
|
||||
enddo
|
||||
call HDF5_closeGroup(groupHomogID)
|
||||
call HDF5_read(fileHandle,material_phase, 'recordedPhase')
|
||||
call HDF5_read(fileHandle,crystallite_F0, 'convergedF')
|
||||
call HDF5_read(fileHandle,crystallite_Fp0, 'convergedFp')
|
||||
call HDF5_read(fileHandle,crystallite_Fi0, 'convergedFi')
|
||||
call HDF5_read(fileHandle,crystallite_Lp0, 'convergedLp')
|
||||
call HDF5_read(fileHandle,crystallite_Li0, 'convergedLi')
|
||||
call HDF5_read(fileHandle,crystallite_S0, 'convergedS')
|
||||
|
||||
groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases')
|
||||
do ph = 1,size(phase_plasticity)
|
||||
write(PlasticItem,*) ph,'_'
|
||||
call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
|
||||
enddo
|
||||
call HDF5_closeGroup(groupPlasticID)
|
||||
|
||||
groupHomogID = HDF5_openGroup(fileHandle,'HomogStates')
|
||||
do homog = 1, material_Nhomogenization
|
||||
write(HomogItem,*) homog,'_'
|
||||
call HDF5_read(groupHomogID,homogState(homog)%state0, trim(HomogItem)//'convergedStateHomog')
|
||||
enddo
|
||||
call HDF5_closeGroup(groupHomogID)
|
||||
|
||||
call HDF5_closeFile(fileHandle)
|
||||
|
||||
restartRead = .false.
|
||||
endif
|
||||
call HDF5_closeFile(fileHandle)
|
||||
|
||||
restartRead = .false.
|
||||
endif
|
||||
|
||||
end subroutine CPFEM_init
|
||||
|
||||
|
|
@ -172,115 +122,70 @@ end subroutine CPFEM_init
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief forwards data after successful increment
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine CPFEM_age()
|
||||
use prec, only: &
|
||||
pReal
|
||||
use numerics, only: &
|
||||
worldrank
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_CPFEM, &
|
||||
debug_levelBasic, &
|
||||
debug_levelExtensive, &
|
||||
debug_levelSelective
|
||||
use FEsolving, only: &
|
||||
restartWrite
|
||||
use material, only: &
|
||||
plasticState, &
|
||||
sourceState, &
|
||||
homogState, &
|
||||
thermalState, &
|
||||
damageState, &
|
||||
material_phase, &
|
||||
phase_plasticity, &
|
||||
phase_Nsources
|
||||
use config, only: &
|
||||
material_Nhomogenization
|
||||
use crystallite, only: &
|
||||
crystallite_partionedF,&
|
||||
crystallite_F0, &
|
||||
crystallite_Fp0, &
|
||||
crystallite_Fp, &
|
||||
crystallite_Fi0, &
|
||||
crystallite_Fi, &
|
||||
crystallite_Lp0, &
|
||||
crystallite_Lp, &
|
||||
crystallite_Li0, &
|
||||
crystallite_Li, &
|
||||
crystallite_S0, &
|
||||
crystallite_S
|
||||
use HDF5_utilities, only: &
|
||||
HDF5_openFile, &
|
||||
HDF5_closeFile, &
|
||||
HDF5_addGroup, &
|
||||
HDF5_closeGroup, &
|
||||
HDF5_write
|
||||
use hdf5
|
||||
use DAMASK_interface, only: &
|
||||
getSolverJobName
|
||||
subroutine CPFEM_age
|
||||
|
||||
integer :: i, ph, homog, mySource
|
||||
character(len=32) :: rankStr, PlasticItem, HomogItem
|
||||
integer(HID_T) :: fileHandle, groupPlastic, groupHomog
|
||||
integer :: i, ph, homog, mySource
|
||||
character(len=32) :: rankStr, PlasticItem, HomogItem
|
||||
integer(HID_T) :: fileHandle, groupPlastic, groupHomog
|
||||
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
|
||||
write(6,'(a)') '<< CPFEM >> aging states'
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
|
||||
write(6,'(a)') '<< CPFEM >> aging states'
|
||||
|
||||
crystallite_F0 = crystallite_partionedF
|
||||
crystallite_Fp0 = crystallite_Fp
|
||||
crystallite_Lp0 = crystallite_Lp
|
||||
crystallite_Fi0 = crystallite_Fi
|
||||
crystallite_Li0 = crystallite_Li
|
||||
crystallite_S0 = crystallite_S
|
||||
crystallite_F0 = crystallite_partionedF
|
||||
crystallite_Fp0 = crystallite_Fp
|
||||
crystallite_Lp0 = crystallite_Lp
|
||||
crystallite_Fi0 = crystallite_Fi
|
||||
crystallite_Li0 = crystallite_Li
|
||||
crystallite_S0 = crystallite_S
|
||||
|
||||
do i = 1, size(plasticState)
|
||||
plasticState(i)%state0 = plasticState(i)%state
|
||||
enddo
|
||||
do i = 1, size(sourceState)
|
||||
do mySource = 1,phase_Nsources(i)
|
||||
sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state
|
||||
enddo; enddo
|
||||
do homog = 1, material_Nhomogenization
|
||||
homogState (homog)%state0 = homogState (homog)%state
|
||||
thermalState (homog)%state0 = thermalState (homog)%state
|
||||
damageState (homog)%state0 = damageState (homog)%state
|
||||
enddo
|
||||
do i = 1, size(plasticState)
|
||||
plasticState(i)%state0 = plasticState(i)%state
|
||||
enddo
|
||||
do i = 1, size(sourceState)
|
||||
do mySource = 1,phase_Nsources(i)
|
||||
sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state
|
||||
enddo; enddo
|
||||
do homog = 1, material_Nhomogenization
|
||||
homogState (homog)%state0 = homogState (homog)%state
|
||||
thermalState (homog)%state0 = thermalState (homog)%state
|
||||
damageState (homog)%state0 = damageState (homog)%state
|
||||
enddo
|
||||
|
||||
if (restartWrite) then
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
|
||||
write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file'
|
||||
|
||||
write(rankStr,'(a1,i0)')'_',worldrank
|
||||
fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','a')
|
||||
|
||||
call HDF5_write(fileHandle,material_phase, 'recordedPhase')
|
||||
call HDF5_write(fileHandle,crystallite_F0, 'convergedF')
|
||||
call HDF5_write(fileHandle,crystallite_Fp0, 'convergedFp')
|
||||
call HDF5_write(fileHandle,crystallite_Fi0, 'convergedFi')
|
||||
call HDF5_write(fileHandle,crystallite_Lp0, 'convergedLp')
|
||||
call HDF5_write(fileHandle,crystallite_Li0, 'convergedLi')
|
||||
call HDF5_write(fileHandle,crystallite_S0, 'convergedS')
|
||||
|
||||
groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases')
|
||||
do ph = 1,size(phase_plasticity)
|
||||
write(PlasticItem,*) ph,'_'
|
||||
call HDF5_write(groupPlastic,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
|
||||
enddo
|
||||
call HDF5_closeGroup(groupPlastic)
|
||||
if (restartWrite) then
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
|
||||
write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file'
|
||||
|
||||
write(rankStr,'(a1,i0)')'_',worldrank
|
||||
fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','a')
|
||||
|
||||
call HDF5_write(fileHandle,material_phase, 'recordedPhase')
|
||||
call HDF5_write(fileHandle,crystallite_F0, 'convergedF')
|
||||
call HDF5_write(fileHandle,crystallite_Fp0, 'convergedFp')
|
||||
call HDF5_write(fileHandle,crystallite_Fi0, 'convergedFi')
|
||||
call HDF5_write(fileHandle,crystallite_Lp0, 'convergedLp')
|
||||
call HDF5_write(fileHandle,crystallite_Li0, 'convergedLi')
|
||||
call HDF5_write(fileHandle,crystallite_S0, 'convergedS')
|
||||
|
||||
groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases')
|
||||
do ph = 1,size(phase_plasticity)
|
||||
write(PlasticItem,*) ph,'_'
|
||||
call HDF5_write(groupPlastic,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
|
||||
enddo
|
||||
call HDF5_closeGroup(groupPlastic)
|
||||
|
||||
groupHomog = HDF5_addGroup(fileHandle,'HomogStates')
|
||||
do homog = 1, material_Nhomogenization
|
||||
write(HomogItem,*) homog,'_'
|
||||
call HDF5_write(groupHomog,homogState(homog)%state0,trim(HomogItem)//'convergedStateHomog')
|
||||
enddo
|
||||
call HDF5_closeGroup(groupHomog)
|
||||
|
||||
call HDF5_closeFile(fileHandle)
|
||||
restartWrite = .false.
|
||||
endif
|
||||
groupHomog = HDF5_addGroup(fileHandle,'HomogStates')
|
||||
do homog = 1, material_Nhomogenization
|
||||
write(HomogItem,*) homog,'_'
|
||||
call HDF5_write(groupHomog,homogState(homog)%state0,trim(HomogItem)//'convergedStateHomog')
|
||||
enddo
|
||||
call HDF5_closeGroup(groupHomog)
|
||||
|
||||
call HDF5_closeFile(fileHandle)
|
||||
restartWrite = .false.
|
||||
endif
|
||||
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
|
||||
write(6,'(a)') '<< CPFEM >> done aging states'
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
|
||||
write(6,'(a)') '<< CPFEM >> done aging states'
|
||||
|
||||
end subroutine CPFEM_age
|
||||
|
||||
|
|
@ -289,25 +194,18 @@ end subroutine CPFEM_age
|
|||
!> @brief triggers writing of the results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine CPFEM_results(inc,time)
|
||||
use results
|
||||
use HDF5_utilities
|
||||
use homogenization, only: &
|
||||
homogenization_results
|
||||
use constitutive, only: &
|
||||
constitutive_results
|
||||
use crystallite, only: &
|
||||
crystallite_results
|
||||
|
||||
integer, intent(in) :: inc
|
||||
real(pReal), intent(in) :: time
|
||||
|
||||
call results_openJobFile
|
||||
call results_addIncrement(inc,time)
|
||||
call constitutive_results
|
||||
call crystallite_results
|
||||
call homogenization_results
|
||||
call results_removeLink('current') ! ToDo: put this into closeJobFile
|
||||
call results_closeJobFile
|
||||
integer, intent(in) :: inc
|
||||
real(pReal), intent(in) :: time
|
||||
|
||||
call results_openJobFile
|
||||
call results_addIncrement(inc,time)
|
||||
call constitutive_results
|
||||
call crystallite_results
|
||||
call homogenization_results
|
||||
call discretization_results
|
||||
call results_removeLink('current') ! ToDo: put this into closeJobFile
|
||||
call results_closeJobFile
|
||||
|
||||
end subroutine CPFEM_results
|
||||
|
||||
|
|
|
|||
|
|
@ -40,12 +40,6 @@ module DAMASK_interface
|
|||
setSIGTERM, &
|
||||
setSIGUSR1, &
|
||||
setSIGUSR2
|
||||
private :: &
|
||||
setWorkingDirectory, &
|
||||
getGeometryFile, &
|
||||
getLoadCaseFile, &
|
||||
rectifyPath, &
|
||||
makeRelativePath
|
||||
|
||||
contains
|
||||
|
||||
|
|
|
|||
|
|
@ -29,9 +29,18 @@
|
|||
#include "prec.f90"
|
||||
|
||||
module DAMASK_interface
|
||||
use prec
|
||||
#if __INTEL_COMPILER >= 1800
|
||||
use, intrinsic :: iso_fortran_env, only: &
|
||||
compiler_version, &
|
||||
compiler_options
|
||||
#endif
|
||||
use ifport, only: &
|
||||
CHDIR
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
character(len=4), parameter, public :: InputFileExtension = '.dat'
|
||||
character(len=4), parameter, public :: LogFileExtension = '.log'
|
||||
|
||||
|
|
@ -45,15 +54,7 @@ contains
|
|||
!> @brief reports and sets working directory
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine DAMASK_interface_init
|
||||
#if __INTEL_COMPILER >= 1800
|
||||
use, intrinsic :: iso_fortran_env, only: &
|
||||
compiler_version, &
|
||||
compiler_options
|
||||
#endif
|
||||
use ifport, only: &
|
||||
CHDIR
|
||||
|
||||
implicit none
|
||||
integer, dimension(8) :: &
|
||||
dateAndTime
|
||||
integer :: ierr
|
||||
|
|
@ -96,9 +97,7 @@ end subroutine DAMASK_interface_init
|
|||
!> @brief solver job name (no extension) as combination of geometry and load case name
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function getSolverJobName()
|
||||
use prec
|
||||
|
||||
implicit none
|
||||
character(1024) :: getSolverJobName, inputName
|
||||
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
|
||||
integer :: extPos
|
||||
|
|
@ -115,8 +114,6 @@ end function getSolverJobName
|
|||
end module DAMASK_interface
|
||||
|
||||
|
||||
|
||||
|
||||
#include "commercialFEM_fileList.f90"
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
@ -132,47 +129,11 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
|
|||
strechn1,eigvn1,ncrd,itel,ndeg,ndm,nnode, &
|
||||
jtype,lclass,ifr,ifu)
|
||||
use prec
|
||||
use numerics, only: &
|
||||
!$ DAMASK_NumThreadsInt, &
|
||||
numerics_unitlength, &
|
||||
usePingPong
|
||||
use FEsolving, only: &
|
||||
calcMode, &
|
||||
terminallyIll, &
|
||||
symmetricSolver
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_LEVELBASIC, &
|
||||
debug_MARC, &
|
||||
debug_info, &
|
||||
debug_reset
|
||||
use mesh, only: &
|
||||
theMesh, &
|
||||
mesh_FEasCP, &
|
||||
mesh_element, &
|
||||
mesh_node0, &
|
||||
mesh_node, &
|
||||
mesh_Ncellnodes, &
|
||||
mesh_cellnode, &
|
||||
mesh_build_cellnodes, &
|
||||
mesh_build_ipCoordinates
|
||||
use CPFEM, only: &
|
||||
CPFEM_general, &
|
||||
CPFEM_init_done, &
|
||||
CPFEM_initAll, &
|
||||
CPFEM_CALCRESULTS, &
|
||||
CPFEM_AGERESULTS, &
|
||||
CPFEM_COLLECT, &
|
||||
CPFEM_RESTOREJACOBIAN, &
|
||||
CPFEM_BACKUPJACOBIAN, &
|
||||
cycleCounter, &
|
||||
theInc, &
|
||||
theTime, &
|
||||
theDelta, &
|
||||
lastIncConverged, &
|
||||
outdatedByNewInc, &
|
||||
outdatedFFN1, &
|
||||
lastLovl
|
||||
use numerics
|
||||
use FEsolving
|
||||
use debug
|
||||
use mesh
|
||||
use CPFEM
|
||||
|
||||
implicit none
|
||||
!$ include "omp_lib.h" ! the openMP function library
|
||||
|
|
@ -304,7 +265,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
|
|||
call debug_reset() ! resets debugging
|
||||
outdatedFFN1 = .false.
|
||||
cycleCounter = cycleCounter + 1
|
||||
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates
|
||||
mesh_cellnode = mesh_build_cellnodes() ! update cell node coordinates
|
||||
call mesh_build_ipCoordinates() ! update ip coordinates
|
||||
endif
|
||||
if (outdatedByNewInc) then
|
||||
|
|
@ -319,10 +280,10 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
|
|||
computationMode = ior(computationMode,CPFEM_BACKUPJACOBIAN) ! collect and backup Jacobian after convergence
|
||||
lastIncConverged = .false. ! reset flag
|
||||
endif
|
||||
do node = 1,theMesh%elem%nNodes
|
||||
CPnodeID = mesh_element(4+node,cp_en)
|
||||
mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node)
|
||||
enddo
|
||||
!do node = 1,theMesh%elem%nNodes
|
||||
!CPnodeID = mesh_element(4+node,cp_en)
|
||||
!mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node)
|
||||
!enddo
|
||||
endif
|
||||
|
||||
else ! --- PLAIN MODE ---
|
||||
|
|
@ -333,8 +294,8 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
|
|||
call debug_reset() ! and resets debugging
|
||||
outdatedFFN1 = .false.
|
||||
cycleCounter = cycleCounter + 1
|
||||
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates
|
||||
call mesh_build_ipCoordinates() ! update ip coordinates
|
||||
!mesh_cellnode = mesh_build_cellnodes() ! update cell node coordinates
|
||||
!call mesh_build_ipCoordinates() ! update ip coordinates
|
||||
endif
|
||||
if (outdatedByNewInc) then
|
||||
computationMode = ior(computationMode,CPFEM_AGERESULTS)
|
||||
|
|
@ -373,10 +334,8 @@ end subroutine hypela2
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine flux(f,ts,n,time)
|
||||
use prec
|
||||
use thermal_conduction, only: &
|
||||
thermal_conduction_getSourceAndItsTangent
|
||||
use mesh, only: &
|
||||
mesh_FEasCP
|
||||
use thermal_conduction
|
||||
use mesh
|
||||
|
||||
implicit none
|
||||
real(pReal), dimension(6), intent(in) :: &
|
||||
|
|
@ -399,8 +358,7 @@ subroutine flux(f,ts,n,time)
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine uedinc(inc,incsub)
|
||||
use prec
|
||||
use CPFEM, only: &
|
||||
CPFEM_results
|
||||
use CPFEM
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: inc, incsub
|
||||
|
|
@ -417,13 +375,9 @@ end subroutine uedinc
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
|
||||
use prec
|
||||
use mesh, only: &
|
||||
mesh_FEasCP
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use homogenization, only: &
|
||||
materialpoint_results,&
|
||||
materialpoint_sizeResults
|
||||
use mesh
|
||||
use IO
|
||||
use homogenization
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: &
|
||||
|
|
|
|||
|
|
@ -5,32 +5,35 @@
|
|||
!> @todo Descriptions for public variables needed
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module FEsolving
|
||||
use prec
|
||||
|
||||
implicit none
|
||||
private
|
||||
integer, public :: &
|
||||
restartInc = 1 !< needs description
|
||||
|
||||
logical, public :: &
|
||||
symmetricSolver = .false., & !< use a symmetric FEM solver
|
||||
restartWrite = .false., & !< write current state to enable restart
|
||||
restartRead = .false., & !< restart information to continue calculation from saved state
|
||||
terminallyIll = .false. !< at least one material point is terminally ill
|
||||
|
||||
integer, dimension(:,:), allocatable, public :: &
|
||||
FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP
|
||||
use prec
|
||||
use debug
|
||||
use IO
|
||||
use DAMASK_interface
|
||||
|
||||
integer, dimension(2), public :: &
|
||||
FEsolving_execElem !< for ping-pong scheme always whole range, otherwise one specific element
|
||||
|
||||
character(len=1024), public :: &
|
||||
modelName !< needs description
|
||||
|
||||
logical, dimension(:,:), allocatable, public :: &
|
||||
calcMode !< do calculation or simply collect when using ping pong scheme
|
||||
implicit none
|
||||
private
|
||||
integer, public :: &
|
||||
restartInc = 1 !< needs description
|
||||
|
||||
public :: FE_init
|
||||
logical, public :: &
|
||||
symmetricSolver = .false., & !< use a symmetric FEM solver
|
||||
restartWrite = .false., & !< write current state to enable restart
|
||||
restartRead = .false., & !< restart information to continue calculation from saved state
|
||||
terminallyIll = .false. !< at least one material point is terminally ill
|
||||
|
||||
integer, dimension(:,:), allocatable, public :: &
|
||||
FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP
|
||||
|
||||
integer, dimension(2), public :: &
|
||||
FEsolving_execElem !< for ping-pong scheme always whole range, otherwise one specific element
|
||||
|
||||
character(len=1024), public :: &
|
||||
modelName !< needs description
|
||||
|
||||
logical, dimension(:,:), allocatable, public :: &
|
||||
calcMode !< do calculation or simply collect when using ping pong scheme
|
||||
|
||||
public :: FE_init
|
||||
|
||||
contains
|
||||
|
||||
|
|
@ -41,108 +44,93 @@ contains
|
|||
!> solver the information is provided by the interface module
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine FE_init
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_FEsolving, &
|
||||
debug_levelBasic
|
||||
use IO, only: &
|
||||
IO_stringPos, &
|
||||
IO_stringValue, &
|
||||
IO_intValue, &
|
||||
IO_lc, &
|
||||
#if defined(Marc4DAMASK) || defined(Abaqus)
|
||||
IO_open_inputFile, &
|
||||
IO_open_logFile, &
|
||||
#endif
|
||||
IO_warning
|
||||
use DAMASK_interface
|
||||
|
||||
#if defined(Marc4DAMASK) || defined(Abaqus)
|
||||
integer, parameter :: &
|
||||
FILEUNIT = 222
|
||||
integer :: j
|
||||
character(len=65536) :: tag, line
|
||||
integer, allocatable, dimension(:) :: chunkPos
|
||||
integer, parameter :: &
|
||||
FILEUNIT = 222
|
||||
integer :: j
|
||||
character(len=65536) :: tag, line
|
||||
integer, allocatable, dimension(:) :: chunkPos
|
||||
#endif
|
||||
|
||||
write(6,'(/,a)') ' <<<+- FEsolving init -+>>>'
|
||||
write(6,'(/,a)') ' <<<+- FEsolving init -+>>>'
|
||||
|
||||
modelName = getSolverJobName()
|
||||
modelName = getSolverJobName()
|
||||
|
||||
#if defined(Grid) || defined(FEM)
|
||||
restartInc = interface_RestartInc
|
||||
restartInc = interface_RestartInc
|
||||
|
||||
if(restartInc < 0) then
|
||||
call IO_warning(warning_ID=34)
|
||||
restartInc = 0
|
||||
endif
|
||||
restartRead = restartInc > 0 ! only read in if "true" restart requested
|
||||
if(restartInc < 0) then
|
||||
call IO_warning(warning_ID=34)
|
||||
restartInc = 0
|
||||
endif
|
||||
restartRead = restartInc > 0 ! only read in if "true" restart requested
|
||||
#else
|
||||
call IO_open_inputFile(FILEUNIT,modelName)
|
||||
rewind(FILEUNIT)
|
||||
do
|
||||
read (FILEUNIT,'(a1024)',END=100) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key
|
||||
select case(tag)
|
||||
case ('solver')
|
||||
read (FILEUNIT,'(a1024)',END=100) line ! next line
|
||||
chunkPos = IO_stringPos(line)
|
||||
symmetricSolver = (IO_intValue(line,chunkPos,2) /= 1)
|
||||
case ('restart')
|
||||
read (FILEUNIT,'(a1024)',END=100) line ! next line
|
||||
chunkPos = IO_stringPos(line)
|
||||
restartWrite = iand(IO_intValue(line,chunkPos,1),1) > 0
|
||||
restartRead = iand(IO_intValue(line,chunkPos,1),2) > 0
|
||||
case ('*restart')
|
||||
do j=2,chunkPos(1)
|
||||
restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'write') .or. restartWrite
|
||||
restartRead = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'read') .or. restartRead
|
||||
enddo
|
||||
if(restartWrite) then
|
||||
do j=2,chunkPos(1)
|
||||
restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) /= 'frequency=0') .and. restartWrite
|
||||
enddo
|
||||
endif
|
||||
end select
|
||||
enddo
|
||||
100 close(FILEUNIT)
|
||||
call IO_open_inputFile(FILEUNIT,modelName)
|
||||
rewind(FILEUNIT)
|
||||
do
|
||||
read (FILEUNIT,'(a1024)',END=100) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key
|
||||
select case(tag)
|
||||
case ('solver')
|
||||
read (FILEUNIT,'(a1024)',END=100) line ! next line
|
||||
chunkPos = IO_stringPos(line)
|
||||
symmetricSolver = (IO_intValue(line,chunkPos,2) /= 1)
|
||||
case ('restart')
|
||||
read (FILEUNIT,'(a1024)',END=100) line ! next line
|
||||
chunkPos = IO_stringPos(line)
|
||||
restartWrite = iand(IO_intValue(line,chunkPos,1),1) > 0
|
||||
restartRead = iand(IO_intValue(line,chunkPos,1),2) > 0
|
||||
case ('*restart')
|
||||
do j=2,chunkPos(1)
|
||||
restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'write') .or. restartWrite
|
||||
restartRead = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'read') .or. restartRead
|
||||
enddo
|
||||
if(restartWrite) then
|
||||
do j=2,chunkPos(1)
|
||||
restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) /= 'frequency=0') .and. restartWrite
|
||||
enddo
|
||||
endif
|
||||
end select
|
||||
enddo
|
||||
100 close(FILEUNIT)
|
||||
|
||||
if (restartRead) then
|
||||
if (restartRead) then
|
||||
#ifdef Marc4DAMASK
|
||||
call IO_open_logFile(FILEUNIT)
|
||||
rewind(FILEUNIT)
|
||||
do
|
||||
read (FILEUNIT,'(a1024)',END=200) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'restart' &
|
||||
.and. IO_lc(IO_stringValue(line,chunkPos,2)) == 'file' &
|
||||
.and. IO_lc(IO_stringValue(line,chunkPos,3)) == 'job' &
|
||||
.and. IO_lc(IO_stringValue(line,chunkPos,4)) == 'id' ) &
|
||||
modelName = IO_StringValue(line,chunkPos,6)
|
||||
enddo
|
||||
#else ! QUESTION: is this meaningful for the spectral/FEM case?
|
||||
call IO_open_inputFile(FILEUNIT,modelName)
|
||||
rewind(FILEUNIT)
|
||||
do
|
||||
read (FILEUNIT,'(a1024)',END=200) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
if (IO_lc(IO_stringValue(line,chunkPos,1))=='*heading') then
|
||||
read (FILEUNIT,'(a1024)',END=200) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
modelName = IO_StringValue(line,chunkPos,1)
|
||||
endif
|
||||
enddo
|
||||
call IO_open_logFile(FILEUNIT)
|
||||
rewind(FILEUNIT)
|
||||
do
|
||||
read (FILEUNIT,'(a1024)',END=200) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'restart' &
|
||||
.and. IO_lc(IO_stringValue(line,chunkPos,2)) == 'file' &
|
||||
.and. IO_lc(IO_stringValue(line,chunkPos,3)) == 'job' &
|
||||
.and. IO_lc(IO_stringValue(line,chunkPos,4)) == 'id' ) &
|
||||
modelName = IO_StringValue(line,chunkPos,6)
|
||||
enddo
|
||||
#else
|
||||
call IO_open_inputFile(FILEUNIT,modelName)
|
||||
rewind(FILEUNIT)
|
||||
do
|
||||
read (FILEUNIT,'(a1024)',END=200) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
if (IO_lc(IO_stringValue(line,chunkPos,1))=='*heading') then
|
||||
read (FILEUNIT,'(a1024)',END=200) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
modelName = IO_StringValue(line,chunkPos,1)
|
||||
endif
|
||||
enddo
|
||||
#endif
|
||||
200 close(FILEUNIT)
|
||||
endif
|
||||
200 close(FILEUNIT)
|
||||
endif
|
||||
|
||||
#endif
|
||||
if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0) then
|
||||
write(6,'(a21,l1)') ' restart writing: ', restartWrite
|
||||
write(6,'(a21,l1)') ' restart reading: ', restartRead
|
||||
if (restartRead) write(6,'(a,/)') ' restart Job: '//trim(modelName)
|
||||
endif
|
||||
if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0) then
|
||||
write(6,'(a21,l1)') ' restart writing: ', restartWrite
|
||||
write(6,'(a21,l1)') ' restart reading: ', restartRead
|
||||
if (restartRead) write(6,'(a,/)') ' restart Job: '//trim(modelName)
|
||||
endif
|
||||
|
||||
end subroutine FE_init
|
||||
|
||||
|
|
|
|||
|
|
@ -5,20 +5,24 @@
|
|||
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module HDF5_utilities
|
||||
use prec
|
||||
use IO
|
||||
#if defined(PETSc) || defined(DAMASK_HDF5)
|
||||
use HDF5
|
||||
use rotations
|
||||
use numerics
|
||||
#endif
|
||||
#ifdef PETSc
|
||||
use PETSC
|
||||
#endif
|
||||
|
||||
use prec
|
||||
use IO
|
||||
use rotations
|
||||
use numerics
|
||||
|
||||
implicit none
|
||||
public
|
||||
|
||||
#if defined(PETSc) || defined(DAMASK_HDF5)
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief reads pInt or pReal data of defined shape from file ! ToDo: order of arguments wrong
|
||||
!> @brief reads integer or float data of defined shape from file ! ToDo: order of arguments wrong
|
||||
!> @details for parallel IO, all dimension except for the last need to match
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
interface HDF5_read
|
||||
|
|
@ -41,7 +45,7 @@ module HDF5_utilities
|
|||
end interface HDF5_read
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief writes pInt or pReal data of defined shape to file ! ToDo: order of arguments wrong
|
||||
!> @brief writes integer or real data of defined shape to file ! ToDo: order of arguments wrong
|
||||
!> @details for parallel IO, all dimension except for the last need to match
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
interface HDF5_write
|
||||
|
|
@ -66,7 +70,7 @@ module HDF5_utilities
|
|||
end interface HDF5_write
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief attached attributes of type char,pInt or pReal to a file/dataset/group
|
||||
!> @brief attached attributes of type char, integer or real to a file/dataset/group
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
interface HDF5_addAttribute
|
||||
module procedure HDF5_addAttribute_str
|
||||
|
|
@ -111,7 +115,7 @@ subroutine HDF5_utilities_init
|
|||
call h5tget_size_f(H5T_NATIVE_INTEGER,typeSize, hdferr)
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_Utilities_init: h5tget_size_f (int)')
|
||||
if (int(bit_size(0),SIZE_T)/=typeSize*8) &
|
||||
call IO_error(0_pInt,ext_msg='Default integer size does not match H5T_NATIVE_INTEGER')
|
||||
call IO_error(0,ext_msg='Default integer size does not match H5T_NATIVE_INTEGER')
|
||||
|
||||
call h5tget_size_f(H5T_NATIVE_DOUBLE,typeSize, hdferr)
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_Utilities_init: h5tget_size_f (double)')
|
||||
|
|
@ -141,30 +145,30 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel) ! ToDo: simply "op
|
|||
endif
|
||||
|
||||
call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5pcreate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5pcreate_f')
|
||||
|
||||
#ifdef PETSc
|
||||
if (present(parallel)) then; if (parallel) then
|
||||
call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5pset_fapl_mpio_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5pset_fapl_mpio_f')
|
||||
endif; endif
|
||||
#endif
|
||||
|
||||
if (m == 'w') then
|
||||
call h5fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr,access_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fcreate_f (w)')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5fcreate_f (w)')
|
||||
elseif(m == 'a') then
|
||||
call h5fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (a)')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5fopen_f (a)')
|
||||
elseif(m == 'r') then
|
||||
call h5fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (r)')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5fopen_f (r)')
|
||||
else
|
||||
call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f unknown access mode: '//trim(m))
|
||||
call IO_error(1,ext_msg='HDF5_openFile: h5fopen_f unknown access mode: '//trim(m))
|
||||
endif
|
||||
|
||||
call h5pclose_f(plist_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5pclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5pclose_f')
|
||||
|
||||
end function HDF5_openFile
|
||||
|
||||
|
|
@ -179,7 +183,7 @@ subroutine HDF5_closeFile(fileHandle)
|
|||
integer :: hdferr
|
||||
|
||||
call h5fclose_f(fileHandle,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_closeFile: h5fclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_closeFile: h5fclose_f')
|
||||
|
||||
end subroutine HDF5_closeFile
|
||||
|
||||
|
|
@ -198,19 +202,19 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName)
|
|||
!-------------------------------------------------------------------------------------------------
|
||||
! creating a property list for data access properties
|
||||
call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5pcreate_f ('//trim(groupName)//')')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_addGroup: h5pcreate_f ('//trim(groupName)//')')
|
||||
|
||||
!-------------------------------------------------------------------------------------------------
|
||||
! setting I/O mode to collective
|
||||
#ifdef PETSc
|
||||
call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_addGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')')
|
||||
#endif
|
||||
|
||||
!-------------------------------------------------------------------------------------------------
|
||||
! Create group
|
||||
call h5gcreate_f(fileHandle, trim(groupName), HDF5_addGroup, hdferr, OBJECT_NAMELEN_DEFAULT_F,gapl_id = aplist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5gcreate_f ('//trim(groupName)//')')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_addGroup: h5gcreate_f ('//trim(groupName)//')')
|
||||
|
||||
call h5pclose_f(aplist_id,hdferr)
|
||||
|
||||
|
|
@ -234,19 +238,19 @@ integer(HID_T) function HDF5_openGroup(fileHandle,groupName)
|
|||
!-------------------------------------------------------------------------------------------------
|
||||
! creating a property list for data access properties
|
||||
call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5pcreate_f ('//trim(groupName)//')')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_openGroup: h5pcreate_f ('//trim(groupName)//')')
|
||||
|
||||
!-------------------------------------------------------------------------------------------------
|
||||
! setting I/O mode to collective
|
||||
#ifdef PETSc
|
||||
call h5pget_all_coll_metadata_ops_f(aplist_id, is_collective, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_openGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')')
|
||||
#endif
|
||||
|
||||
!-------------------------------------------------------------------------------------------------
|
||||
! opening the group
|
||||
call h5gopen_f(fileHandle, trim(groupName), HDF5_openGroup, hdferr, gapl_id = aplist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5gopen_f ('//trim(groupName)//')')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_openGroup: h5gopen_f ('//trim(groupName)//')')
|
||||
|
||||
call h5pclose_f(aplist_id,hdferr)
|
||||
|
||||
|
|
@ -262,7 +266,7 @@ subroutine HDF5_closeGroup(group_id)
|
|||
integer :: hdferr
|
||||
|
||||
call h5gclose_f(group_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = int(group_id,pInt))
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = int(group_id))
|
||||
|
||||
end subroutine HDF5_closeGroup
|
||||
|
||||
|
|
@ -285,11 +289,11 @@ logical function HDF5_objectExists(loc_id,path)
|
|||
endif
|
||||
|
||||
call h5lexists_f(loc_id, p, HDF5_objectExists, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f')
|
||||
|
||||
if(HDF5_objectExists) then
|
||||
call h5oexists_by_name_f(loc_id, p, HDF5_objectExists, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f')
|
||||
endif
|
||||
|
||||
end function HDF5_objectExists
|
||||
|
|
@ -316,27 +320,27 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
|
|||
endif
|
||||
|
||||
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5screate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5screate_f')
|
||||
call h5tcopy_f(H5T_NATIVE_CHARACTER, type_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5tcopy_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5tcopy_f')
|
||||
call h5tset_size_f(type_id, int(len(trim(attrValue)),HSIZE_T), hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5tset_size_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5tset_size_f')
|
||||
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5aexists_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5aexists_by_name_f')
|
||||
if (attrExists) then
|
||||
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5adelete_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5adelete_by_name_f')
|
||||
endif
|
||||
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5acreate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5acreate_f')
|
||||
call h5awrite_f(attr_id, type_id, trim(attrValue), int([1],HSIZE_T), hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5awrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5awrite_f')
|
||||
call h5aclose_f(attr_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5aclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5aclose_f')
|
||||
call h5tclose_f(type_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5tclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5tclose_f')
|
||||
call h5sclose_f(space_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5sclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5sclose_f')
|
||||
|
||||
end subroutine HDF5_addAttribute_str
|
||||
|
||||
|
|
@ -348,7 +352,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
|
|||
|
||||
integer(HID_T), intent(in) :: loc_id
|
||||
character(len=*), intent(in) :: attrLabel
|
||||
integer(pInt), intent(in) :: attrValue
|
||||
integer, intent(in) :: attrValue
|
||||
character(len=*), intent(in), optional :: path
|
||||
|
||||
integer :: hdferr
|
||||
|
|
@ -363,21 +367,21 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
|
|||
endif
|
||||
|
||||
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5screate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5screate_f')
|
||||
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5aexists_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5aexists_by_name_f')
|
||||
if (attrExists) then
|
||||
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5adelete_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5adelete_by_name_f')
|
||||
endif
|
||||
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5acreate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5acreate_f')
|
||||
call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5awrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5awrite_f')
|
||||
call h5aclose_f(attr_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5tclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5tclose_f')
|
||||
call h5sclose_f(space_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5sclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5sclose_f')
|
||||
|
||||
end subroutine HDF5_addAttribute_int
|
||||
|
||||
|
|
@ -404,21 +408,21 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
|
|||
endif
|
||||
|
||||
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5screate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5screate_f')
|
||||
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5aexists_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5aexists_by_name_f')
|
||||
if (attrExists) then
|
||||
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5adelete_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5adelete_by_name_f')
|
||||
endif
|
||||
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5acreate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5acreate_f')
|
||||
call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5awrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5awrite_f')
|
||||
call h5aclose_f(attr_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5tclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5tclose_f')
|
||||
call h5sclose_f(space_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5sclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5sclose_f')
|
||||
|
||||
end subroutine HDF5_addAttribute_real
|
||||
|
||||
|
|
@ -430,7 +434,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
|
|||
|
||||
integer(HID_T), intent(in) :: loc_id
|
||||
character(len=*), intent(in) :: attrLabel
|
||||
integer(pInt), intent(in), dimension(:) :: attrValue
|
||||
integer, intent(in), dimension(:) :: attrValue
|
||||
character(len=*), intent(in), optional :: path
|
||||
|
||||
integer :: hdferr
|
||||
|
|
@ -448,21 +452,21 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
|
|||
array_size = size(attrValue,kind=HSIZE_T)
|
||||
|
||||
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5screate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5screate_f')
|
||||
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f')
|
||||
if (attrExists) then
|
||||
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f')
|
||||
endif
|
||||
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5acreate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5acreate_f')
|
||||
call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, array_size, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5awrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5awrite_f')
|
||||
call h5aclose_f(attr_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5tclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5tclose_f')
|
||||
call h5sclose_f(space_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5sclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5sclose_f')
|
||||
|
||||
end subroutine HDF5_addAttribute_int_array
|
||||
|
||||
|
|
@ -492,21 +496,21 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
|
|||
array_size = size(attrValue,kind=HSIZE_T)
|
||||
|
||||
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5screate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5screate_f')
|
||||
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f')
|
||||
if (attrExists) then
|
||||
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f')
|
||||
endif
|
||||
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5acreate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5acreate_f')
|
||||
call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, array_size, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5awrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5awrite_f')
|
||||
call h5aclose_f(attr_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5tclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5tclose_f')
|
||||
call h5sclose_f(space_id,hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5sclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5sclose_f')
|
||||
|
||||
end subroutine HDF5_addAttribute_real_array
|
||||
|
||||
|
|
@ -522,19 +526,19 @@ subroutine HDF5_setLink(loc_id,target_name,link_name)
|
|||
logical :: linkExists
|
||||
|
||||
call h5lexists_f(loc_id, link_name,linkExists, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lexists_soft_f ('//trim(link_name)//')')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_setLink: h5lexists_soft_f ('//trim(link_name)//')')
|
||||
if (linkExists) then
|
||||
call h5ldelete_f(loc_id,link_name, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5ldelete_soft_f ('//trim(link_name)//')')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_setLink: h5ldelete_soft_f ('//trim(link_name)//')')
|
||||
endif
|
||||
call h5lcreate_soft_f(target_name, loc_id, link_name, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lcreate_soft_f ('//trim(target_name)//' '//trim(link_name)//')')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_setLink: h5lcreate_soft_f ('//trim(target_name)//' '//trim(link_name)//')')
|
||||
|
||||
end subroutine HDF5_setLink
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pReal with 1 dimension
|
||||
!> @brief read dataset of type real with 1 dimension
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_real1(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -567,14 +571,14 @@ subroutine HDF5_read_real1(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real1: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real1: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_real1
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pReal with 2 dimensions
|
||||
!> @brief read dataset of type real with 2 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_real2(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -607,14 +611,14 @@ subroutine HDF5_read_real2(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real2: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real2: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_real2
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pReal with 2 dimensions
|
||||
!> @brief read dataset of type real with 2 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_real3(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -647,14 +651,14 @@ subroutine HDF5_read_real3(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real3: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real3: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_real3
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pReal with 4 dimensions
|
||||
!> @brief read dataset of type real with 4 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_real4(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -687,14 +691,14 @@ subroutine HDF5_read_real4(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real4: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real4: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_real4
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pReal with 5 dimensions
|
||||
!> @brief read dataset of type real with 5 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_real5(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -727,14 +731,14 @@ subroutine HDF5_read_real5(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real5: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real5: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_real5
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pReal with 6 dimensions
|
||||
!> @brief read dataset of type real with 6 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_real6(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -767,14 +771,14 @@ subroutine HDF5_read_real6(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real6: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real6: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_real6
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pReal with 7 dimensions
|
||||
!> @brief read dataset of type real with 7 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_real7(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -807,7 +811,7 @@ subroutine HDF5_read_real7(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_real7: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real7: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -815,7 +819,7 @@ end subroutine HDF5_read_real7
|
|||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pInt with 1 dimension
|
||||
!> @brief read dataset of type integer with 1 dimension
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_int1(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -848,14 +852,14 @@ subroutine HDF5_read_int1(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int1: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int1: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_int1
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pInt with 2 dimensions
|
||||
!> @brief read dataset of type integer with 2 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_int2(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -888,14 +892,14 @@ subroutine HDF5_read_int2(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int2: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int2: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_int2
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pInt with 3 dimensions
|
||||
!> @brief read dataset of type integer with 3 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_int3(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -928,14 +932,14 @@ subroutine HDF5_read_int3(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int3: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int3: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_int3
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pInt withh 4 dimensions
|
||||
!> @brief read dataset of type integer withh 4 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_int4(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -968,14 +972,14 @@ subroutine HDF5_read_int4(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int4: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int4: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_int4
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pInt with 5 dimensions
|
||||
!> @brief read dataset of type integer with 5 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_int5(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1008,14 +1012,14 @@ subroutine HDF5_read_int5(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int5: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int5: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_int5
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pInt with 6 dimensions
|
||||
!> @brief read dataset of type integer with 6 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_int6(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1048,14 +1052,14 @@ subroutine HDF5_read_int6(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int6: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int6: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
end subroutine HDF5_read_int6
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief read dataset of type pInt with 7 dimensions
|
||||
!> @brief read dataset of type integer with 7 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_read_int7(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1088,7 +1092,7 @@ subroutine HDF5_read_int7(loc_id,dataset,datasetName,parallel)
|
|||
|
||||
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
|
||||
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_int7: h5dread_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int7: h5dread_f')
|
||||
|
||||
call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
|
||||
|
||||
|
|
@ -1096,7 +1100,7 @@ end subroutine HDF5_read_int7
|
|||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pReal with 1 dimension
|
||||
!> @brief write dataset of type real with 1 dimension
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_real1(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1129,7 +1133,7 @@ subroutine HDF5_write_real1(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real1: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real1: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1137,7 +1141,7 @@ subroutine HDF5_write_real1(loc_id,dataset,datasetName,parallel)
|
|||
end subroutine HDF5_write_real1
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pReal with 2 dimensions
|
||||
!> @brief write dataset of type real with 2 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_real2(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1170,7 +1174,7 @@ subroutine HDF5_write_real2(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real2: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real2: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1178,7 +1182,7 @@ subroutine HDF5_write_real2(loc_id,dataset,datasetName,parallel)
|
|||
end subroutine HDF5_write_real2
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pReal with 3 dimensions
|
||||
!> @brief write dataset of type real with 3 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_real3(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1211,7 +1215,7 @@ subroutine HDF5_write_real3(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real3: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real3: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1219,7 +1223,7 @@ subroutine HDF5_write_real3(loc_id,dataset,datasetName,parallel)
|
|||
end subroutine HDF5_write_real3
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pReal with 4 dimensions
|
||||
!> @brief write dataset of type real with 4 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_real4(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1252,7 +1256,7 @@ subroutine HDF5_write_real4(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real4: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real4: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1261,7 +1265,7 @@ end subroutine HDF5_write_real4
|
|||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pReal with 5 dimensions
|
||||
!> @brief write dataset of type real with 5 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_real5(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1294,7 +1298,7 @@ subroutine HDF5_write_real5(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real5: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real5: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1302,7 +1306,7 @@ subroutine HDF5_write_real5(loc_id,dataset,datasetName,parallel)
|
|||
end subroutine HDF5_write_real5
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pReal with 6 dimensions
|
||||
!> @brief write dataset of type real with 6 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_real6(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1335,7 +1339,7 @@ subroutine HDF5_write_real6(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real6: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real6: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1343,7 +1347,7 @@ subroutine HDF5_write_real6(loc_id,dataset,datasetName,parallel)
|
|||
end subroutine HDF5_write_real6
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pReal with 7 dimensions
|
||||
!> @brief write dataset of type real with 7 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_real7(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1376,7 +1380,7 @@ subroutine HDF5_write_real7(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_real7: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real7: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1385,7 +1389,7 @@ end subroutine HDF5_write_real7
|
|||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pInt with 1 dimension
|
||||
!> @brief write dataset of type integer with 1 dimension
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_int1(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1418,7 +1422,7 @@ subroutine HDF5_write_int1(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int1: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int1: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1426,7 +1430,7 @@ subroutine HDF5_write_int1(loc_id,dataset,datasetName,parallel)
|
|||
end subroutine HDF5_write_int1
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pInt with 2 dimensions
|
||||
!> @brief write dataset of type integer with 2 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_int2(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1459,7 +1463,7 @@ subroutine HDF5_write_int2(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int2: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int2: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1467,7 +1471,7 @@ subroutine HDF5_write_int2(loc_id,dataset,datasetName,parallel)
|
|||
end subroutine HDF5_write_int2
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pInt with 3 dimensions
|
||||
!> @brief write dataset of type integer with 3 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_int3(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1500,7 +1504,7 @@ subroutine HDF5_write_int3(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int3: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int3: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1508,7 +1512,7 @@ subroutine HDF5_write_int3(loc_id,dataset,datasetName,parallel)
|
|||
end subroutine HDF5_write_int3
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pInt with 4 dimensions
|
||||
!> @brief write dataset of type integer with 4 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_int4(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1541,7 +1545,7 @@ subroutine HDF5_write_int4(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int4: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int4: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1549,7 +1553,7 @@ subroutine HDF5_write_int4(loc_id,dataset,datasetName,parallel)
|
|||
end subroutine HDF5_write_int4
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pInt with 5 dimensions
|
||||
!> @brief write dataset of type integer with 5 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_int5(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1582,7 +1586,7 @@ subroutine HDF5_write_int5(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int5: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int5: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1590,7 +1594,7 @@ subroutine HDF5_write_int5(loc_id,dataset,datasetName,parallel)
|
|||
end subroutine HDF5_write_int5
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pInt with 6 dimensions
|
||||
!> @brief write dataset of type integer with 6 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_int6(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1623,7 +1627,7 @@ subroutine HDF5_write_int6(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int6: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int6: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1631,7 +1635,7 @@ subroutine HDF5_write_int6(loc_id,dataset,datasetName,parallel)
|
|||
end subroutine HDF5_write_int6
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief write dataset of type pInt with 7 dimensions
|
||||
!> @brief write dataset of type integer with 7 dimensions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine HDF5_write_int7(loc_id,dataset,datasetName,parallel)
|
||||
|
||||
|
|
@ -1664,7 +1668,7 @@ subroutine HDF5_write_int7(loc_id,dataset,datasetName,parallel)
|
|||
if (product(totalShape) /= 0) then
|
||||
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_int7: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int7: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1740,7 +1744,7 @@ subroutine HDF5_write_rotation(loc_id,dataset,datasetName,parallel)
|
|||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
call h5dwrite_f(dset_id, z_id,dataset_asArray(4,:),int(totalShape,HSIZE_T), hdferr,&
|
||||
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_rotation: h5dwrite_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_rotation: h5dwrite_f')
|
||||
endif
|
||||
|
||||
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||
|
|
@ -1765,7 +1769,7 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
|
|||
globalShape !< shape of the dataset (all processes)
|
||||
integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
|
||||
|
||||
integer(pInt), dimension(worldsize) :: &
|
||||
integer, dimension(worldsize) :: &
|
||||
readSize !< contribution of all processes
|
||||
integer :: ierr
|
||||
integer :: hdferr
|
||||
|
|
@ -1773,17 +1777,17 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
|
|||
!-------------------------------------------------------------------------------------------------
|
||||
! creating a property list for transfer properties (is collective for MPI)
|
||||
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pcreate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pcreate_f')
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
readSize = 0_pInt
|
||||
readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt)
|
||||
readSize = 0
|
||||
readSize(worldrank+1) = int(localShape(ubound(localShape,1)))
|
||||
#ifdef PETSc
|
||||
if (parallel) then
|
||||
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pset_dxpl_mpio_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pset_dxpl_mpio_f')
|
||||
call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process
|
||||
if (ierr /= 0) call IO_error(894_pInt,ext_msg='initialize_read: MPI_allreduce')
|
||||
if (ierr /= 0) call IO_error(894,ext_msg='initialize_read: MPI_allreduce')
|
||||
endif
|
||||
#endif
|
||||
myStart = int(0,HSIZE_T)
|
||||
|
|
@ -1793,28 +1797,28 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! create dataspace in memory (local shape)
|
||||
call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5screate_simple_f/memspace_id')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5screate_simple_f/memspace_id')
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! creating a property list for IO and set it to collective
|
||||
call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pcreate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pcreate_f')
|
||||
#ifdef PETSc
|
||||
call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f')
|
||||
#endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! open the dataset in the file and get the space ID
|
||||
call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5dopen_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5dopen_f')
|
||||
call h5dget_space_f(dset_id, filespace_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5dget_space_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5dget_space_f')
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! select a hyperslab (the portion of the current process) in the file
|
||||
call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_read: h5sselect_hyperslab_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5sselect_hyperslab_f')
|
||||
|
||||
end subroutine initialize_read
|
||||
|
||||
|
|
@ -1828,15 +1832,15 @@ subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id
|
|||
integer :: hdferr
|
||||
|
||||
call h5pclose_f(plist_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: plist_id')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: plist_id')
|
||||
call h5pclose_f(aplist_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: aplist_id')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: aplist_id')
|
||||
call h5dclose_f(dset_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5dclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5dclose_f')
|
||||
call h5sclose_f(filespace_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5sclose_f/filespace_id')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5sclose_f/filespace_id')
|
||||
call h5sclose_f(memspace_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5sclose_f/memspace_id')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5sclose_f/memspace_id')
|
||||
|
||||
end subroutine finalize_read
|
||||
|
||||
|
|
@ -1867,22 +1871,22 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
|
|||
!-------------------------------------------------------------------------------------------------
|
||||
! creating a property list for transfer properties (is collective when reading in parallel)
|
||||
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5pcreate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5pcreate_f')
|
||||
#ifdef PETSc
|
||||
if (parallel) then
|
||||
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5pset_dxpl_mpio_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5pset_dxpl_mpio_f')
|
||||
endif
|
||||
#endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! determine the global data layout among all processes
|
||||
writeSize = 0_pInt
|
||||
writeSize(worldrank+1) = int(myShape(ubound(myShape,1)),pInt)
|
||||
writeSize = 0
|
||||
writeSize(worldrank+1) = int(myShape(ubound(myShape,1)))
|
||||
#ifdef PETSc
|
||||
if (parallel) then
|
||||
call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process
|
||||
if (ierr /= 0) call IO_error(894_pInt,ext_msg='initialize_write: MPI_allreduce')
|
||||
if (ierr /= 0) call IO_error(894,ext_msg='initialize_write: MPI_allreduce')
|
||||
endif
|
||||
#endif
|
||||
myStart = int(0,HSIZE_T)
|
||||
|
|
@ -1892,17 +1896,16 @@ if (parallel) then
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! create dataspace in memory (local shape) and in file (global shape)
|
||||
call h5screate_simple_f(size(myShape), myShape, memspace_id, hdferr, myShape)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dopen_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dopen_f')
|
||||
call h5screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dget_space_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dget_space_f')
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! create dataset in the file and select a hyperslab from it (the portion of the current process)
|
||||
call h5dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5dcreate_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dcreate_f')
|
||||
call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, myShape, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='initialize_write: h5sselect_hyperslab_f')
|
||||
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5sselect_hyperslab_f')
|
||||
|
||||
end subroutine initialize_write
|
||||
|
||||
|
|
@ -1916,14 +1919,15 @@ subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
|||
integer :: hdferr
|
||||
|
||||
call h5pclose_f(plist_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: plist_id')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: plist_id')
|
||||
call h5dclose_f(dset_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5dclose_f')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5dclose_f')
|
||||
call h5sclose_f(filespace_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5sclose_f/filespace_id')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5sclose_f/filespace_id')
|
||||
call h5sclose_f(memspace_id, hdferr)
|
||||
if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_write: h5sclose_f/memspace_id')
|
||||
if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5sclose_f/memspace_id')
|
||||
|
||||
end subroutine finalize_write
|
||||
|
||||
#endif
|
||||
end module HDF5_Utilities
|
||||
|
|
|
|||
12
src/IO.f90
12
src/IO.f90
|
|
@ -356,7 +356,7 @@ logical pure function IO_isBlank(string)
|
|||
character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
|
||||
character(len=*), parameter :: comment = achar(35) ! comment id '#'
|
||||
|
||||
integer :: posNonBlank, posComment ! no pInt
|
||||
integer :: posNonBlank, posComment
|
||||
|
||||
posNonBlank = verify(string,blankChar)
|
||||
posComment = scan(string,comment)
|
||||
|
|
@ -377,7 +377,7 @@ pure function IO_getTag(string,openChar,closeChar)
|
|||
closeChar !< indicates end of tag
|
||||
|
||||
character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
|
||||
integer :: left,right ! no pInt
|
||||
integer :: left,right
|
||||
|
||||
IO_getTag = ''
|
||||
|
||||
|
|
@ -408,7 +408,7 @@ pure function IO_stringPos(string)
|
|||
character(len=*), intent(in) :: string !< string in which chunk positions are searched for
|
||||
|
||||
character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces
|
||||
integer :: left, right ! no pInt (verify and scan return default integer)
|
||||
integer :: left, right
|
||||
|
||||
allocate(IO_stringPos(1), source=0)
|
||||
right = 0
|
||||
|
|
@ -417,7 +417,7 @@ pure function IO_stringPos(string)
|
|||
left = right + verify(string(right+1:),SEP)
|
||||
right = left + scan(string(left:),SEP) - 2
|
||||
if ( string(left:left) == '#' ) exit
|
||||
IO_stringPos = [IO_stringPos,int(left, pInt), int(right, pInt)]
|
||||
IO_stringPos = [IO_stringPos,left, right]
|
||||
IO_stringPos(1) = IO_stringPos(1)+1
|
||||
endOfString: if (right < left) then
|
||||
IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string)
|
||||
|
|
@ -568,7 +568,7 @@ pure function IO_lc(string)
|
|||
character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
|
||||
character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
||||
|
||||
integer :: i,n ! no pInt (len returns default integer)
|
||||
integer :: i,n
|
||||
|
||||
IO_lc = string
|
||||
do i=1,len(string)
|
||||
|
|
@ -590,7 +590,7 @@ pure function IO_intOut(intToPrint)
|
|||
character(len=19) :: width ! maximum digits for 64 bit integer
|
||||
character(len=20) :: min_width ! longer for negative values
|
||||
|
||||
N_digits = 1 + int(log10(real(max(abs(intToPrint),1))),pInt)
|
||||
N_digits = 1 + int(log10(real(max(abs(intToPrint),1))))
|
||||
write(width, '(I19.19)') N_digits
|
||||
write(min_width, '(I20.20)') N_digits + merge(1,0,intToPrint < 0)
|
||||
IO_intOut = 'I'//trim(min_width)//'.'//trim(width)
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
!
|
||||
! MSC.Marc include file
|
||||
!
|
||||
integer(pInt) &
|
||||
integer &
|
||||
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
|
||||
ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,&
|
||||
ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,&
|
||||
|
|
@ -27,7 +27,7 @@ integer(pInt) &
|
|||
iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror,&
|
||||
icsprg
|
||||
dimension :: ideva(60)
|
||||
integer(pInt) num_concom
|
||||
integer num_concom
|
||||
parameter(num_concom=251)
|
||||
common/marc_concom/&
|
||||
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
!
|
||||
! MSC.Marc include file
|
||||
!
|
||||
integer(pInt) &
|
||||
integer &
|
||||
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
|
||||
ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,&
|
||||
ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,&
|
||||
|
|
@ -27,7 +27,7 @@ integer(pInt) &
|
|||
iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror,&
|
||||
icsprg
|
||||
dimension :: ideva(60)
|
||||
integer(pInt) num_concom
|
||||
integer num_concom
|
||||
parameter(num_concom=251)
|
||||
common/marc_concom/&
|
||||
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
|
||||
|
|
|
|||
|
|
@ -6,12 +6,12 @@
|
|||
! MSC.Marc include file
|
||||
!
|
||||
real(pReal) cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b
|
||||
integer(pInt) icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,&
|
||||
integer icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,&
|
||||
icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa
|
||||
real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst
|
||||
real(pReal) fraction_donn,timinc_ol2
|
||||
!
|
||||
integer(pInt) num_creepsr,num_creepsi,num_creeps2r
|
||||
integer num_creepsr,num_creepsi,num_creeps2r
|
||||
parameter(num_creepsr=7)
|
||||
parameter(num_creepsi=17)
|
||||
parameter(num_creeps2r=6)
|
||||
|
|
|
|||
|
|
@ -6,12 +6,12 @@
|
|||
! MSC.Marc include file
|
||||
!
|
||||
real(pReal) cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b
|
||||
integer(pInt) icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,&
|
||||
integer icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,&
|
||||
icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa
|
||||
real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst
|
||||
real(pReal) fraction_donn,timinc_ol2
|
||||
!
|
||||
integer(pInt) num_creepsr,num_creepsi,num_creeps2r
|
||||
integer num_creepsr,num_creepsi,num_creeps2r
|
||||
parameter(num_creepsr=7)
|
||||
parameter(num_creepsi=17)
|
||||
parameter(num_creeps2r=6)
|
||||
|
|
|
|||
|
|
@ -17,16 +17,15 @@
|
|||
#include "geometry_plastic_nonlocal.f90"
|
||||
#include "element.f90"
|
||||
#include "mesh_base.f90"
|
||||
#include "HDF5_utilities.f90"
|
||||
#include "results.f90"
|
||||
#include "discretization.f90"
|
||||
#ifdef Abaqus
|
||||
#include "mesh_abaqus.f90"
|
||||
#endif
|
||||
#ifdef Marc4DAMASK
|
||||
#include "mesh_marc.f90"
|
||||
#endif
|
||||
#ifdef DAMASK_HDF5
|
||||
#include "HDF5_utilities.f90"
|
||||
#include "results.f90"
|
||||
#endif
|
||||
#include "material.f90"
|
||||
#include "lattice.f90"
|
||||
#include "source_thermal_dissipation.f90"
|
||||
|
|
|
|||
|
|
@ -5,9 +5,37 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
module constitutive
|
||||
use math
|
||||
use debug
|
||||
use numerics
|
||||
use IO
|
||||
use config
|
||||
use material
|
||||
use results
|
||||
use HDF5_utilities
|
||||
use lattice
|
||||
use mesh
|
||||
use discretization
|
||||
use plastic_none
|
||||
use plastic_isotropic
|
||||
use plastic_phenopowerlaw
|
||||
use plastic_kinehardening
|
||||
use plastic_dislotwin
|
||||
use plastic_disloucla
|
||||
use plastic_nonlocal
|
||||
use geometry_plastic_nonlocal
|
||||
use source_thermal_dissipation
|
||||
use source_thermal_externalheat
|
||||
use source_damage_isoBrittle
|
||||
use source_damage_isoDuctile
|
||||
use source_damage_anisoBrittle
|
||||
use source_damage_anisoDuctile
|
||||
use kinematics_cleavage_opening
|
||||
use kinematics_slipplane_opening
|
||||
use kinematics_thermal_expansion
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
integer, public, protected :: &
|
||||
constitutive_plasticity_maxSizePostResults, &
|
||||
constitutive_plasticity_maxSizeDotState, &
|
||||
|
|
@ -37,74 +65,6 @@ contains
|
|||
!> @brief allocates arrays pointing to array of the various constitutive modules
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine constitutive_init
|
||||
use debug, only: &
|
||||
debug_constitutive, &
|
||||
debug_levelBasic
|
||||
use numerics, only: &
|
||||
worldrank
|
||||
use IO, only: &
|
||||
IO_error, &
|
||||
IO_write_jobFile
|
||||
use config, only: &
|
||||
material_Nphase, &
|
||||
phase_name
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
phase_plasticity, &
|
||||
phase_plasticityInstance, &
|
||||
phase_Nsources, &
|
||||
phase_source, &
|
||||
phase_kinematics, &
|
||||
ELASTICITY_hooke_ID, &
|
||||
PLASTICITY_none_ID, &
|
||||
PLASTICITY_isotropic_ID, &
|
||||
PLASTICITY_phenopowerlaw_ID, &
|
||||
PLASTICITY_kinehardening_ID, &
|
||||
PLASTICITY_dislotwin_ID, &
|
||||
PLASTICITY_disloucla_ID, &
|
||||
PLASTICITY_nonlocal_ID ,&
|
||||
SOURCE_thermal_dissipation_ID, &
|
||||
SOURCE_thermal_externalheat_ID, &
|
||||
SOURCE_damage_isoBrittle_ID, &
|
||||
SOURCE_damage_isoDuctile_ID, &
|
||||
SOURCE_damage_anisoBrittle_ID, &
|
||||
SOURCE_damage_anisoDuctile_ID, &
|
||||
KINEMATICS_cleavage_opening_ID, &
|
||||
KINEMATICS_slipplane_opening_ID, &
|
||||
KINEMATICS_thermal_expansion_ID, &
|
||||
ELASTICITY_HOOKE_label, &
|
||||
PLASTICITY_NONE_label, &
|
||||
PLASTICITY_ISOTROPIC_label, &
|
||||
PLASTICITY_PHENOPOWERLAW_label, &
|
||||
PLASTICITY_KINEHARDENING_label, &
|
||||
PLASTICITY_DISLOTWIN_label, &
|
||||
PLASTICITY_DISLOUCLA_label, &
|
||||
PLASTICITY_NONLOCAL_label, &
|
||||
SOURCE_thermal_dissipation_label, &
|
||||
SOURCE_thermal_externalheat_label, &
|
||||
SOURCE_damage_isoBrittle_label, &
|
||||
SOURCE_damage_isoDuctile_label, &
|
||||
SOURCE_damage_anisoBrittle_label, &
|
||||
SOURCE_damage_anisoDuctile_label, &
|
||||
plasticState, &
|
||||
sourceState
|
||||
|
||||
use plastic_none
|
||||
use plastic_isotropic
|
||||
use plastic_phenopowerlaw
|
||||
use plastic_kinehardening
|
||||
use plastic_dislotwin
|
||||
use plastic_disloucla
|
||||
use plastic_nonlocal
|
||||
use source_thermal_dissipation
|
||||
use source_thermal_externalheat
|
||||
use source_damage_isoBrittle
|
||||
use source_damage_isoDuctile
|
||||
use source_damage_anisoBrittle
|
||||
use source_damage_anisoDuctile
|
||||
use kinematics_cleavage_opening
|
||||
use kinematics_slipplane_opening
|
||||
use kinematics_thermal_expansion
|
||||
|
||||
integer, parameter :: FILEUNIT = 204
|
||||
integer :: &
|
||||
|
|
@ -127,8 +87,11 @@ subroutine constitutive_init
|
|||
if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init
|
||||
if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init
|
||||
if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init
|
||||
if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) call plastic_nonlocal_init
|
||||
|
||||
if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then
|
||||
call plastic_nonlocal_init
|
||||
else
|
||||
call geometry_plastic_nonlocal_disable
|
||||
endif
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! initialize source mechanisms
|
||||
if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init
|
||||
|
|
@ -281,15 +244,6 @@ end subroutine constitutive_init
|
|||
!> ToDo: homogenizedC66 would be more consistent
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function constitutive_homogenizedC(ipc,ip,el)
|
||||
use material, only: &
|
||||
phase_plasticity, &
|
||||
material_phase, &
|
||||
PLASTICITY_DISLOTWIN_ID, &
|
||||
PLASTICITY_DISLOUCLA_ID
|
||||
use plastic_dislotwin, only: &
|
||||
plastic_dislotwin_homogenizedC
|
||||
use lattice, only: &
|
||||
lattice_C66
|
||||
|
||||
real(pReal), dimension(6,6) :: constitutive_homogenizedC
|
||||
integer, intent(in) :: &
|
||||
|
|
@ -310,23 +264,6 @@ end function constitutive_homogenizedC
|
|||
!> @brief calls microstructure function of the different constitutive models
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine constitutive_microstructure(Fe, Fp, ipc, ip, el)
|
||||
use material, only: &
|
||||
phasememberAt, &
|
||||
phase_plasticity, &
|
||||
phase_plasticityInstance, &
|
||||
material_phase, &
|
||||
material_homogenizationAt, &
|
||||
temperature, &
|
||||
thermalMapping, &
|
||||
PLASTICITY_dislotwin_ID, &
|
||||
PLASTICITY_disloucla_ID, &
|
||||
PLASTICITY_nonlocal_ID
|
||||
use plastic_nonlocal, only: &
|
||||
plastic_nonlocal_dependentState
|
||||
use plastic_dislotwin, only: &
|
||||
plastic_dislotwin_dependentState
|
||||
use plastic_disloUCLA, only: &
|
||||
plastic_disloUCLA_dependentState
|
||||
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
|
|
@ -366,35 +303,6 @@ end subroutine constitutive_microstructure
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
|
||||
S, Fi, ipc, ip, el)
|
||||
use material, only: &
|
||||
phasememberAt, &
|
||||
phase_plasticity, &
|
||||
phase_plasticityInstance, &
|
||||
material_phase, &
|
||||
material_homogenizationAt, &
|
||||
temperature, &
|
||||
thermalMapping, &
|
||||
PLASTICITY_NONE_ID, &
|
||||
PLASTICITY_ISOTROPIC_ID, &
|
||||
PLASTICITY_PHENOPOWERLAW_ID, &
|
||||
PLASTICITY_KINEHARDENING_ID, &
|
||||
PLASTICITY_DISLOTWIN_ID, &
|
||||
PLASTICITY_DISLOUCLA_ID, &
|
||||
PLASTICITY_NONLOCAL_ID
|
||||
use mesh, only: &
|
||||
mesh_ipVolume
|
||||
use plastic_isotropic, only: &
|
||||
plastic_isotropic_LpAndItsTangent
|
||||
use plastic_phenopowerlaw, only: &
|
||||
plastic_phenopowerlaw_LpAndItsTangent
|
||||
use plastic_kinehardening, only: &
|
||||
plastic_kinehardening_LpAndItsTangent
|
||||
use plastic_dislotwin, only: &
|
||||
plastic_dislotwin_LpAndItsTangent
|
||||
use plastic_disloucla, only: &
|
||||
plastic_disloucla_LpAndItsTangent
|
||||
use plastic_nonlocal, only: &
|
||||
plastic_nonlocal_LpAndItsTangent
|
||||
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
|
|
@ -446,7 +354,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
|
|||
|
||||
case (PLASTICITY_NONLOCAL_ID) plasticityType
|
||||
call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp,Mp, &
|
||||
temperature(ho)%p(tme),mesh_ipVolume(ip,el),ip,el)
|
||||
temperature(ho)%p(tme),geometry_plastic_nonlocal_IPvolume0(ip,el),ip,el)
|
||||
|
||||
case (PLASTICITY_DISLOTWIN_ID) plasticityType
|
||||
of = phasememberAt(ipc,ip,el)
|
||||
|
|
@ -475,26 +383,6 @@ end subroutine constitutive_LpAndItsTangents
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
|
||||
S, Fi, ipc, ip, el)
|
||||
use material, only: &
|
||||
phasememberAt, &
|
||||
phase_plasticity, &
|
||||
phase_plasticityInstance, &
|
||||
phase_plasticity, &
|
||||
material_phase, &
|
||||
phase_kinematics, &
|
||||
phase_Nkinematics, &
|
||||
PLASTICITY_isotropic_ID, &
|
||||
KINEMATICS_cleavage_opening_ID, &
|
||||
KINEMATICS_slipplane_opening_ID, &
|
||||
KINEMATICS_thermal_expansion_ID
|
||||
use plastic_isotropic, only: &
|
||||
plastic_isotropic_LiAndItsTangent
|
||||
use kinematics_cleavage_opening, only: &
|
||||
kinematics_cleavage_opening_LiAndItsTangent
|
||||
use kinematics_slipplane_opening, only: &
|
||||
kinematics_slipplane_opening_LiAndItsTangent
|
||||
use kinematics_thermal_expansion, only: &
|
||||
kinematics_thermal_expansion_LiAndItsTangent
|
||||
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
|
|
@ -573,16 +461,6 @@ end subroutine constitutive_LiAndItsTangents
|
|||
!> @brief collects initial intermediate deformation gradient
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
pure function constitutive_initialFi(ipc, ip, el)
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
material_homogenizationAt, &
|
||||
thermalMapping, &
|
||||
phase_kinematics, &
|
||||
phase_Nkinematics, &
|
||||
material_phase, &
|
||||
KINEMATICS_thermal_expansion_ID
|
||||
use kinematics_thermal_expansion, only: &
|
||||
kinematics_thermal_expansion_initialStrain
|
||||
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
|
|
@ -644,14 +522,6 @@ end subroutine constitutive_SandItsTangents
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, &
|
||||
Fe, Fi, ipc, ip, el)
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
material_homogenizationAt, &
|
||||
phase_NstiffnessDegradations, &
|
||||
phase_stiffnessDegradation, &
|
||||
damage, &
|
||||
damageMapping, &
|
||||
STIFFNESS_DEGRADATION_damage_ID
|
||||
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
|
|
@ -700,54 +570,6 @@ end subroutine constitutive_hooke_SandItsTangents
|
|||
!> @brief contains the constitutive equation for calculating the rate of change of microstructure
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip, el)
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_constitutive, &
|
||||
debug_levelBasic
|
||||
use mesh, only: &
|
||||
theMesh
|
||||
use material, only: &
|
||||
phasememberAt, &
|
||||
phase_plasticityInstance, &
|
||||
phase_plasticity, &
|
||||
phase_source, &
|
||||
phase_Nsources, &
|
||||
material_phase, &
|
||||
material_homogenizationAt, &
|
||||
temperature, &
|
||||
thermalMapping, &
|
||||
homogenization_maxNgrains, &
|
||||
PLASTICITY_none_ID, &
|
||||
PLASTICITY_isotropic_ID, &
|
||||
PLASTICITY_phenopowerlaw_ID, &
|
||||
PLASTICITY_kinehardening_ID, &
|
||||
PLASTICITY_dislotwin_ID, &
|
||||
PLASTICITY_disloucla_ID, &
|
||||
PLASTICITY_nonlocal_ID, &
|
||||
SOURCE_damage_isoDuctile_ID, &
|
||||
SOURCE_damage_anisoBrittle_ID, &
|
||||
SOURCE_damage_anisoDuctile_ID, &
|
||||
SOURCE_thermal_externalheat_ID
|
||||
use plastic_isotropic, only: &
|
||||
plastic_isotropic_dotState
|
||||
use plastic_phenopowerlaw, only: &
|
||||
plastic_phenopowerlaw_dotState
|
||||
use plastic_kinehardening, only: &
|
||||
plastic_kinehardening_dotState
|
||||
use plastic_dislotwin, only: &
|
||||
plastic_dislotwin_dotState
|
||||
use plastic_disloucla, only: &
|
||||
plastic_disloucla_dotState
|
||||
use plastic_nonlocal, only: &
|
||||
plastic_nonlocal_dotState
|
||||
use source_damage_isoDuctile, only: &
|
||||
source_damage_isoDuctile_dotState
|
||||
use source_damage_anisoBrittle, only: &
|
||||
source_damage_anisoBrittle_dotState
|
||||
use source_damage_anisoDuctile, only: &
|
||||
source_damage_anisoDuctile_dotState
|
||||
use source_thermal_externalheat, only: &
|
||||
source_thermal_externalheat_dotState
|
||||
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
|
|
@ -755,7 +577,7 @@ subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip,
|
|||
el !< element
|
||||
real(pReal), intent(in) :: &
|
||||
subdt !< timestep
|
||||
real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
|
||||
real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
|
||||
FeArray, & !< elastic deformation gradient
|
||||
FpArray !< plastic deformation gradient
|
||||
real(pReal), intent(in), dimension(3,3) :: &
|
||||
|
|
@ -835,26 +657,6 @@ end subroutine constitutive_collectDotState
|
|||
!> will return false if delta state is not needed/supported by the constitutive model
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el)
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_constitutive, &
|
||||
debug_levelBasic
|
||||
use material, only: &
|
||||
phasememberAt, &
|
||||
phase_plasticityInstance, &
|
||||
phase_plasticity, &
|
||||
phase_source, &
|
||||
phase_Nsources, &
|
||||
material_phase, &
|
||||
PLASTICITY_KINEHARDENING_ID, &
|
||||
PLASTICITY_NONLOCAL_ID, &
|
||||
SOURCE_damage_isoBrittle_ID
|
||||
use plastic_kinehardening, only: &
|
||||
plastic_kinehardening_deltaState
|
||||
use plastic_nonlocal, only: &
|
||||
plastic_nonlocal_deltaState
|
||||
use source_damage_isoBrittle, only: &
|
||||
source_damage_isoBrittle_deltaState
|
||||
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
|
|
@ -903,49 +705,6 @@ end subroutine constitutive_collectDeltaState
|
|||
!> @brief returns array of constitutive results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function constitutive_postResults(S, Fi, ipc, ip, el)
|
||||
use material, only: &
|
||||
phasememberAt, &
|
||||
phase_plasticityInstance, &
|
||||
plasticState, &
|
||||
sourceState, &
|
||||
phase_plasticity, &
|
||||
phase_source, &
|
||||
phase_Nsources, &
|
||||
material_phase, &
|
||||
material_homogenizationAt, &
|
||||
temperature, &
|
||||
thermalMapping, &
|
||||
PLASTICITY_NONE_ID, &
|
||||
PLASTICITY_ISOTROPIC_ID, &
|
||||
PLASTICITY_PHENOPOWERLAW_ID, &
|
||||
PLASTICITY_KINEHARDENING_ID, &
|
||||
PLASTICITY_DISLOTWIN_ID, &
|
||||
PLASTICITY_DISLOUCLA_ID, &
|
||||
PLASTICITY_NONLOCAL_ID, &
|
||||
SOURCE_damage_isoBrittle_ID, &
|
||||
SOURCE_damage_isoDuctile_ID, &
|
||||
SOURCE_damage_anisoBrittle_ID, &
|
||||
SOURCE_damage_anisoDuctile_ID
|
||||
use plastic_isotropic, only: &
|
||||
plastic_isotropic_postResults
|
||||
use plastic_phenopowerlaw, only: &
|
||||
plastic_phenopowerlaw_postResults
|
||||
use plastic_kinehardening, only: &
|
||||
plastic_kinehardening_postResults
|
||||
use plastic_dislotwin, only: &
|
||||
plastic_dislotwin_postResults
|
||||
use plastic_disloucla, only: &
|
||||
plastic_disloucla_postResults
|
||||
use plastic_nonlocal, only: &
|
||||
plastic_nonlocal_postResults
|
||||
use source_damage_isoBrittle, only: &
|
||||
source_damage_isoBrittle_postResults
|
||||
use source_damage_isoDuctile, only: &
|
||||
source_damage_isoDuctile_postResults
|
||||
use source_damage_anisoBrittle, only: &
|
||||
source_damage_anisoBrittle_postResults
|
||||
use source_damage_anisoDuctile, only: &
|
||||
source_damage_anisoDuctile_postResults
|
||||
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
|
|
@ -1031,47 +790,18 @@ end function constitutive_postResults
|
|||
!> @brief writes constitutive results to HDF5 output file
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine constitutive_results
|
||||
use material, only: &
|
||||
PLASTICITY_ISOTROPIC_ID, &
|
||||
PLASTICITY_PHENOPOWERLAW_ID, &
|
||||
PLASTICITY_KINEHARDENING_ID, &
|
||||
PLASTICITY_DISLOTWIN_ID, &
|
||||
PLASTICITY_DISLOUCLA_ID, &
|
||||
PLASTICITY_NONLOCAL_ID
|
||||
#if defined(PETSc) || defined(DAMASK_HDF5)
|
||||
use results
|
||||
use HDF5_utilities
|
||||
use config, only: &
|
||||
config_name_phase => phase_name ! anticipate logical name
|
||||
|
||||
use material, only: &
|
||||
phase_plasticityInstance, &
|
||||
material_phase_plasticity_type => phase_plasticity
|
||||
|
||||
use plastic_isotropic, only: &
|
||||
plastic_isotropic_results
|
||||
use plastic_phenopowerlaw, only: &
|
||||
plastic_phenopowerlaw_results
|
||||
use plastic_kinehardening, only: &
|
||||
plastic_kinehardening_results
|
||||
use plastic_dislotwin, only: &
|
||||
plastic_dislotwin_results
|
||||
use plastic_disloUCLA, only: &
|
||||
plastic_disloUCLA_results
|
||||
use plastic_nonlocal, only: &
|
||||
plastic_nonlocal_results
|
||||
|
||||
integer :: p
|
||||
character(len=256) :: group
|
||||
|
||||
do p=1,size(config_name_phase)
|
||||
group = trim('current/constituent')//'/'//trim(config_name_phase(p))
|
||||
#if defined(PETSc) || defined(DAMASK_HDF5)
|
||||
do p=1,size(phase_name)
|
||||
group = trim('current/constituent')//'/'//trim(phase_name(p))
|
||||
call HDF5_closeGroup(results_addGroup(group))
|
||||
|
||||
group = trim(group)//'/plastic'
|
||||
|
||||
call HDF5_closeGroup(results_addGroup(group))
|
||||
select case(material_phase_plasticity_type(p))
|
||||
select case(phase_plasticity(p))
|
||||
|
||||
case(PLASTICITY_ISOTROPIC_ID)
|
||||
call plastic_isotropic_results(phase_plasticityInstance(p),group)
|
||||
|
|
|
|||
|
|
@ -20,13 +20,15 @@ module crystallite
|
|||
use FEsolving
|
||||
use material
|
||||
use constitutive
|
||||
use discretization
|
||||
use lattice
|
||||
use future
|
||||
use plastic_nonlocal
|
||||
#if defined(PETSc) || defined(DAMASK_HDF5)
|
||||
use geometry_plastic_nonlocal, only: &
|
||||
nIPneighbors => geometry_plastic_nonlocal_nIPneighbors, &
|
||||
IPneighborhood => geometry_plastic_nonlocal_IPneighborhood
|
||||
use HDF5_utilities
|
||||
use results
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
|
@ -172,8 +174,8 @@ subroutine crystallite_init
|
|||
write(6,'(/,a)') ' <<<+- crystallite init -+>>>'
|
||||
|
||||
cMax = homogenization_maxNgrains
|
||||
iMax = theMesh%elem%nIPs
|
||||
eMax = theMesh%nElems
|
||||
iMax = discretization_nIP
|
||||
eMax = discretization_nElem
|
||||
|
||||
allocate(crystallite_S0(3,3,cMax,iMax,eMax), source=0.0_pReal)
|
||||
allocate(crystallite_partionedS0(3,3,cMax,iMax,eMax), source=0.0_pReal)
|
||||
|
|
@ -342,7 +344,7 @@ subroutine crystallite_init
|
|||
case(elasmatrix_ID)
|
||||
mySize = 36
|
||||
case(neighboringip_ID,neighboringelement_ID)
|
||||
mySize = theMesh%elem%nIPneighbors
|
||||
mySize = nIPneighbors
|
||||
case default
|
||||
mySize = 0
|
||||
end select
|
||||
|
|
@ -361,7 +363,7 @@ subroutine crystallite_init
|
|||
call IO_write_jobFile(FILEUNIT,'outputCrystallite')
|
||||
|
||||
do r = 1,size(config_crystallite)
|
||||
if (any(microstructure_crystallite(mesh_element(4,:)) == r)) then
|
||||
if (any(microstructure_crystallite(discretization_microstructureAt) == r)) then
|
||||
write(FILEUNIT,'(/,a,/)') '['//trim(crystallite_name(r))//']'
|
||||
do o = 1,crystallite_Noutput(r)
|
||||
write(FILEUNIT,'(a,i4)') trim(crystallite_output(o,r))//char(9),crystallite_sizePostResult(o,r)
|
||||
|
|
@ -379,7 +381,7 @@ subroutine crystallite_init
|
|||
! initialize
|
||||
!$OMP PARALLEL DO PRIVATE(myNcomponents,i,c)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
myNcomponents = homogenization_Ngrains(mesh_element(3,e))
|
||||
myNcomponents = homogenization_Ngrains(material_homogenizationAt(e))
|
||||
do i = FEsolving_execIP(1,e), FEsolving_execIP(2,e); do c = 1, myNcomponents
|
||||
crystallite_Fp0(1:3,1:3,c,i,e) = math_EulerToR(material_EulerAngles(1:3,c,i,e)) ! plastic def gradient reflects init orientation
|
||||
crystallite_Fi0(1:3,1:3,c,i,e) = constitutive_initialFi(c,i,e)
|
||||
|
|
@ -407,7 +409,7 @@ subroutine crystallite_init
|
|||
!$OMP PARALLEL DO
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do c = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
call constitutive_microstructure(crystallite_Fe(1:3,1:3,c,i,e), &
|
||||
crystallite_Fp(1:3,1:3,c,i,e), &
|
||||
c,i,e) ! update dependent state variables to be consistent with basic states
|
||||
|
|
@ -424,7 +426,6 @@ subroutine crystallite_init
|
|||
write(6,'(a42,1x,i10)') ' # of elements: ', eMax
|
||||
write(6,'(a42,1x,i10)') 'max # of integration points/element: ', iMax
|
||||
write(6,'(a42,1x,i10)') 'max # of constituents/integration point: ', cMax
|
||||
write(6,'(a42,1x,i10)') 'max # of neigbours/integration point: ', theMesh%elem%nIPneighbors
|
||||
write(6,'(a42,1x,i10)') ' # of nonlocal constituents: ',count(.not. crystallite_localPlasticity)
|
||||
flush(6)
|
||||
endif
|
||||
|
|
@ -441,7 +442,7 @@ end subroutine crystallite_init
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
|
||||
|
||||
logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress
|
||||
logical, dimension(discretization_nIP,discretization_nElem) :: crystallite_stress
|
||||
real(pReal), intent(in), optional :: &
|
||||
dummyArgumentToPreventInternalCompilerErrorWithGCC
|
||||
real(pReal) :: &
|
||||
|
|
@ -480,7 +481,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
|
|||
crystallite_subStep = 0.0_pReal
|
||||
!$OMP PARALLEL DO
|
||||
elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then
|
||||
plasticState (phaseAt(c,i,e))%subState0( :,phasememberAt(c,i,e)) = &
|
||||
plasticState (phaseAt(c,i,e))%partionedState0(:,phasememberAt(c,i,e))
|
||||
|
|
@ -510,7 +511,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
|
|||
endIP = startIP
|
||||
else singleRun
|
||||
startIP = 1
|
||||
endIP = theMesh%elem%nIPs
|
||||
endIP = discretization_nIP
|
||||
endif singleRun
|
||||
|
||||
NiterationCrystallite = 0
|
||||
|
|
@ -524,7 +525,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
|
|||
!$OMP PARALLEL DO PRIVATE(formerSubStep)
|
||||
elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do c = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! wind forward
|
||||
if (crystallite_converged(c,i,e)) then
|
||||
|
|
@ -646,7 +647,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
|
|||
#ifdef DEBUG
|
||||
elementLooping6: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do c = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (.not. crystallite_converged(c,i,e)) then
|
||||
if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) &
|
||||
write(6,'(a,i8,1x,i2,1x,i3,/)') '<< CRYST stress >> no convergence at el ip ipc ', &
|
||||
|
|
@ -708,7 +709,7 @@ subroutine crystallite_stressTangent
|
|||
!$OMP rhs_3333,lhs_3333,temp_99,temp_33_1,temp_33_2,temp_33_3,temp_33_4,temp_3333,error)
|
||||
elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do c = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
|
||||
call constitutive_SandItsTangents(devNull,dSdFe,dSdFi, &
|
||||
crystallite_Fe(1:3,1:3,c,i,e), &
|
||||
|
|
@ -829,7 +830,7 @@ subroutine crystallite_orientations
|
|||
!$OMP PARALLEL DO
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do c = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do c = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
call crystallite_orientation(c,i,e)%fromRotationMatrix(transpose(math_rotationalPart33(crystallite_Fe(1:3,1:3,c,i,e))))
|
||||
enddo; enddo; enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
|
@ -851,11 +852,6 @@ end subroutine crystallite_orientations
|
|||
!> @brief Map 2nd order tensor to reference config
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function crystallite_push33ToRef(ipc,ip,el, tensor33)
|
||||
use math, only: &
|
||||
math_inv33, &
|
||||
math_EulerToR
|
||||
use material, only: &
|
||||
material_EulerAngles ! ToDo: Why stored? We also have crystallite_orientation0
|
||||
|
||||
real(pReal), dimension(3,3) :: crystallite_push33ToRef
|
||||
real(pReal), dimension(3,3), intent(in) :: tensor33
|
||||
|
|
@ -882,12 +878,10 @@ function crystallite_postResults(ipc, ip, el)
|
|||
ip, & !< integration point index
|
||||
ipc !< grain index
|
||||
|
||||
real(pReal), dimension(1+crystallite_sizePostResults(microstructure_crystallite(mesh_element(4,el))) + &
|
||||
real(pReal), dimension(1+crystallite_sizePostResults(microstructure_crystallite(discretization_microstructureAt(el))) + &
|
||||
1+plasticState(material_phase(ipc,ip,el))%sizePostResults + &
|
||||
sum(sourceState(material_phase(ipc,ip,el))%p(:)%sizePostResults)) :: &
|
||||
crystallite_postResults
|
||||
real(pReal) :: &
|
||||
detF
|
||||
integer :: &
|
||||
o, &
|
||||
c, &
|
||||
|
|
@ -896,7 +890,7 @@ function crystallite_postResults(ipc, ip, el)
|
|||
n
|
||||
type(rotation) :: rot
|
||||
|
||||
crystID = microstructure_crystallite(mesh_element(4,el))
|
||||
crystID = microstructure_crystallite(discretization_microstructureAt(el))
|
||||
|
||||
crystallite_postResults = 0.0_pReal
|
||||
crystallite_postResults(1) = real(crystallite_sizePostResults(crystID),pReal) ! header-like information (length)
|
||||
|
|
@ -960,15 +954,15 @@ function crystallite_postResults(ipc, ip, el)
|
|||
mySize = 36
|
||||
crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize])
|
||||
case(neighboringelement_ID)
|
||||
mySize = theMesh%elem%nIPneighbors
|
||||
mySize = nIPneighbors
|
||||
crystallite_postResults(c+1:c+mySize) = 0.0_pReal
|
||||
forall (n = 1:mySize) &
|
||||
crystallite_postResults(c+n) = real(mesh_ipNeighborhood(1,n,ip,el),pReal)
|
||||
crystallite_postResults(c+n) = real(IPneighborhood(1,n,ip,el),pReal)
|
||||
case(neighboringip_ID)
|
||||
mySize = theMesh%elem%nIPneighbors
|
||||
mySize = nIPneighbors
|
||||
crystallite_postResults(c+1:c+mySize) = 0.0_pReal
|
||||
forall (n = 1:mySize) &
|
||||
crystallite_postResults(c+n) = real(mesh_ipNeighborhood(2,n,ip,el),pReal)
|
||||
crystallite_postResults(c+n) = real(IPneighborhood(2,n,ip,el),pReal)
|
||||
end select
|
||||
c = c + mySize
|
||||
enddo
|
||||
|
|
@ -1064,10 +1058,6 @@ subroutine crystallite_results
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
function select_tensors(dataset,instance)
|
||||
|
||||
use material, only: &
|
||||
homogenization_maxNgrains, &
|
||||
material_phaseAt
|
||||
|
||||
integer, intent(in) :: instance
|
||||
real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset
|
||||
real(pReal), allocatable, dimension(:,:,:) :: select_tensors
|
||||
|
|
@ -1095,10 +1085,6 @@ subroutine crystallite_results
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
function select_rotations(dataset,instance)
|
||||
|
||||
use material, only: &
|
||||
homogenization_maxNgrains, &
|
||||
material_phaseAt
|
||||
|
||||
integer, intent(in) :: instance
|
||||
type(rotation), dimension(:,:,:), intent(in) :: dataset
|
||||
type(rotation), allocatable, dimension(:) :: select_rotations
|
||||
|
|
@ -1567,7 +1553,7 @@ subroutine integrateStateFPI
|
|||
!$OMP PARALLEL DO PRIVATE(p,c)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
|
||||
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
|
||||
|
||||
|
|
@ -1595,7 +1581,7 @@ subroutine integrateStateFPI
|
|||
!$OMP DO PRIVATE(sizeDotState,residuum_plastic,residuum_source,zeta,p,c)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
|
||||
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
|
||||
sizeDotState = plasticState(p)%sizeDotState
|
||||
|
|
@ -1650,7 +1636,7 @@ subroutine integrateStateFPI
|
|||
!$OMP DO
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
!$OMP FLUSH(crystallite_todo)
|
||||
if (crystallite_todo(g,i,e) .and. crystallite_converged(g,i,e)) then ! converged and still alive...
|
||||
crystallite_todo(g,i,e) = stateJump(g,i,e)
|
||||
|
|
@ -1676,7 +1662,7 @@ subroutine integrateStateFPI
|
|||
doneWithIntegration = .true.
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
|
||||
doneWithIntegration = .false.
|
||||
exit
|
||||
|
|
@ -1744,11 +1730,11 @@ subroutine integrateStateAdaptiveEuler
|
|||
|
||||
! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler
|
||||
real(pReal), dimension(constitutive_plasticity_maxSizeDotState, &
|
||||
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
|
||||
homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
|
||||
residuum_plastic
|
||||
real(pReal), dimension(constitutive_source_maxSizeDotState,&
|
||||
maxval(phase_Nsources), &
|
||||
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
|
||||
homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
|
||||
residuum_source
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
@ -1758,7 +1744,7 @@ subroutine integrateStateAdaptiveEuler
|
|||
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,c)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (crystallite_todo(g,i,e)) then
|
||||
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
|
||||
sizeDotState = plasticState(p)%sizeDotState
|
||||
|
|
@ -1787,7 +1773,7 @@ subroutine integrateStateAdaptiveEuler
|
|||
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,c)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (crystallite_todo(g,i,e)) then
|
||||
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
|
||||
sizeDotState = plasticState(p)%sizeDotState
|
||||
|
|
@ -1847,7 +1833,7 @@ subroutine integrateStateRK4
|
|||
!$OMP PARALLEL DO PRIVATE(p,c)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (crystallite_todo(g,i,e)) then
|
||||
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
|
||||
|
||||
|
|
@ -1919,11 +1905,11 @@ subroutine integrateStateRKCK45
|
|||
! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of RKCK45
|
||||
|
||||
real(pReal), dimension(constitutive_plasticity_maxSizeDotState, &
|
||||
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
|
||||
homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
|
||||
residuum_plastic ! relative residuum from evolution in microstructure
|
||||
real(pReal), dimension(constitutive_source_maxSizeDotState, &
|
||||
maxval(phase_Nsources), &
|
||||
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: &
|
||||
homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
|
||||
residuum_source ! relative residuum from evolution in microstructure
|
||||
|
||||
|
||||
|
|
@ -1938,7 +1924,7 @@ subroutine integrateStateRKCK45
|
|||
!$OMP PARALLEL DO PRIVATE(p,cc)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (crystallite_todo(g,i,e)) then
|
||||
p = phaseAt(g,i,e); cc = phasememberAt(g,i,e)
|
||||
|
||||
|
|
@ -1978,7 +1964,7 @@ subroutine integrateStateRKCK45
|
|||
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (crystallite_todo(g,i,e)) then
|
||||
p = phaseAt(g,i,e); cc = phasememberAt(g,i,e)
|
||||
|
||||
|
|
@ -2017,7 +2003,7 @@ subroutine integrateStateRKCK45
|
|||
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (crystallite_todo(g,i,e)) then
|
||||
p = phaseAt(g,i,e); cc = phasememberAt(g,i,e)
|
||||
|
||||
|
|
@ -2075,7 +2061,7 @@ subroutine setConvergenceFlag
|
|||
!OMP DO PARALLEL PRIVATE
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! if still "to do" then converged per definition
|
||||
enddo; enddo; enddo
|
||||
!OMP END DO PARALLEL
|
||||
|
|
@ -2115,7 +2101,7 @@ subroutine update_stress(timeFraction)
|
|||
!$OMP PARALLEL DO
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
!$OMP FLUSH(crystallite_todo)
|
||||
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
|
||||
crystallite_todo(g,i,e) = integrateStress(g,i,e,timeFraction)
|
||||
|
|
@ -2145,7 +2131,7 @@ subroutine update_dependentState
|
|||
!$OMP PARALLEL DO
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) &
|
||||
call constitutive_dependentState(crystallite_Fe(1:3,1:3,g,i,e), &
|
||||
crystallite_Fp(1:3,1:3,g,i,e), &
|
||||
|
|
@ -2175,7 +2161,7 @@ subroutine update_state(timeFraction)
|
|||
!$OMP PARALLEL DO PRIVATE(mySize,p,c)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
|
||||
p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
|
||||
|
||||
|
|
@ -2220,7 +2206,7 @@ subroutine update_dotState(timeFraction)
|
|||
!$OMP PARALLEL DO PRIVATE (p,c,NaN)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
!$OMP FLUSH(nonlocalStop)
|
||||
if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then
|
||||
call constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), &
|
||||
|
|
@ -2266,7 +2252,7 @@ subroutine update_deltaState
|
|||
!$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize,NaN)
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
do g = 1,homogenization_Ngrains(mesh_element(3,e))
|
||||
do g = 1,homogenization_Ngrains(material_homogenizationAt(e))
|
||||
!$OMP FLUSH(nonlocalStop)
|
||||
if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then
|
||||
call constitutive_collectDeltaState(crystallite_S(1:3,1:3,g,i,e), &
|
||||
|
|
|
|||
|
|
@ -3,43 +3,46 @@
|
|||
!> @brief material subroutine for locally evolving damage field
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module damage_local
|
||||
use prec
|
||||
use material
|
||||
use numerics
|
||||
use config
|
||||
use prec
|
||||
use material
|
||||
use numerics
|
||||
use config
|
||||
use source_damage_isoBrittle
|
||||
use source_damage_isoDuctile
|
||||
use source_damage_anisoBrittle
|
||||
use source_damage_anisoDuctile
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
integer, dimension(:,:), allocatable, target, public :: &
|
||||
damage_local_sizePostResult !< size of each post result output
|
||||
implicit none
|
||||
private
|
||||
|
||||
integer, dimension(:,:), allocatable, target, public :: &
|
||||
damage_local_sizePostResult
|
||||
character(len=64), dimension(:,:), allocatable, target, public :: &
|
||||
damage_local_output
|
||||
integer, dimension(:), allocatable, target, public :: &
|
||||
damage_local_Noutput
|
||||
|
||||
character(len=64), dimension(:,:), allocatable, target, public :: &
|
||||
damage_local_output !< name of each post result output
|
||||
|
||||
integer, dimension(:), allocatable, target, public :: &
|
||||
damage_local_Noutput !< number of outputs per instance of this damage
|
||||
|
||||
enum, bind(c)
|
||||
enumerator :: undefined_ID, &
|
||||
damage_ID
|
||||
end enum
|
||||
integer(kind(undefined_ID)), dimension(:,:), allocatable :: &
|
||||
damage_local_outputID !< ID of each post result output
|
||||
|
||||
type :: tParameters
|
||||
integer(kind(undefined_ID)), dimension(:), allocatable :: &
|
||||
outputID
|
||||
end type tParameters
|
||||
|
||||
type(tparameters), dimension(:), allocatable :: &
|
||||
param
|
||||
|
||||
public :: &
|
||||
damage_local_init, &
|
||||
damage_local_updateState, &
|
||||
damage_local_postResults
|
||||
enum, bind(c)
|
||||
enumerator :: &
|
||||
undefined_ID, &
|
||||
damage_ID
|
||||
end enum
|
||||
|
||||
integer(kind(undefined_ID)), dimension(:,:), allocatable :: &
|
||||
damage_local_outputID !< ID of each post result output
|
||||
|
||||
type :: tParameters
|
||||
integer(kind(undefined_ID)), dimension(:), allocatable :: &
|
||||
outputID
|
||||
end type tParameters
|
||||
|
||||
type(tparameters), dimension(:), allocatable :: &
|
||||
param
|
||||
|
||||
public :: &
|
||||
damage_local_init, &
|
||||
damage_local_updateState, &
|
||||
damage_local_postResults
|
||||
|
||||
contains
|
||||
|
||||
|
|
@ -49,167 +52,160 @@ contains
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine damage_local_init
|
||||
|
||||
integer :: maxNinstance,homog,instance,i
|
||||
integer :: sizeState
|
||||
integer :: NofMyHomog, h
|
||||
integer :: maxNinstance,homog,instance,i
|
||||
integer :: sizeState
|
||||
integer :: NofMyHomog, h
|
||||
integer(kind(undefined_ID)) :: &
|
||||
outputID
|
||||
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
|
||||
outputID
|
||||
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
|
||||
character(len=65536), dimension(:), allocatable :: &
|
||||
outputs
|
||||
|
||||
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>'
|
||||
|
||||
maxNinstance = count(damage_type == DAMAGE_local_ID)
|
||||
if (maxNinstance == 0) return
|
||||
|
||||
allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0)
|
||||
allocate(damage_local_output (maxval(homogenization_Noutput),maxNinstance))
|
||||
damage_local_output = ''
|
||||
allocate(damage_local_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
|
||||
allocate(damage_local_Noutput (maxNinstance), source=0)
|
||||
|
||||
allocate(param(maxNinstance))
|
||||
outputs
|
||||
|
||||
do h = 1, size(damage_type)
|
||||
if (damage_type(h) /= DAMAGE_LOCAL_ID) cycle
|
||||
associate(prm => param(damage_typeInstance(h)), &
|
||||
config => config_homogenization(h))
|
||||
|
||||
write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>'
|
||||
|
||||
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
|
||||
allocate(prm%outputID(0))
|
||||
maxNinstance = count(damage_type == DAMAGE_local_ID)
|
||||
if (maxNinstance == 0) return
|
||||
|
||||
allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0)
|
||||
allocate(damage_local_output (maxval(homogenization_Noutput),maxNinstance))
|
||||
damage_local_output = ''
|
||||
allocate(damage_local_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
|
||||
allocate(damage_local_Noutput (maxNinstance), source=0)
|
||||
|
||||
allocate(param(maxNinstance))
|
||||
|
||||
do i=1, size(outputs)
|
||||
outputID = undefined_ID
|
||||
select case(outputs(i))
|
||||
|
||||
case ('damage')
|
||||
damage_local_output(i,damage_typeInstance(h)) = outputs(i)
|
||||
damage_local_Noutput(instance) = damage_local_Noutput(instance) + 1
|
||||
damage_local_sizePostResult(i,damage_typeInstance(h)) = 1
|
||||
prm%outputID = [prm%outputID , damage_ID]
|
||||
end select
|
||||
|
||||
enddo
|
||||
do h = 1, size(damage_type)
|
||||
if (damage_type(h) /= DAMAGE_LOCAL_ID) cycle
|
||||
associate(prm => param(damage_typeInstance(h)), &
|
||||
config => config_homogenization(h))
|
||||
|
||||
|
||||
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
|
||||
allocate(prm%outputID(0))
|
||||
|
||||
do i=1, size(outputs)
|
||||
outputID = undefined_ID
|
||||
select case(outputs(i))
|
||||
|
||||
case ('damage')
|
||||
damage_local_output(i,damage_typeInstance(h)) = outputs(i)
|
||||
damage_local_Noutput(instance) = damage_local_Noutput(instance) + 1
|
||||
damage_local_sizePostResult(i,damage_typeInstance(h)) = 1
|
||||
prm%outputID = [prm%outputID , damage_ID]
|
||||
end select
|
||||
|
||||
enddo
|
||||
|
||||
|
||||
homog = h
|
||||
homog = h
|
||||
|
||||
NofMyHomog = count(material_homogenizationAt == homog)
|
||||
instance = damage_typeInstance(homog)
|
||||
NofMyHomog = count(material_homogenizationAt == homog)
|
||||
instance = damage_typeInstance(homog)
|
||||
|
||||
|
||||
! allocate state arrays
|
||||
sizeState = 1
|
||||
damageState(homog)%sizeState = sizeState
|
||||
damageState(homog)%sizePostResults = sum(damage_local_sizePostResult(:,instance))
|
||||
allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog))
|
||||
allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog))
|
||||
allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog))
|
||||
|
||||
nullify(damageMapping(homog)%p)
|
||||
damageMapping(homog)%p => mappingHomogenization(1,:,:)
|
||||
deallocate(damage(homog)%p)
|
||||
damage(homog)%p => damageState(homog)%state(1,:)
|
||||
|
||||
end associate
|
||||
enddo
|
||||
|
||||
sizeState = 1
|
||||
damageState(homog)%sizeState = sizeState
|
||||
damageState(homog)%sizePostResults = sum(damage_local_sizePostResult(:,instance))
|
||||
allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog))
|
||||
allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog))
|
||||
allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog))
|
||||
|
||||
nullify(damageMapping(homog)%p)
|
||||
damageMapping(homog)%p => mappingHomogenization(1,:,:)
|
||||
deallocate(damage(homog)%p)
|
||||
damage(homog)%p => damageState(homog)%state(1,:)
|
||||
|
||||
end associate
|
||||
enddo
|
||||
|
||||
end subroutine damage_local_init
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief calculates local change in damage field
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function damage_local_updateState(subdt, ip, el)
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
real(pReal), intent(in) :: &
|
||||
subdt
|
||||
logical, dimension(2) :: &
|
||||
damage_local_updateState
|
||||
integer :: &
|
||||
homog, &
|
||||
offset
|
||||
real(pReal) :: &
|
||||
phi, phiDot, dPhiDot_dPhi
|
||||
|
||||
homog = material_homogenizationAt(el)
|
||||
offset = mappingHomogenization(1,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))
|
||||
|
||||
damage_local_updateState = [ abs(phi - damageState(homog)%state(1,offset)) &
|
||||
<= err_damage_tolAbs &
|
||||
.or. abs(phi - damageState(homog)%state(1,offset)) &
|
||||
<= err_damage_tolRel*abs(damageState(homog)%state(1,offset)), &
|
||||
.true.]
|
||||
integer, intent(in) :: &
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
real(pReal), intent(in) :: &
|
||||
subdt
|
||||
logical, dimension(2) :: &
|
||||
damage_local_updateState
|
||||
integer :: &
|
||||
homog, &
|
||||
offset
|
||||
real(pReal) :: &
|
||||
phi, phiDot, dPhiDot_dPhi
|
||||
|
||||
homog = material_homogenizationAt(el)
|
||||
offset = mappingHomogenization(1,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))
|
||||
|
||||
damage_local_updateState = [ abs(phi - damageState(homog)%state(1,offset)) &
|
||||
<= err_damage_tolAbs &
|
||||
.or. abs(phi - damageState(homog)%state(1,offset)) &
|
||||
<= err_damage_tolRel*abs(damageState(homog)%state(1,offset)), &
|
||||
.true.]
|
||||
|
||||
damageState(homog)%state(1,offset) = phi
|
||||
damageState(homog)%state(1,offset) = phi
|
||||
|
||||
end function damage_local_updateState
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief calculates homogenized local damage driving forces
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
|
||||
use source_damage_isoBrittle, only: &
|
||||
source_damage_isobrittle_getRateAndItsTangent
|
||||
use source_damage_isoDuctile, only: &
|
||||
source_damage_isoductile_getRateAndItsTangent
|
||||
use source_damage_anisoBrittle, only: &
|
||||
source_damage_anisobrittle_getRateAndItsTangent
|
||||
use source_damage_anisoDuctile, only: &
|
||||
source_damage_anisoductile_getRateAndItsTangent
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
real(pReal), intent(in) :: &
|
||||
phi
|
||||
integer :: &
|
||||
phase, &
|
||||
grain, &
|
||||
source, &
|
||||
constituent
|
||||
real(pReal) :: &
|
||||
phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
real(pReal), intent(in) :: &
|
||||
phi
|
||||
integer :: &
|
||||
phase, &
|
||||
grain, &
|
||||
source, &
|
||||
constituent
|
||||
real(pReal) :: &
|
||||
phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi
|
||||
|
||||
phiDot = 0.0_pReal
|
||||
dPhiDot_dPhi = 0.0_pReal
|
||||
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
|
||||
phase = phaseAt(grain,ip,el)
|
||||
constituent = phasememberAt(grain,ip,el)
|
||||
do source = 1, phase_Nsources(phase)
|
||||
select case(phase_source(source,phase))
|
||||
case (SOURCE_damage_isoBrittle_ID)
|
||||
call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
|
||||
phiDot = 0.0_pReal
|
||||
dPhiDot_dPhi = 0.0_pReal
|
||||
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
|
||||
phase = phaseAt(grain,ip,el)
|
||||
constituent = phasememberAt(grain,ip,el)
|
||||
do source = 1, phase_Nsources(phase)
|
||||
select case(phase_source(source,phase))
|
||||
case (SOURCE_damage_isoBrittle_ID)
|
||||
call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
|
||||
|
||||
case (SOURCE_damage_isoDuctile_ID)
|
||||
call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
|
||||
case (SOURCE_damage_isoDuctile_ID)
|
||||
call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
|
||||
|
||||
case (SOURCE_damage_anisoBrittle_ID)
|
||||
call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
|
||||
case (SOURCE_damage_anisoBrittle_ID)
|
||||
call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
|
||||
|
||||
case (SOURCE_damage_anisoDuctile_ID)
|
||||
call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
|
||||
case (SOURCE_damage_anisoDuctile_ID)
|
||||
call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
|
||||
|
||||
case default
|
||||
localphiDot = 0.0_pReal
|
||||
dLocalphiDot_dPhi = 0.0_pReal
|
||||
case default
|
||||
localphiDot = 0.0_pReal
|
||||
dLocalphiDot_dPhi = 0.0_pReal
|
||||
|
||||
end select
|
||||
phiDot = phiDot + localphiDot
|
||||
dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi
|
||||
enddo
|
||||
enddo
|
||||
|
||||
phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
|
||||
dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
|
||||
end select
|
||||
phiDot = phiDot + localphiDot
|
||||
dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi
|
||||
enddo
|
||||
enddo
|
||||
|
||||
phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
|
||||
dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
|
||||
|
||||
end subroutine damage_local_getSourceAndItsTangent
|
||||
|
||||
|
|
@ -219,31 +215,31 @@ end subroutine damage_local_getSourceAndItsTangent
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
function damage_local_postResults(ip,el)
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, & !< integration point
|
||||
el !< element
|
||||
real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: &
|
||||
damage_local_postResults
|
||||
integer, intent(in) :: &
|
||||
ip, & !< integration point
|
||||
el !< element
|
||||
real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: &
|
||||
damage_local_postResults
|
||||
|
||||
integer :: &
|
||||
instance, homog, offset, o, c
|
||||
|
||||
homog = material_homogenizationAt(el)
|
||||
offset = damageMapping(homog)%p(ip,el)
|
||||
instance = damage_typeInstance(homog)
|
||||
associate(prm => param(instance))
|
||||
c = 0
|
||||
integer :: instance, homog, offset, o, c
|
||||
|
||||
homog = material_homogenizationAt(el)
|
||||
offset = damageMapping(homog)%p(ip,el)
|
||||
instance = damage_typeInstance(homog)
|
||||
associate(prm => param(instance))
|
||||
c = 0
|
||||
|
||||
outputsLoop: do o = 1,size(prm%outputID)
|
||||
select case(prm%outputID(o))
|
||||
|
||||
case (damage_ID)
|
||||
damage_local_postResults(c+1) = damage(homog)%p(offset)
|
||||
c = c + 1
|
||||
end select
|
||||
enddo outputsLoop
|
||||
|
||||
end associate
|
||||
|
||||
outputsLoop: do o = 1,size(prm%outputID)
|
||||
select case(prm%outputID(o))
|
||||
|
||||
case (damage_ID)
|
||||
damage_local_postResults(c+1) = damage(homog)%p(offset)
|
||||
c = c + 1
|
||||
end select
|
||||
enddo outputsLoop
|
||||
|
||||
end associate
|
||||
end function damage_local_postResults
|
||||
|
||||
end module damage_local
|
||||
|
|
|
|||
|
|
@ -19,26 +19,25 @@ module damage_nonlocal
|
|||
implicit none
|
||||
private
|
||||
|
||||
integer, dimension(:,:), allocatable, target, public :: &
|
||||
damage_nonlocal_sizePostResult !< size of each post result output
|
||||
|
||||
character(len=64), dimension(:,:), allocatable, target, public :: &
|
||||
damage_nonlocal_output !< name of each post result output
|
||||
|
||||
integer, dimension(:), allocatable, target, public :: &
|
||||
damage_nonlocal_Noutput !< number of outputs per instance of this damage
|
||||
integer, dimension(:,:), allocatable, target, public :: &
|
||||
damage_nonlocal_sizePostResult
|
||||
character(len=64), dimension(:,:), allocatable, target, public :: &
|
||||
damage_nonlocal_output
|
||||
integer, dimension(:), allocatable, target, public :: &
|
||||
damage_nonlocal_Noutput
|
||||
|
||||
enum, bind(c)
|
||||
enumerator :: undefined_ID, &
|
||||
damage_ID
|
||||
enumerator :: &
|
||||
undefined_ID, &
|
||||
damage_ID
|
||||
end enum
|
||||
|
||||
type :: tParameters
|
||||
integer(kind(undefined_ID)), dimension(:), allocatable :: &
|
||||
integer(kind(undefined_ID)), dimension(:), allocatable :: &
|
||||
outputID
|
||||
end type tParameters
|
||||
|
||||
type(tparameters), dimension(:), allocatable :: &
|
||||
type(tparameters), dimension(:), allocatable :: &
|
||||
param
|
||||
|
||||
public :: &
|
||||
|
|
@ -217,12 +216,12 @@ real(pReal) function damage_nonlocal_getMobility(ip,el)
|
|||
|
||||
damage_nonlocal_getMobility = 0.0_pReal
|
||||
|
||||
do ipc = 1, homogenization_Ngrains(mesh_element(3,el))
|
||||
do ipc = 1, homogenization_Ngrains(material_homogenizationAt(el))
|
||||
damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el))
|
||||
enddo
|
||||
|
||||
damage_nonlocal_getMobility = damage_nonlocal_getMobility/&
|
||||
real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
|
||||
|
||||
end function damage_nonlocal_getMobility
|
||||
|
||||
|
|
|
|||
110
src/debug.f90
110
src/debug.f90
|
|
@ -12,49 +12,49 @@ module debug
|
|||
implicit none
|
||||
private
|
||||
|
||||
integer(pInt), parameter, public :: &
|
||||
debug_LEVELSELECTIVE = 2_pInt**0_pInt, &
|
||||
debug_LEVELBASIC = 2_pInt**1_pInt, &
|
||||
debug_LEVELEXTENSIVE = 2_pInt**2_pInt
|
||||
integer(pInt), parameter, 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(pInt), parameter, public :: &
|
||||
debug_SPECTRALRESTART = debug_MAXGENERAL*2_pInt**1_pInt, &
|
||||
debug_SPECTRALFFTW = debug_MAXGENERAL*2_pInt**2_pInt, &
|
||||
debug_SPECTRALDIVERGENCE = debug_MAXGENERAL*2_pInt**3_pInt, &
|
||||
debug_SPECTRALROTATION = debug_MAXGENERAL*2_pInt**4_pInt, &
|
||||
debug_SPECTRALPETSC = debug_MAXGENERAL*2_pInt**5_pInt
|
||||
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(pInt), parameter, public :: &
|
||||
debug_DEBUG = 1_pInt, &
|
||||
debug_MATH = 2_pInt, &
|
||||
debug_FESOLVING = 3_pInt, &
|
||||
debug_MESH = 4_pInt, & !< stores debug level for mesh part of DAMASK bitwise coded
|
||||
debug_MATERIAL = 5_pInt, & !< stores debug level for material part of DAMASK bitwise coded
|
||||
debug_LATTICE = 6_pInt, & !< stores debug level for lattice part of DAMASK bitwise coded
|
||||
debug_CONSTITUTIVE = 7_pInt, & !< stores debug level for constitutive part of DAMASK bitwise coded
|
||||
debug_CRYSTALLITE = 8_pInt, &
|
||||
debug_HOMOGENIZATION = 9_pInt, &
|
||||
debug_CPFEM = 10_pInt, &
|
||||
debug_SPECTRAL = 11_pInt, &
|
||||
debug_MARC = 12_pInt, &
|
||||
debug_ABAQUS = 13_pInt
|
||||
integer(pInt), parameter, private :: &
|
||||
integer, parameter, public :: &
|
||||
debug_DEBUG = 1, &
|
||||
debug_MATH = 2, &
|
||||
debug_FESOLVING = 3, &
|
||||
debug_MESH = 4, & !< stores debug level for mesh part of DAMASK bitwise coded
|
||||
debug_MATERIAL = 5, & !< stores debug level for material part of DAMASK bitwise coded
|
||||
debug_LATTICE = 6, & !< stores debug level for lattice part of DAMASK bitwise coded
|
||||
debug_CONSTITUTIVE = 7, & !< stores debug level for constitutive part of DAMASK bitwise coded
|
||||
debug_CRYSTALLITE = 8, &
|
||||
debug_HOMOGENIZATION = 9, &
|
||||
debug_CPFEM = 10, &
|
||||
debug_SPECTRAL = 11, &
|
||||
debug_MARC = 12, &
|
||||
debug_ABAQUS = 13
|
||||
integer, parameter, private :: &
|
||||
debug_MAXNTYPE = debug_ABAQUS !< must be set to the maximum defined debug type
|
||||
|
||||
integer(pInt),protected, dimension(debug_maxNtype+2_pInt), public :: & ! specific ones, and 2 for "all" and "other"
|
||||
debug_level = 0_pInt
|
||||
integer,protected, dimension(debug_maxNtype+2), public :: & ! specific ones, and 2 for "all" and "other"
|
||||
debug_level = 0
|
||||
|
||||
integer(pInt), protected, public :: &
|
||||
debug_e = 1_pInt, &
|
||||
debug_i = 1_pInt, &
|
||||
debug_g = 1_pInt
|
||||
integer, protected, public :: &
|
||||
debug_e = 1, &
|
||||
debug_i = 1, &
|
||||
debug_g = 1
|
||||
|
||||
integer(pInt), dimension(2), public :: &
|
||||
debug_stressMaxLocation = 0_pInt, &
|
||||
debug_stressMinLocation = 0_pInt, &
|
||||
debug_jacobianMaxLocation = 0_pInt, &
|
||||
debug_jacobianMinLocation = 0_pInt
|
||||
integer, dimension(2), public :: &
|
||||
debug_stressMaxLocation = 0, &
|
||||
debug_stressMinLocation = 0, &
|
||||
debug_jacobianMaxLocation = 0, &
|
||||
debug_jacobianMinLocation = 0
|
||||
|
||||
|
||||
real(pReal), public :: &
|
||||
|
|
@ -100,17 +100,17 @@ subroutine debug_init
|
|||
line = fileContent(j)
|
||||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
chunkPos = IO_stringPos(line)
|
||||
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
|
||||
tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key
|
||||
select case(tag)
|
||||
case ('element','e','el')
|
||||
debug_e = IO_intValue(line,chunkPos,2_pInt)
|
||||
debug_e = IO_intValue(line,chunkPos,2)
|
||||
case ('integrationpoint','i','ip')
|
||||
debug_i = IO_intValue(line,chunkPos,2_pInt)
|
||||
debug_i = IO_intValue(line,chunkPos,2)
|
||||
case ('grain','g','gr')
|
||||
debug_g = IO_intValue(line,chunkPos,2_pInt)
|
||||
debug_g = IO_intValue(line,chunkPos,2)
|
||||
end select
|
||||
|
||||
what = 0_pInt
|
||||
what = 0
|
||||
select case(tag)
|
||||
case ('debug')
|
||||
what = debug_DEBUG
|
||||
|
|
@ -139,12 +139,12 @@ subroutine debug_init
|
|||
case ('abaqus')
|
||||
what = debug_ABAQUS
|
||||
case ('all')
|
||||
what = debug_MAXNTYPE + 1_pInt
|
||||
what = debug_MAXNTYPE + 1
|
||||
case ('other')
|
||||
what = debug_MAXNTYPE + 2_pInt
|
||||
what = debug_MAXNTYPE + 2
|
||||
end select
|
||||
if (what /= 0) then
|
||||
do i = 2_pInt, chunkPos(1)
|
||||
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)
|
||||
|
|
@ -167,11 +167,11 @@ subroutine debug_init
|
|||
endif
|
||||
enddo
|
||||
|
||||
do i = 1_pInt, debug_maxNtype
|
||||
do i = 1, debug_maxNtype
|
||||
if (debug_level(i) == 0) &
|
||||
debug_level(i) = ior(debug_level(i), debug_level(debug_MAXNTYPE + 2_pInt)) ! fill undefined debug types with levels specified by "other"
|
||||
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_pInt)) ! fill all debug types with levels specified by "all"
|
||||
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) &
|
||||
|
|
@ -184,7 +184,7 @@ subroutine debug_init
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! output switched on (debug level for debug must be extensive)
|
||||
if (iand(debug_level(debug_debug),debug_LEVELEXTENSIVE) /= 0) then
|
||||
do i = 1_pInt, debug_MAXNTYPE
|
||||
do i = 1, debug_MAXNTYPE
|
||||
select case(i)
|
||||
case (debug_DEBUG)
|
||||
tag = ' Debug'
|
||||
|
|
@ -241,10 +241,10 @@ end subroutine debug_init
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine debug_reset
|
||||
|
||||
debug_stressMaxLocation = 0_pInt
|
||||
debug_stressMinLocation = 0_pInt
|
||||
debug_jacobianMaxLocation = 0_pInt
|
||||
debug_jacobianMinLocation = 0_pInt
|
||||
debug_stressMaxLocation = 0
|
||||
debug_stressMinLocation = 0
|
||||
debug_jacobianMaxLocation = 0
|
||||
debug_jacobianMinLocation = 0
|
||||
debug_stressMax = -huge(1.0_pReal)
|
||||
debug_stressMin = huge(1.0_pReal)
|
||||
debug_jacobianMax = -huge(1.0_pReal)
|
||||
|
|
@ -260,8 +260,8 @@ subroutine debug_info
|
|||
|
||||
!$OMP CRITICAL (write2out)
|
||||
debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 &
|
||||
.and. any(debug_stressMinLocation /= 0_pInt) &
|
||||
.and. any(debug_stressMaxLocation /= 0_pInt) ) then
|
||||
.and. any(debug_stressMinLocation /= 0) &
|
||||
.and. any(debug_stressMaxLocation /= 0) ) then
|
||||
write(6,'(2/,a,/)') ' Extreme values of returned stress and Jacobian'
|
||||
write(6,'(a39)') ' value el ip'
|
||||
write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation
|
||||
|
|
|
|||
|
|
@ -0,0 +1,82 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief spatial discretization
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module discretization
|
||||
|
||||
use prec
|
||||
use results
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
integer, public, protected :: &
|
||||
discretization_nIP, &
|
||||
discretization_nElem
|
||||
|
||||
integer, public, protected, dimension(:), allocatable :: &
|
||||
discretization_homogenizationAt, &
|
||||
discretization_microstructureAt
|
||||
|
||||
real(pReal), public, protected, dimension(:,:), allocatable :: &
|
||||
discretization_IPcoords0, &
|
||||
discretization_NodeCoords0, &
|
||||
discretization_IPcoords, &
|
||||
discretization_NodeCoords
|
||||
|
||||
public :: &
|
||||
discretization_init, &
|
||||
discretization_results, &
|
||||
discretization_setIPcoords
|
||||
|
||||
contains
|
||||
|
||||
|
||||
subroutine discretization_init(homogenizationAt,microstructureAt,IPcoords0,NodeCoords0)
|
||||
|
||||
integer, dimension(:), intent(in) :: &
|
||||
homogenizationAt, &
|
||||
microstructureAt
|
||||
real(pReal), dimension(:,:), intent(in) :: &
|
||||
IPcoords0, &
|
||||
NodeCoords0
|
||||
|
||||
write(6,'(/,a)') ' <<<+- discretization init -+>>>'
|
||||
|
||||
discretization_nElem = size(microstructureAt,1)
|
||||
discretization_nIP = size(IPcoords0,2)/discretization_nElem
|
||||
|
||||
discretization_homogenizationAt = homogenizationAt
|
||||
discretization_microstructureAt = microstructureAt
|
||||
|
||||
discretization_IPcoords0 = IPcoords0
|
||||
discretization_IPcoords = IPcoords0
|
||||
|
||||
discretization_NodeCoords0 = NodeCoords0
|
||||
discretization_NodeCoords = NodeCoords0
|
||||
|
||||
end subroutine discretization_init
|
||||
|
||||
|
||||
subroutine discretization_results
|
||||
#if defined(PETSc) || defined(DAMASK_HDF5)
|
||||
real(pReal), dimension(:,:), allocatable :: u
|
||||
|
||||
u = discretization_NodeCoords -discretization_NodeCoords0
|
||||
call results_writeDataset('current',U,'U','nodal displacements','m')
|
||||
|
||||
u = discretization_IPcoords -discretization_IPcoords0
|
||||
call results_writeDataset('current',u,'u','IP displacements','m')
|
||||
#endif
|
||||
end subroutine discretization_results
|
||||
|
||||
|
||||
subroutine discretization_setIPcoords(IPcoords)
|
||||
|
||||
real(pReal), dimension(:,:), intent(in) :: IPcoords
|
||||
|
||||
discretization_IPcoords = IPcoords
|
||||
|
||||
end subroutine discretization_setIPcoords
|
||||
|
||||
|
||||
end module discretization
|
||||
|
|
@ -4,6 +4,7 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
module element
|
||||
use prec
|
||||
use IO
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
|
@ -27,7 +28,7 @@ module element
|
|||
NnodeAtIP, &
|
||||
IPneighbor, &
|
||||
cellFace
|
||||
real(pReal), dimension(:,:), allocatable :: &
|
||||
integer, dimension(:,:), allocatable :: &
|
||||
! center of gravity of the weighted nodes gives the position of the cell node.
|
||||
! example: face-centered cell node with face nodes 1,2,5,6 to be used in,
|
||||
! e.g., an 8 node element, would be encoded: 1, 1, 0, 0, 1, 1, 0, 0
|
||||
|
|
@ -129,7 +130,7 @@ module element
|
|||
6 & ! 3D 8node
|
||||
] !< number of ip neighbors / cell faces in a specific cell type
|
||||
|
||||
!integer, dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = &
|
||||
!integer, dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = & ! Intel 16.0 complains
|
||||
integer, dimension(4), parameter, private :: NCELLNODEPERCELLFACE = &
|
||||
[ &
|
||||
2, & ! 2D 3node
|
||||
|
|
@ -162,6 +163,10 @@ module element
|
|||
8 & ! 3D 8node
|
||||
] !< number of cell nodes in a specific cell type
|
||||
|
||||
|
||||
|
||||
! --------------------------------------------------------------------------------------------------
|
||||
! MD: probably not needed START
|
||||
integer, dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = &
|
||||
reshape([&
|
||||
1,2,3 &
|
||||
|
|
@ -265,8 +270,7 @@ module element
|
|||
7,8, 0,0, &
|
||||
7,0, 0,0 &
|
||||
],[maxNnodeAtIP(10),nIP(10)])
|
||||
|
||||
|
||||
|
||||
! *** FE_ipNeighbor ***
|
||||
! is a list of the neighborhood of each IP.
|
||||
! It is sorted in (local) +x,-x, +y,-y, +z,-z direction.
|
||||
|
|
@ -376,7 +380,11 @@ module element
|
|||
27,25,-4,23,-6,17, &
|
||||
-3,26,-4,24,-6,18 &
|
||||
],[nIPneighbor(cellType(10)),nIP(10)])
|
||||
|
||||
|
||||
! MD: probably not needed END
|
||||
! --------------------------------------------------------------------------------------------------
|
||||
|
||||
|
||||
|
||||
real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = &
|
||||
reshape(real([&
|
||||
|
|
@ -798,8 +806,6 @@ module element
|
|||
contains
|
||||
|
||||
subroutine tElement_init(self,elemType)
|
||||
use IO, only: &
|
||||
IO_error
|
||||
|
||||
class(tElement) :: self
|
||||
integer, intent(in) :: elemType
|
||||
|
|
|
|||
|
|
@ -3,7 +3,11 @@
|
|||
!> @brief New fortran functions for compiler versions that do not support them
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module future
|
||||
use prec
|
||||
|
||||
implicit none
|
||||
public
|
||||
|
||||
contains
|
||||
|
||||
#if defined(__GFORTRAN__) || __INTEL_COMPILER < 1800
|
||||
|
|
@ -11,6 +15,7 @@ contains
|
|||
!> @brief substitute for the findloc intrinsic (only for integer, dimension(:) at the moment)
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function findloc(a,v)
|
||||
|
||||
integer, intent(in), dimension(:) :: a
|
||||
integer, intent(in) :: v
|
||||
integer :: i,j
|
||||
|
|
@ -29,13 +34,10 @@ end function findloc
|
|||
|
||||
#if defined(__PGI)
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief substitute for the norm2 intrinsic (only for real,dimension(3) at the moment)
|
||||
!> @brief substitute for the norm2 intrinsic (only for real, dimension(3) at the moment)
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
real(pReal) pure function norm2(v)
|
||||
use prec, only: &
|
||||
pReal
|
||||
|
||||
implicit none
|
||||
real(pReal), intent(in), dimension(3) :: v
|
||||
|
||||
norm2 = sqrt(sum(v**2))
|
||||
|
|
|
|||
|
|
@ -10,43 +10,106 @@ module geometry_plastic_nonlocal
|
|||
|
||||
implicit none
|
||||
private
|
||||
logical, dimension(3), public, parameter :: &
|
||||
geometry_plastic_nonlocal_periodicSurface = .true. !< flag indicating periodic outer surfaces (used for fluxes) NEEDED?
|
||||
|
||||
integer, dimension(:,:,:,:), allocatable, public, protected :: &
|
||||
geometry_plastic_nonlocal_IPneighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me]
|
||||
|
||||
real(pReal), dimension(:,:), allocatable, public, protected :: &
|
||||
geometry_plastic_nonlocal_IPvolume !< volume associated with IP (initially!)
|
||||
|
||||
real(pReal), dimension(:,:,:), allocatable, public, protected :: &
|
||||
geometry_plastic_nonlocal_IParea !< area of interface to neighboring IP (initially!)
|
||||
|
||||
real(pReal),dimension(:,:,:,:), allocatable, public, protected :: &
|
||||
geometry_plastic_nonlocal_IPareaNormal !< area normal of interface to neighboring IP (initially!)
|
||||
|
||||
public :: &
|
||||
geometry_plastic_nonlocal_set_IPneighborhood, &
|
||||
geometry_plastic_nonlocal_set_IPvolume
|
||||
|
||||
contains
|
||||
|
||||
subroutine geometry_plastic_nonlocal_set_IPneighborhood(IPneighborhood)
|
||||
integer, public, protected :: &
|
||||
geometry_plastic_nonlocal_nIPneighbors
|
||||
|
||||
integer, dimension(:,:,:,:), allocatable, public, protected :: &
|
||||
geometry_plastic_nonlocal_IPneighborhood !< 6 or less neighboring IPs as [element ID, IP ID, face ID that point to me]
|
||||
|
||||
real(pReal), dimension(:,:), allocatable, public, protected :: &
|
||||
geometry_plastic_nonlocal_IPvolume0 !< volume associated with IP (initially!)
|
||||
|
||||
real(pReal), dimension(:,:,:), allocatable, public, protected :: &
|
||||
geometry_plastic_nonlocal_IParea0 !< area of interface to neighboring IP (initially!)
|
||||
|
||||
real(pReal), dimension(:,:,:,:), allocatable, public, protected :: &
|
||||
geometry_plastic_nonlocal_IPareaNormal0 !< area normal of interface to neighboring IP (initially!)
|
||||
|
||||
|
||||
public :: &
|
||||
geometry_plastic_nonlocal_setIPneighborhood, &
|
||||
geometry_plastic_nonlocal_setIPvolume, &
|
||||
geometry_plastic_nonlocal_setIParea, &
|
||||
geometry_plastic_nonlocal_setIPareaNormal, &
|
||||
geometry_plastic_nonlocal_disable
|
||||
|
||||
contains
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> @brief Set the integration point (IP) neighborhood
|
||||
!> @details: The IP neighborhood for element ID (last index), IP ID (second but last index) and
|
||||
! face ID (second index) gives the element ID (1 @ first index), IP ID (2 @ first index)
|
||||
! and face ID (3 @ first index).
|
||||
! A triangle (2D) has 3 faces, a quadrilateral (2D) had 4 faces, a tetrahedron (3D) has
|
||||
! 4 faces, and a hexahedron (3D) has 6 faces.
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
subroutine geometry_plastic_nonlocal_setIPneighborhood(IPneighborhood)
|
||||
|
||||
integer, dimension(:,:,:,:), intent(in) :: IPneighborhood
|
||||
|
||||
geometry_plastic_nonlocal_IPneighborhood = IPneighborhood
|
||||
geometry_plastic_nonlocal_nIPneighbors = size(IPneighborhood,2)
|
||||
|
||||
|
||||
end subroutine geometry_plastic_nonlocal_set_IPneighborhood
|
||||
end subroutine geometry_plastic_nonlocal_setIPneighborhood
|
||||
|
||||
|
||||
subroutine geometry_plastic_nonlocal_set_IPvolume(IPvolume)
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> @brief Set the initial volume associated with an integration point
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
subroutine geometry_plastic_nonlocal_setIPvolume(IPvolume)
|
||||
|
||||
real(pReal), dimension(:,:), intent(in) :: IPvolume
|
||||
|
||||
geometry_plastic_nonlocal_IPvolume = IPvolume
|
||||
geometry_plastic_nonlocal_IPvolume0 = IPvolume
|
||||
|
||||
end subroutine geometry_plastic_nonlocal_set_IPvolume
|
||||
end subroutine geometry_plastic_nonlocal_setIPvolume
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> @brief Set the initial areas of the unit triangle/unit quadrilateral/tetrahedron/hexahedron
|
||||
! encompassing an integration point
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
subroutine geometry_plastic_nonlocal_setIParea(IParea)
|
||||
|
||||
real(pReal), dimension(:,:,:), intent(in) :: IParea
|
||||
|
||||
geometry_plastic_nonlocal_IParea0 = IParea
|
||||
|
||||
end subroutine geometry_plastic_nonlocal_setIParea
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> @brief Set the direction normal of the areas of the triangle/quadrilateral/tetrahedron/hexahedron
|
||||
! encompassing an integration point
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
subroutine geometry_plastic_nonlocal_setIPareaNormal(IPareaNormal)
|
||||
|
||||
real(pReal), dimension(:,:,:,:), intent(in) :: IPareaNormal
|
||||
|
||||
geometry_plastic_nonlocal_IPareaNormal0 = IPareaNormal
|
||||
|
||||
end subroutine geometry_plastic_nonlocal_setIPareaNormal
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> @brief Frees memory used by variables only needed by plastic_nonlocal
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
subroutine geometry_plastic_nonlocal_disable
|
||||
|
||||
if(allocated(geometry_plastic_nonlocal_IPneighborhood)) &
|
||||
deallocate(geometry_plastic_nonlocal_IPneighborhood)
|
||||
|
||||
if(allocated(geometry_plastic_nonlocal_IPvolume0)) &
|
||||
deallocate(geometry_plastic_nonlocal_IPvolume0)
|
||||
|
||||
if(allocated(geometry_plastic_nonlocal_IParea0)) &
|
||||
deallocate(geometry_plastic_nonlocal_IParea0)
|
||||
|
||||
if(allocated(geometry_plastic_nonlocal_IPareaNormal0)) &
|
||||
deallocate(geometry_plastic_nonlocal_IPareaNormal0)
|
||||
|
||||
end subroutine geometry_plastic_nonlocal_disable
|
||||
|
||||
end module geometry_plastic_nonlocal
|
||||
|
|
|
|||
|
|
@ -9,14 +9,17 @@ module grid_damage_spectral
|
|||
#include <petsc/finclude/petscdmda.h>
|
||||
use PETScdmda
|
||||
use PETScsnes
|
||||
use prec, only: &
|
||||
pReal
|
||||
use spectral_utilities, only: &
|
||||
tSolutionState, &
|
||||
tSolutionParams
|
||||
|
||||
use prec
|
||||
use spectral_utilities
|
||||
use mesh
|
||||
use damage_nonlocal
|
||||
use numerics
|
||||
use damage_nonlocal
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! derived types
|
||||
type(tSolutionParams), private :: params
|
||||
|
|
@ -51,18 +54,6 @@ contains
|
|||
! ToDo: Restart not implemented
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_damage_spectral_init
|
||||
use spectral_utilities, only: &
|
||||
wgt
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use damage_nonlocal, only: &
|
||||
damage_nonlocal_getDiffusion33, &
|
||||
damage_nonlocal_getMobility
|
||||
use numerics, only: &
|
||||
worldrank, &
|
||||
worldsize, &
|
||||
petsc_options
|
||||
|
||||
PetscInt, dimension(worldsize) :: localK
|
||||
integer :: i, j, k, cell
|
||||
|
|
@ -153,15 +144,6 @@ end subroutine grid_damage_spectral_init
|
|||
!> @brief solution for the spectral damage scheme with internal iterations
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function grid_damage_spectral_solution(timeinc,timeinc_old,loadCaseTime) result(solution)
|
||||
use numerics, only: &
|
||||
itmax, &
|
||||
err_damage_tolAbs, &
|
||||
err_damage_tolRel
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use damage_nonlocal, only: &
|
||||
damage_nonlocal_putNonLocalDamage
|
||||
|
||||
real(pReal), intent(in) :: &
|
||||
timeinc, & !< increment in time for current solution
|
||||
|
|
@ -223,17 +205,7 @@ end function grid_damage_spectral_solution
|
|||
!> @brief spectral damage forwarding routine
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_damage_spectral_forward
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use spectral_utilities, only: &
|
||||
cutBack, &
|
||||
wgt
|
||||
use damage_nonlocal, only: &
|
||||
damage_nonlocal_putNonLocalDamage, &
|
||||
damage_nonlocal_getDiffusion33, &
|
||||
damage_nonlocal_getMobility
|
||||
|
||||
|
||||
integer :: i, j, k, cell
|
||||
DM :: dm_local
|
||||
PetscScalar, dimension(:,:,:), pointer :: x_scal
|
||||
|
|
@ -278,25 +250,6 @@ end subroutine grid_damage_spectral_forward
|
|||
!> @brief forms the spectral damage residual vector
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
|
||||
use numerics, only: &
|
||||
residualStiffness
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use spectral_utilities, only: &
|
||||
scalarField_real, &
|
||||
vectorField_real, &
|
||||
utilities_FFTvectorForward, &
|
||||
utilities_FFTvectorBackward, &
|
||||
utilities_FFTscalarForward, &
|
||||
utilities_FFTscalarBackward, &
|
||||
utilities_fourierGreenConvolution, &
|
||||
utilities_fourierScalarGradient, &
|
||||
utilities_fourierVectorDivergence
|
||||
use damage_nonlocal, only: &
|
||||
damage_nonlocal_getSourceAndItsTangent,&
|
||||
damage_nonlocal_getDiffusion33, &
|
||||
damage_nonlocal_getMobility
|
||||
|
||||
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
|
||||
in
|
||||
|
|
|
|||
|
|
@ -11,13 +11,18 @@ module grid_mech_FEM
|
|||
use HDF5_utilities
|
||||
use PETScdmda
|
||||
use PETScsnes
|
||||
use prec, only: &
|
||||
pReal
|
||||
use math, only: &
|
||||
math_I3
|
||||
use spectral_utilities, only: &
|
||||
tSolutionState, &
|
||||
tSolutionParams
|
||||
use prec
|
||||
use CPFEM2
|
||||
use IO
|
||||
use debug
|
||||
use FEsolving
|
||||
use numerics
|
||||
use homogenization
|
||||
use DAMASK_interface
|
||||
use spectral_utilities
|
||||
use discretization
|
||||
use mesh
|
||||
use math
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
|
@ -74,30 +79,6 @@ contains
|
|||
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_mech_FEM_init
|
||||
use IO, only: &
|
||||
IO_intOut, &
|
||||
IO_error, &
|
||||
IO_open_jobFile_binary
|
||||
use FEsolving, only: &
|
||||
restartInc
|
||||
use numerics, only: &
|
||||
worldrank, &
|
||||
worldsize, &
|
||||
petsc_options
|
||||
use homogenization, only: &
|
||||
materialpoint_F0
|
||||
use DAMASK_interface, only: &
|
||||
getSolverJobName
|
||||
use spectral_utilities, only: &
|
||||
utilities_constitutiveResponse, &
|
||||
utilities_updateIPcoords, &
|
||||
wgt
|
||||
use mesh, only: &
|
||||
geomSize, &
|
||||
grid, &
|
||||
grid3
|
||||
use math, only: &
|
||||
math_invSym3333
|
||||
|
||||
real(pReal) :: HGCoeff = 0e-2_pReal
|
||||
PetscInt, dimension(:), allocatable :: localK
|
||||
|
|
@ -243,14 +224,6 @@ end subroutine grid_mech_FEM_init
|
|||
!> @brief solution for the FEM scheme with internal iterations
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function grid_mech_FEM_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) result(solution)
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use spectral_utilities, only: &
|
||||
tBoundaryCondition, &
|
||||
utilities_maskedCompliance
|
||||
use FEsolving, only: &
|
||||
restartWrite, &
|
||||
terminallyIll
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! input data for solution
|
||||
|
|
@ -304,25 +277,6 @@ end function grid_mech_FEM_solution
|
|||
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_mech_FEM_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
|
||||
use math, only: &
|
||||
math_rotate_backward33
|
||||
use numerics, only: &
|
||||
worldrank
|
||||
use homogenization, only: &
|
||||
materialpoint_F0
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use CPFEM2, only: &
|
||||
CPFEM_age
|
||||
use spectral_utilities, only: &
|
||||
utilities_updateIPcoords, &
|
||||
tBoundaryCondition, &
|
||||
cutBack
|
||||
use IO, only: &
|
||||
IO_open_jobFile_binary
|
||||
use FEsolving, only: &
|
||||
restartWrite
|
||||
|
||||
logical, intent(in) :: &
|
||||
guess
|
||||
|
|
@ -422,17 +376,6 @@ end subroutine grid_mech_FEM_forward
|
|||
!> @brief convergence check
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,ierr)
|
||||
use mesh
|
||||
use spectral_utilities
|
||||
use numerics, only: &
|
||||
itmax, &
|
||||
itmin, &
|
||||
err_div_tolRel, &
|
||||
err_div_tolAbs, &
|
||||
err_stress_tolRel, &
|
||||
err_stress_tolAbs
|
||||
use FEsolving, only: &
|
||||
terminallyIll
|
||||
|
||||
SNES :: snes_local
|
||||
PetscInt, intent(in) :: PETScIter
|
||||
|
|
@ -481,28 +424,6 @@ end subroutine converged
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine formResidual(da_local,x_local, &
|
||||
f_local,dummy,ierr)
|
||||
use numerics, only: &
|
||||
itmax, &
|
||||
itmin
|
||||
use numerics, only: &
|
||||
worldrank
|
||||
use mesh, only: &
|
||||
grid
|
||||
use math, only: &
|
||||
math_rotate_backward33, &
|
||||
math_mul3333xx33
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_spectral, &
|
||||
debug_spectralRotation
|
||||
use spectral_utilities, only: &
|
||||
utilities_constitutiveResponse
|
||||
use IO, only: &
|
||||
IO_intOut
|
||||
use FEsolving, only: &
|
||||
terminallyIll
|
||||
use homogenization, only: &
|
||||
materialpoint_dPdF
|
||||
|
||||
DM :: da_local
|
||||
Vec :: x_local, f_local
|
||||
|
|
@ -617,12 +538,7 @@ end subroutine formResidual
|
|||
!> @brief forms the FEM stiffness matrix
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr)
|
||||
use mesh, only: &
|
||||
mesh_ipCoordinates
|
||||
use homogenization, only: &
|
||||
materialpoint_dPdF
|
||||
|
||||
|
||||
|
||||
DM :: da_local
|
||||
Vec :: x_local, coordinates
|
||||
Mat :: Jac_pre, Jac
|
||||
|
|
@ -699,7 +615,7 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr)
|
|||
ele = 0
|
||||
do k = zstart, zend; do j = ystart, yend; do i = xstart, xend
|
||||
ele = ele + 1
|
||||
x_scal(0:2,i,j,k) = mesh_ipCoordinates(1:3,1,ele)
|
||||
x_scal(0:2,i,j,k) = discretization_IPcoords(1:3,ele)
|
||||
enddo; enddo; enddo
|
||||
call DMDAVecRestoreArrayF90(da_local,coordinates,x_scal,ierr);CHKERRQ(ierr) ! initialize to undeformed coordinates (ToDo: use ip coordinates)
|
||||
call MatNullSpaceCreateRigidBody(coordinates,matnull,ierr);CHKERRQ(ierr) ! get rigid body deformation modes
|
||||
|
|
|
|||
|
|
@ -7,18 +7,23 @@
|
|||
module grid_mech_spectral_basic
|
||||
#include <petsc/finclude/petscsnes.h>
|
||||
#include <petsc/finclude/petscdmda.h>
|
||||
use DAMASK_interface
|
||||
use HDF5_utilities
|
||||
use PETScdmda
|
||||
use PETScsnes
|
||||
use prec, only: &
|
||||
pReal
|
||||
use math, only: &
|
||||
math_I3
|
||||
use spectral_utilities, only: &
|
||||
tSolutionState, &
|
||||
tSolutionParams
|
||||
|
||||
|
||||
use prec
|
||||
use DAMASK_interface
|
||||
use HDF5_utilities
|
||||
use math
|
||||
use spectral_utilities
|
||||
use IO
|
||||
use FEsolving
|
||||
use config
|
||||
use numerics
|
||||
use homogenization
|
||||
use mesh
|
||||
use CPFEM2
|
||||
use debug
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
|
|
@ -81,31 +86,6 @@ contains
|
|||
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_mech_spectral_basic_init
|
||||
use IO, only: &
|
||||
IO_intOut, &
|
||||
IO_error, &
|
||||
IO_open_jobFile_binary
|
||||
use FEsolving, only: &
|
||||
restartInc
|
||||
use config, only :&
|
||||
config_numerics
|
||||
use numerics, only: &
|
||||
worldrank, &
|
||||
worldsize, &
|
||||
petsc_options
|
||||
use homogenization, only: &
|
||||
materialpoint_F0
|
||||
use DAMASK_interface, only: &
|
||||
getSolverJobName
|
||||
use spectral_utilities, only: &
|
||||
utilities_constitutiveResponse, &
|
||||
utilities_updateGamma, &
|
||||
utilities_updateIPcoords
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use math, only: &
|
||||
math_invSym3333
|
||||
|
||||
real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P
|
||||
real(pReal), dimension(3,3) :: &
|
||||
|
|
@ -215,13 +195,6 @@ end subroutine grid_mech_spectral_basic_init
|
|||
!> @brief solution for the basic scheme with internal iterations
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function grid_mech_spectral_basic_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) result(solution)
|
||||
use spectral_utilities, only: &
|
||||
tBoundaryCondition, &
|
||||
utilities_maskedCompliance, &
|
||||
utilities_updateGamma
|
||||
use FEsolving, only: &
|
||||
restartWrite, &
|
||||
terminallyIll
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! input data for solution
|
||||
|
|
@ -277,27 +250,6 @@ end function grid_mech_spectral_basic_solution
|
|||
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_mech_spectral_basic_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
|
||||
use math, only: &
|
||||
math_rotate_backward33
|
||||
use numerics, only: &
|
||||
worldrank
|
||||
use homogenization, only: &
|
||||
materialpoint_F0
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use CPFEM2, only: &
|
||||
CPFEM_age
|
||||
use spectral_utilities, only: &
|
||||
utilities_calculateRate, &
|
||||
utilities_forwardField, &
|
||||
utilities_updateIPcoords, &
|
||||
tBoundaryCondition, &
|
||||
cutBack
|
||||
use IO, only: &
|
||||
IO_open_jobFile_binary
|
||||
use FEsolving, only: &
|
||||
restartWrite
|
||||
|
||||
logical, intent(in) :: &
|
||||
guess
|
||||
|
|
@ -387,15 +339,6 @@ end subroutine grid_mech_spectral_basic_forward
|
|||
!> @brief convergence check
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dummy,ierr)
|
||||
use numerics, only: &
|
||||
itmax, &
|
||||
itmin, &
|
||||
err_div_tolRel, &
|
||||
err_div_tolAbs, &
|
||||
err_stress_tolRel, &
|
||||
err_stress_tolAbs
|
||||
use FEsolving, only: &
|
||||
terminallyIll
|
||||
|
||||
SNES :: snes_local
|
||||
PetscInt, intent(in) :: PETScIter
|
||||
|
|
@ -442,30 +385,6 @@ end subroutine converged
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine formResidual(in, F, &
|
||||
residuum, dummy, ierr)
|
||||
use numerics, only: &
|
||||
itmax, &
|
||||
itmin
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use math, only: &
|
||||
math_rotate_backward33, &
|
||||
math_mul3333xx33
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_spectral, &
|
||||
debug_spectralRotation
|
||||
use spectral_utilities, only: &
|
||||
tensorField_real, &
|
||||
utilities_FFTtensorForward, &
|
||||
utilities_fourierGammaConvolution, &
|
||||
utilities_FFTtensorBackward, &
|
||||
utilities_constitutiveResponse, &
|
||||
utilities_divergenceRMS
|
||||
use IO, only: &
|
||||
IO_intOut
|
||||
use FEsolving, only: &
|
||||
terminallyIll
|
||||
|
||||
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: in !< DMDA info (needs to be named "in" for macros like XRANGE to work)
|
||||
PetscScalar, dimension(3,3,XG_RANGE,YG_RANGE,ZG_RANGE), &
|
||||
|
|
|
|||
|
|
@ -7,17 +7,22 @@
|
|||
module grid_mech_spectral_polarisation
|
||||
#include <petsc/finclude/petscsnes.h>
|
||||
#include <petsc/finclude/petscdmda.h>
|
||||
use DAMASK_interface
|
||||
use HDF5_utilities
|
||||
use PETScdmda
|
||||
use PETScsnes
|
||||
use prec, only: &
|
||||
pReal
|
||||
use math, only: &
|
||||
math_I3
|
||||
use spectral_utilities, only: &
|
||||
tSolutionState, &
|
||||
tSolutionParams
|
||||
|
||||
use prec
|
||||
use DAMASK_interface
|
||||
use HDF5_utilities
|
||||
use math
|
||||
use spectral_utilities
|
||||
use IO
|
||||
use FEsolving
|
||||
use config
|
||||
use numerics
|
||||
use homogenization
|
||||
use mesh
|
||||
use CPFEM2
|
||||
use debug
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
|
@ -87,32 +92,7 @@ contains
|
|||
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_mech_spectral_polarisation_init
|
||||
use IO, only: &
|
||||
IO_intOut, &
|
||||
IO_error, &
|
||||
IO_open_jobFile_binary
|
||||
use FEsolving, only: &
|
||||
restartInc
|
||||
use config, only :&
|
||||
config_numerics
|
||||
use numerics, only: &
|
||||
worldrank, &
|
||||
worldsize, &
|
||||
petsc_options
|
||||
use homogenization, only: &
|
||||
materialpoint_F0
|
||||
use DAMASK_interface, only: &
|
||||
getSolverJobName
|
||||
use spectral_utilities, only: &
|
||||
utilities_constitutiveResponse, &
|
||||
utilities_updateGamma, &
|
||||
utilities_updateIPcoords
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use math, only: &
|
||||
math_invSym3333
|
||||
|
||||
|
||||
real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P
|
||||
real(pReal), dimension(3,3) :: &
|
||||
temp33_Real = 0.0_pReal
|
||||
|
|
@ -230,15 +210,6 @@ end subroutine grid_mech_spectral_polarisation_init
|
|||
!> @brief solution for the Polarisation scheme with internal iterations
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function grid_mech_spectral_polarisation_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) result(solution)
|
||||
use math, only: &
|
||||
math_invSym3333
|
||||
use spectral_utilities, only: &
|
||||
tBoundaryCondition, &
|
||||
utilities_maskedCompliance, &
|
||||
utilities_updateGamma
|
||||
use FEsolving, only: &
|
||||
restartWrite, &
|
||||
terminallyIll
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! input data for solution
|
||||
|
|
@ -298,28 +269,6 @@ end function grid_mech_spectral_polarisation_solution
|
|||
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_mech_spectral_polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
|
||||
use math, only: &
|
||||
math_mul3333xx33, &
|
||||
math_rotate_backward33
|
||||
use numerics, only: &
|
||||
worldrank
|
||||
use homogenization, only: &
|
||||
materialpoint_F0
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use CPFEM2, only: &
|
||||
CPFEM_age
|
||||
use spectral_utilities, only: &
|
||||
utilities_calculateRate, &
|
||||
utilities_forwardField, &
|
||||
utilities_updateIPcoords, &
|
||||
tBoundaryCondition, &
|
||||
cutBack
|
||||
use IO, only: &
|
||||
IO_open_jobFile_binary
|
||||
use FEsolving, only: &
|
||||
restartWrite
|
||||
|
||||
logical, intent(in) :: &
|
||||
guess
|
||||
|
|
@ -434,17 +383,6 @@ end subroutine grid_mech_spectral_polarisation_forward
|
|||
!> @brief convergence check
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dummy,ierr)
|
||||
use numerics, only: &
|
||||
itmax, &
|
||||
itmin, &
|
||||
err_div_tolRel, &
|
||||
err_div_tolAbs, &
|
||||
err_curl_tolRel, &
|
||||
err_curl_tolAbs, &
|
||||
err_stress_tolRel, &
|
||||
err_stress_tolAbs
|
||||
use FEsolving, only: &
|
||||
terminallyIll
|
||||
|
||||
SNES :: snes_local
|
||||
PetscInt, intent(in) :: PETScIter
|
||||
|
|
@ -496,38 +434,6 @@ end subroutine converged
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine formResidual(in, FandF_tau, &
|
||||
residuum, dummy,ierr)
|
||||
use numerics, only: &
|
||||
itmax, &
|
||||
itmin, &
|
||||
polarAlpha, &
|
||||
polarBeta
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use math, only: &
|
||||
math_rotate_forward33, &
|
||||
math_rotate_backward33, &
|
||||
math_mul3333xx33, &
|
||||
math_invSym3333
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_spectral, &
|
||||
debug_spectralRotation
|
||||
use spectral_utilities, only: &
|
||||
wgt, &
|
||||
tensorField_real, &
|
||||
utilities_FFTtensorForward, &
|
||||
utilities_fourierGammaConvolution, &
|
||||
utilities_FFTtensorBackward, &
|
||||
utilities_constitutiveResponse, &
|
||||
utilities_divergenceRMS, &
|
||||
utilities_curlRMS
|
||||
use IO, only: &
|
||||
IO_intOut
|
||||
use homogenization, only: &
|
||||
materialpoint_dPdF
|
||||
use FEsolving, only: &
|
||||
terminallyIll
|
||||
|
||||
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: in !< DMDA info (needs to be named "in" for macros like XRANGE to work)
|
||||
PetscScalar, dimension(3,3,2,XG_RANGE,YG_RANGE,ZG_RANGE), &
|
||||
|
|
|
|||
|
|
@ -9,14 +9,17 @@ module grid_thermal_spectral
|
|||
#include <petsc/finclude/petscdmda.h>
|
||||
use PETScdmda
|
||||
use PETScsnes
|
||||
use prec, only: &
|
||||
pReal
|
||||
use spectral_utilities, only: &
|
||||
tSolutionState, &
|
||||
tSolutionParams
|
||||
|
||||
use prec
|
||||
use spectral_utilities
|
||||
use mesh
|
||||
use thermal_conduction
|
||||
use material
|
||||
use numerics
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! derived types
|
||||
type(tSolutionParams), private :: params
|
||||
|
|
@ -51,23 +54,6 @@ contains
|
|||
! ToDo: Restart not implemented
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_thermal_spectral_init
|
||||
use spectral_utilities, only: &
|
||||
wgt
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use thermal_conduction, only: &
|
||||
thermal_conduction_getConductivity33, &
|
||||
thermal_conduction_getMassDensity, &
|
||||
thermal_conduction_getSpecificHeat
|
||||
use material, only: &
|
||||
material_homogenizationAt, &
|
||||
temperature, &
|
||||
thermalMapping
|
||||
use numerics, only: &
|
||||
worldrank, &
|
||||
worldsize, &
|
||||
petsc_options
|
||||
|
||||
PetscInt, dimension(worldsize) :: localK
|
||||
integer :: i, j, k, cell
|
||||
|
|
@ -156,15 +142,6 @@ end subroutine grid_thermal_spectral_init
|
|||
!> @brief solution for the spectral thermal scheme with internal iterations
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function grid_thermal_spectral_solution(timeinc,timeinc_old,loadCaseTime) result(solution)
|
||||
use numerics, only: &
|
||||
itmax, &
|
||||
err_thermal_tolAbs, &
|
||||
err_thermal_tolRel
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use thermal_conduction, only: &
|
||||
thermal_conduction_putTemperatureAndItsRate
|
||||
|
||||
real(pReal), intent(in) :: &
|
||||
timeinc, & !< increment in time for current solution
|
||||
|
|
@ -228,18 +205,7 @@ end function grid_thermal_spectral_solution
|
|||
!> @brief forwarding routine
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_thermal_spectral_forward
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use spectral_utilities, only: &
|
||||
cutBack, &
|
||||
wgt
|
||||
use thermal_conduction, only: &
|
||||
thermal_conduction_putTemperatureAndItsRate, &
|
||||
thermal_conduction_getConductivity33, &
|
||||
thermal_conduction_getMassDensity, &
|
||||
thermal_conduction_getSpecificHeat
|
||||
|
||||
|
||||
integer :: i, j, k, cell
|
||||
DM :: dm_local
|
||||
PetscScalar, dimension(:,:,:), pointer :: x_scal
|
||||
|
|
@ -289,24 +255,6 @@ end subroutine grid_thermal_spectral_forward
|
|||
!> @brief forms the spectral thermal residual vector
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
use spectral_utilities, only: &
|
||||
scalarField_real, &
|
||||
vectorField_real, &
|
||||
utilities_FFTvectorForward, &
|
||||
utilities_FFTvectorBackward, &
|
||||
utilities_FFTscalarForward, &
|
||||
utilities_FFTscalarBackward, &
|
||||
utilities_fourierGreenConvolution, &
|
||||
utilities_fourierScalarGradient, &
|
||||
utilities_fourierVectorDivergence
|
||||
use thermal_conduction, only: &
|
||||
thermal_conduction_getSourceAndItsTangent, &
|
||||
thermal_conduction_getConductivity33, &
|
||||
thermal_conduction_getMassDensity, &
|
||||
thermal_conduction_getSpecificHeat
|
||||
|
||||
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
|
||||
in
|
||||
|
|
|
|||
|
|
@ -7,14 +7,20 @@ module spectral_utilities
|
|||
use, intrinsic :: iso_c_binding
|
||||
#include <petsc/finclude/petscsys.h>
|
||||
use PETScSys
|
||||
use prec, only: &
|
||||
pReal, &
|
||||
pStringLen
|
||||
use math, only: &
|
||||
math_I3
|
||||
|
||||
use prec
|
||||
use math
|
||||
use IO
|
||||
use mesh
|
||||
use numerics
|
||||
use debug
|
||||
use config
|
||||
use discretization
|
||||
use homogenization
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
include 'fftw3-mpi.f03'
|
||||
|
||||
logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
|
||||
|
|
@ -170,32 +176,7 @@ contains
|
|||
!> Initializes FFTW.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_init
|
||||
use IO, only: &
|
||||
IO_error, &
|
||||
IO_warning, &
|
||||
IO_lc
|
||||
use numerics, only: &
|
||||
petsc_defaultOptions, &
|
||||
petsc_options
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_SPECTRAL, &
|
||||
debug_LEVELBASIC, &
|
||||
debug_SPECTRALDIVERGENCE, &
|
||||
debug_SPECTRALFFTW, &
|
||||
debug_SPECTRALPETSC, &
|
||||
debug_SPECTRALROTATION
|
||||
use config, only: &
|
||||
config_numerics
|
||||
use debug, only: &
|
||||
PETSCDEBUG
|
||||
use math
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3, &
|
||||
grid3Offset, &
|
||||
geomSize
|
||||
|
||||
|
||||
PetscErrorCode :: ierr
|
||||
integer :: i, j, k, &
|
||||
FFTW_planner_flag
|
||||
|
|
@ -412,17 +393,6 @@ end subroutine utilities_init
|
|||
!> Also writes out the current reference stiffness for restart.
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_updateGamma(C,saveReference)
|
||||
use IO, only: &
|
||||
IO_open_jobFile_binary
|
||||
use numerics, only: &
|
||||
worldrank
|
||||
use mesh, only: &
|
||||
grid3Offset, &
|
||||
grid3,&
|
||||
grid
|
||||
use math, only: &
|
||||
math_det33, &
|
||||
math_invert2
|
||||
|
||||
real(pReal), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness
|
||||
logical , intent(in) :: saveReference !< save reference stiffness to file for restart
|
||||
|
|
@ -538,13 +508,6 @@ end subroutine utilities_FFTvectorBackward
|
|||
!> @brief doing convolution gamma_hat * field_real, ensuring that average value = fieldAim
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_fourierGammaConvolution(fieldAim)
|
||||
use math, only: &
|
||||
math_det33, &
|
||||
math_invert2
|
||||
use mesh, only: &
|
||||
grid3, &
|
||||
grid, &
|
||||
grid3Offset
|
||||
|
||||
real(pReal), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution
|
||||
complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx
|
||||
|
|
@ -600,12 +563,7 @@ end subroutine utilities_fourierGammaConvolution
|
|||
!> @brief doing convolution DamageGreenOp_hat * field_real
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_fourierGreenConvolution(D_ref, mobility_ref, deltaT)
|
||||
use math, only: &
|
||||
PI
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3
|
||||
|
||||
|
||||
real(pReal), dimension(3,3), intent(in) :: D_ref
|
||||
real(pReal), intent(in) :: mobility_ref, deltaT
|
||||
complex(pReal) :: GreenOp_hat
|
||||
|
|
@ -627,12 +585,6 @@ end subroutine utilities_fourierGreenConvolution
|
|||
!> @brief calculate root mean square of divergence of field_fourier
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
real(pReal) function utilities_divergenceRMS()
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use mesh, only: &
|
||||
geomSize, &
|
||||
grid, &
|
||||
grid3
|
||||
|
||||
integer :: i, j, k, ierr
|
||||
complex(pReal), dimension(3) :: rescaledGeom
|
||||
|
|
@ -676,13 +628,7 @@ end function utilities_divergenceRMS
|
|||
!> @brief calculate max of curl of field_fourier
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
real(pReal) function utilities_curlRMS()
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use mesh, only: &
|
||||
geomSize, &
|
||||
grid, &
|
||||
grid3
|
||||
|
||||
|
||||
integer :: i, j, k, l, ierr
|
||||
complex(pReal), dimension(3,3) :: curl_fourier
|
||||
complex(pReal), dimension(3) :: rescaledGeom
|
||||
|
|
@ -743,17 +689,7 @@ end function utilities_curlRMS
|
|||
!> @brief calculates mask compliance tensor used to adjust F to fullfill stress BC
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function utilities_maskedCompliance(rot_BC,mask_stress,C)
|
||||
use, intrinsic :: &
|
||||
IEEE_arithmetic
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use math, only: &
|
||||
math_3333to99, &
|
||||
math_99to3333, &
|
||||
math_rotate_forward3333, &
|
||||
math_rotate_forward33, &
|
||||
math_invert2
|
||||
|
||||
|
||||
real(pReal), dimension(3,3,3,3) :: utilities_maskedCompliance !< masked compliance
|
||||
real(pReal), intent(in) , dimension(3,3,3,3) :: C !< current average stiffness
|
||||
real(pReal), intent(in) , dimension(3,3) :: rot_BC !< rotation of load frame
|
||||
|
|
@ -844,9 +780,6 @@ end function utilities_maskedCompliance
|
|||
!> @brief calculate scalar gradient in fourier field
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_fourierScalarGradient()
|
||||
use mesh, only: &
|
||||
grid3, &
|
||||
grid
|
||||
|
||||
integer :: i, j, k
|
||||
|
||||
|
|
@ -861,9 +794,6 @@ end subroutine utilities_fourierScalarGradient
|
|||
!> @brief calculate vector divergence in fourier field
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_fourierVectorDivergence()
|
||||
use mesh, only: &
|
||||
grid3, &
|
||||
grid
|
||||
|
||||
integer :: i, j, k
|
||||
|
||||
|
|
@ -879,9 +809,6 @@ end subroutine utilities_fourierVectorDivergence
|
|||
!> @brief calculate vector gradient in fourier field
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_fourierVectorGradient()
|
||||
use mesh, only: &
|
||||
grid3, &
|
||||
grid
|
||||
|
||||
integer :: i, j, k, m, n
|
||||
|
||||
|
|
@ -899,10 +826,7 @@ end subroutine utilities_fourierVectorGradient
|
|||
!> @brief calculate tensor divergence in fourier field
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_fourierTensorDivergence()
|
||||
use mesh, only: &
|
||||
grid3, &
|
||||
grid
|
||||
|
||||
|
||||
integer :: i, j, k, m, n
|
||||
|
||||
vectorField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal)
|
||||
|
|
@ -921,21 +845,6 @@ end subroutine utilities_fourierTensorDivergence
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
|
||||
F,timeinc,rotation_BC)
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use numerics, only: &
|
||||
worldrank
|
||||
use math, only: &
|
||||
math_rotate_forward33, &
|
||||
math_det33
|
||||
use mesh, only: &
|
||||
grid,&
|
||||
grid3
|
||||
use homogenization, only: &
|
||||
materialpoint_F, &
|
||||
materialpoint_P, &
|
||||
materialpoint_dPdF, &
|
||||
materialpoint_stressAndItsTangent
|
||||
|
||||
real(pReal),intent(out), dimension(3,3,3,3) :: C_volAvg, C_minmaxAvg !< average stiffness
|
||||
real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress
|
||||
|
|
@ -1010,9 +919,6 @@ end subroutine utilities_constitutiveResponse
|
|||
!> @brief calculates forward rate, either guessing or just add delta/timeinc
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
pure function utilities_calculateRate(heterogeneous,field0,field,dt,avRate)
|
||||
use mesh, only: &
|
||||
grid3, &
|
||||
grid
|
||||
|
||||
real(pReal), intent(in), dimension(3,3) :: &
|
||||
avRate !< homogeneous addon
|
||||
|
|
@ -1040,9 +946,6 @@ end function utilities_calculateRate
|
|||
!> ensures that the average matches the aim
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function utilities_forwardField(timeinc,field_lastInc,rate,aim)
|
||||
use mesh, only: &
|
||||
grid3, &
|
||||
grid
|
||||
|
||||
real(pReal), intent(in) :: &
|
||||
timeinc !< timeinc of current step
|
||||
|
|
@ -1074,11 +977,6 @@ end function utilities_forwardField
|
|||
! standard approach
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
pure function utilities_getFreqDerivative(k_s)
|
||||
use math, only: &
|
||||
PI
|
||||
use mesh, only: &
|
||||
geomSize, &
|
||||
grid
|
||||
|
||||
integer, intent(in), dimension(3) :: k_s !< indices of frequency
|
||||
complex(pReal), dimension(3) :: utilities_getFreqDerivative
|
||||
|
|
@ -1127,16 +1025,6 @@ end function utilities_getFreqDerivative
|
|||
! convolution
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_updateIPcoords(F)
|
||||
use prec, only: &
|
||||
cNeq
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use mesh, only: &
|
||||
grid, &
|
||||
grid3, &
|
||||
grid3Offset, &
|
||||
geomSize, &
|
||||
mesh_ipCoordinates
|
||||
|
||||
real(pReal), dimension(3,3,grid(1),grid(2),grid3), intent(in) :: F
|
||||
integer :: i, j, k, m, ierr
|
||||
|
|
@ -1178,6 +1066,8 @@ subroutine utilities_updateIPcoords(F)
|
|||
+ matmul(Favg,step*real([i,j,k+grid3Offset]-1,pReal))
|
||||
m = m+1
|
||||
enddo; enddo; enddo
|
||||
|
||||
call discretization_setIPcoords(reshape(mesh_ipCoordinates,[3,grid(1)*grid(2)*grid3]))
|
||||
|
||||
end subroutine utilities_updateIPcoords
|
||||
|
||||
|
|
|
|||
|
|
@ -14,24 +14,24 @@ module homogenization
|
|||
use numerics
|
||||
use constitutive
|
||||
use crystallite
|
||||
use mesh
|
||||
use FEsolving
|
||||
use mesh
|
||||
use discretization
|
||||
use thermal_isothermal
|
||||
use thermal_adiabatic
|
||||
use thermal_conduction
|
||||
use damage_none
|
||||
use damage_local
|
||||
use damage_nonlocal
|
||||
#if defined(PETSc) || defined(DAMASK_HDF5)
|
||||
use results
|
||||
use HDF5_utilities
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! General variables for the homogenization at a material point
|
||||
implicit none
|
||||
private
|
||||
real(pReal), dimension(:,:,:,:), allocatable, public :: &
|
||||
real(pReal), dimension(:,:,:,:), allocatable, public :: &
|
||||
materialpoint_F0, & !< def grad of IP at start of FE increment
|
||||
materialpoint_F, & !< def grad of IP to be reached at end of FE increment
|
||||
materialpoint_P !< first P--K stress of IP
|
||||
|
|
@ -44,17 +44,17 @@ module homogenization
|
|||
thermal_maxSizePostResults, &
|
||||
damage_maxSizePostResults
|
||||
|
||||
real(pReal), dimension(:,:,:,:), allocatable, private :: &
|
||||
real(pReal), dimension(:,:,:,:), allocatable :: &
|
||||
materialpoint_subF0, & !< def grad of IP at beginning of homogenization increment
|
||||
materialpoint_subF !< def grad of IP to be reached at end of homog inc
|
||||
real(pReal), dimension(:,:), allocatable, private :: &
|
||||
real(pReal), dimension(:,:), allocatable :: &
|
||||
materialpoint_subFrac, &
|
||||
materialpoint_subStep, &
|
||||
materialpoint_subdt
|
||||
logical, dimension(:,:), allocatable, private :: &
|
||||
logical, dimension(:,:), allocatable :: &
|
||||
materialpoint_requested, &
|
||||
materialpoint_converged
|
||||
logical, dimension(:,:,:), allocatable, private :: &
|
||||
logical, dimension(:,:,:), allocatable :: &
|
||||
materialpoint_doneAndHappy
|
||||
|
||||
interface
|
||||
|
|
@ -236,20 +236,20 @@ subroutine homogenization_init
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! allocate and initialize global variables
|
||||
allocate(materialpoint_dPdF(3,3,3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
|
||||
allocate(materialpoint_F0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
|
||||
materialpoint_F0 = spread(spread(math_I3,3,theMesh%elem%nIPs),4,theMesh%nElems) ! initialize to identity
|
||||
allocate(materialpoint_F(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
|
||||
allocate(materialpoint_dPdF(3,3,3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
|
||||
allocate(materialpoint_F0(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
|
||||
materialpoint_F0 = spread(spread(math_I3,3,discretization_nIP),4,discretization_nElem) ! initialize to identity
|
||||
allocate(materialpoint_F(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
|
||||
materialpoint_F = materialpoint_F0 ! initialize to identity
|
||||
allocate(materialpoint_subF0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
|
||||
allocate(materialpoint_subF(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
|
||||
allocate(materialpoint_P(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
|
||||
allocate(materialpoint_subFrac(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
|
||||
allocate(materialpoint_subStep(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
|
||||
allocate(materialpoint_subdt(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal)
|
||||
allocate(materialpoint_requested(theMesh%elem%nIPs,theMesh%nElems), source=.false.)
|
||||
allocate(materialpoint_converged(theMesh%elem%nIPs,theMesh%nElems), source=.true.)
|
||||
allocate(materialpoint_doneAndHappy(2,theMesh%elem%nIPs,theMesh%nElems), source=.true.)
|
||||
allocate(materialpoint_subF0(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
|
||||
allocate(materialpoint_subF(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
|
||||
allocate(materialpoint_P(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
|
||||
allocate(materialpoint_subFrac(discretization_nIP,discretization_nElem), source=0.0_pReal)
|
||||
allocate(materialpoint_subStep(discretization_nIP,discretization_nElem), source=0.0_pReal)
|
||||
allocate(materialpoint_subdt(discretization_nIP,discretization_nElem), source=0.0_pReal)
|
||||
allocate(materialpoint_requested(discretization_nIP,discretization_nElem), source=.false.)
|
||||
allocate(materialpoint_converged(discretization_nIP,discretization_nElem), source=.true.)
|
||||
allocate(materialpoint_doneAndHappy(2,discretization_nIP,discretization_nElem), source=.true.)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! allocate and initialize global state and postresutls variables
|
||||
|
|
@ -266,7 +266,7 @@ subroutine homogenization_init
|
|||
+ homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results
|
||||
+ 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results
|
||||
+ constitutive_source_maxSizePostResults)
|
||||
allocate(materialpoint_results(materialpoint_sizeResults,theMesh%elem%nIPs,theMesh%nElems))
|
||||
allocate(materialpoint_results(materialpoint_sizeResults,discretization_nIP,discretization_nElem))
|
||||
|
||||
write(6,'(/,a)') ' <<<+- homogenization init -+>>>'
|
||||
|
||||
|
|
@ -286,7 +286,7 @@ subroutine homogenization_init
|
|||
endif
|
||||
flush(6)
|
||||
|
||||
if (debug_g < 1 .or. debug_g > homogenization_Ngrains(mesh_element(3,debug_e))) &
|
||||
if (debug_g < 1 .or. debug_g > homogenization_Ngrains(material_homogenizationAt(debug_e))) &
|
||||
call IO_error(602,ext_msg='constituent', el=debug_e, g=debug_g)
|
||||
|
||||
end subroutine homogenization_init
|
||||
|
|
@ -322,7 +322,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! initialize restoration points of ...
|
||||
do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
myNgrains = homogenization_Ngrains(mesh_element(3,e))
|
||||
myNgrains = homogenization_Ngrains(material_homogenizationAt(e))
|
||||
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e);
|
||||
do g = 1,myNgrains
|
||||
|
||||
|
|
@ -370,7 +370,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
|
|||
|
||||
!$OMP PARALLEL DO PRIVATE(myNgrains)
|
||||
elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
myNgrains = homogenization_Ngrains(mesh_element(3,e))
|
||||
myNgrains = homogenization_Ngrains(material_homogenizationAt(e))
|
||||
IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
|
||||
converged: if (materialpoint_converged(i,e)) then
|
||||
|
|
@ -521,7 +521,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
|
|||
! results in crystallite_partionedF
|
||||
!$OMP PARALLEL DO PRIVATE(myNgrains)
|
||||
elementLooping2: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
myNgrains = homogenization_Ngrains(mesh_element(3,e))
|
||||
myNgrains = homogenization_Ngrains(material_homogenizationAt(e))
|
||||
IpLooping2: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
if ( materialpoint_requested(i,e) .and. & ! process requested but...
|
||||
.not. materialpoint_doneAndHappy(1,i,e)) then ! ...not yet done material points
|
||||
|
|
@ -600,8 +600,8 @@ subroutine materialpoint_postResults
|
|||
|
||||
!$OMP PARALLEL DO PRIVATE(myNgrains,myCrystallite,thePos,theSize)
|
||||
elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2)
|
||||
myNgrains = homogenization_Ngrains(mesh_element(3,e))
|
||||
myCrystallite = microstructure_crystallite(mesh_element(4,e))
|
||||
myNgrains = homogenization_Ngrains(material_homogenizationAt(e))
|
||||
myCrystallite = microstructure_crystallite(discretization_microstructureAt(e))
|
||||
IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
|
||||
thePos = 0
|
||||
|
||||
|
|
@ -642,19 +642,19 @@ subroutine partitionDeformation(ip,el)
|
|||
ip, & !< integration point
|
||||
el !< element number
|
||||
|
||||
chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
|
||||
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
|
||||
|
||||
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
|
||||
crystallite_partionedF(1:3,1:3,1,ip,el) = materialpoint_subF(1:3,1:3,ip,el)
|
||||
|
||||
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
|
||||
call mech_isostrain_partitionDeformation(&
|
||||
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
|
||||
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
|
||||
materialpoint_subF(1:3,1:3,ip,el))
|
||||
|
||||
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
|
||||
call mech_RGC_partitionDeformation(&
|
||||
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
|
||||
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
|
||||
materialpoint_subF(1:3,1:3,ip,el),&
|
||||
ip, &
|
||||
el)
|
||||
|
|
@ -675,21 +675,21 @@ function updateState(ip,el)
|
|||
logical, dimension(2) :: updateState
|
||||
|
||||
updateState = .true.
|
||||
chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
|
||||
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
|
||||
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
|
||||
updateState = &
|
||||
updateState .and. &
|
||||
mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
|
||||
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
|
||||
crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el),&
|
||||
mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
|
||||
crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
|
||||
crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el),&
|
||||
materialpoint_subF(1:3,1:3,ip,el),&
|
||||
materialpoint_subdt(ip,el), &
|
||||
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
|
||||
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
|
||||
ip, &
|
||||
el)
|
||||
end select chosenHomogenization
|
||||
|
||||
chosenThermal: select case (thermal_type(mesh_element(3,el)))
|
||||
chosenThermal: select case (thermal_type(material_homogenizationAt(el)))
|
||||
case (THERMAL_adiabatic_ID) chosenThermal
|
||||
updateState = &
|
||||
updateState .and. &
|
||||
|
|
@ -698,7 +698,7 @@ function updateState(ip,el)
|
|||
el)
|
||||
end select chosenThermal
|
||||
|
||||
chosenDamage: select case (damage_type(mesh_element(3,el)))
|
||||
chosenDamage: select case (damage_type(material_homogenizationAt(el)))
|
||||
case (DAMAGE_local_ID) chosenDamage
|
||||
updateState = &
|
||||
updateState .and. &
|
||||
|
|
@ -719,7 +719,7 @@ subroutine averageStressAndItsTangent(ip,el)
|
|||
ip, & !< integration point
|
||||
el !< element number
|
||||
|
||||
chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
|
||||
chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
|
||||
case (HOMOGENIZATION_NONE_ID) chosenHomogenization
|
||||
materialpoint_P(1:3,1:3,ip,el) = crystallite_P(1:3,1:3,1,ip,el)
|
||||
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el) = crystallite_dPdF(1:3,1:3,1:3,1:3,1,ip,el)
|
||||
|
|
@ -728,17 +728,17 @@ subroutine averageStressAndItsTangent(ip,el)
|
|||
call mech_isostrain_averageStressAndItsTangent(&
|
||||
materialpoint_P(1:3,1:3,ip,el), &
|
||||
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),&
|
||||
crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
|
||||
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
|
||||
homogenization_typeInstance(mesh_element(3,el)))
|
||||
crystallite_P(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
|
||||
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
|
||||
homogenization_typeInstance(material_homogenizationAt(el)))
|
||||
|
||||
case (HOMOGENIZATION_RGC_ID) chosenHomogenization
|
||||
call mech_RGC_averageStressAndItsTangent(&
|
||||
materialpoint_P(1:3,1:3,ip,el), &
|
||||
materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),&
|
||||
crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
|
||||
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
|
||||
homogenization_typeInstance(mesh_element(3,el)))
|
||||
crystallite_P(1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
|
||||
crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
|
||||
homogenization_typeInstance(material_homogenizationAt(el)))
|
||||
end select chosenHomogenization
|
||||
|
||||
end subroutine averageStressAndItsTangent
|
||||
|
|
@ -765,7 +765,7 @@ function postResults(ip,el)
|
|||
postResults = 0.0_pReal
|
||||
startPos = 1
|
||||
endPos = thermalState(material_homogenizationAt(el))%sizePostResults
|
||||
chosenThermal: select case (thermal_type(mesh_element(3,el)))
|
||||
chosenThermal: select case (thermal_type(material_homogenizationAt(el)))
|
||||
|
||||
case (THERMAL_adiabatic_ID) chosenThermal
|
||||
homog = material_homogenizationAt(el)
|
||||
|
|
@ -780,7 +780,7 @@ function postResults(ip,el)
|
|||
|
||||
startPos = endPos + 1
|
||||
endPos = endPos + damageState(material_homogenizationAt(el))%sizePostResults
|
||||
chosenDamage: select case (damage_type(mesh_element(3,el)))
|
||||
chosenDamage: select case (damage_type(material_homogenizationAt(el)))
|
||||
|
||||
case (DAMAGE_local_ID) chosenDamage
|
||||
postResults(startPos:endPos) = damage_local_postResults(ip, el)
|
||||
|
|
|
|||
276
src/material.f90
276
src/material.f90
|
|
@ -8,12 +8,20 @@
|
|||
!! 'phase', 'texture', and 'microstucture'
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module material
|
||||
use prec
|
||||
use math
|
||||
use config
|
||||
use prec
|
||||
use math
|
||||
use config
|
||||
use results
|
||||
use IO
|
||||
use debug
|
||||
use mesh
|
||||
use numerics
|
||||
use rotations
|
||||
use discretization
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
character(len=*), parameter, public :: &
|
||||
ELASTICITY_hooke_label = 'hooke', &
|
||||
PLASTICITY_none_label = 'none', &
|
||||
|
|
@ -122,7 +130,7 @@ module material
|
|||
|
||||
! NEW MAPPINGS
|
||||
integer, dimension(:), allocatable, public, protected :: & ! (elem)
|
||||
material_homogenizationAt !< homogenization ID of each element (copy of mesh_homogenizationAt)
|
||||
material_homogenizationAt !< homogenization ID of each element (copy of discretization_homogenizationAt)
|
||||
integer, dimension(:,:), allocatable, public, protected :: & ! (ip,elem)
|
||||
material_homogenizationMemberAt !< position of the element within its homogenization instance
|
||||
integer, dimension(:,:), allocatable, public, protected :: & ! (constituent,elem)
|
||||
|
|
@ -145,34 +153,28 @@ module material
|
|||
damageState
|
||||
|
||||
integer, dimension(:,:,:), allocatable, public, protected :: &
|
||||
material_texture !< texture (index) of each grain,IP,element
|
||||
material_texture !< texture (index) of each grain,IP,element. Only used by plastic_nonlocal
|
||||
|
||||
real(pReal), dimension(:,:,:,:), allocatable, public, protected :: &
|
||||
material_EulerAngles !< initial orientation of each grain,IP,element
|
||||
|
||||
logical, dimension(:), allocatable, public, protected :: &
|
||||
microstructure_active, &
|
||||
microstructure_elemhomo, & !< flag to indicate homogeneous microstructure distribution over element's IPs
|
||||
phase_localPlasticity !< flags phases with local constitutive law
|
||||
|
||||
integer, private :: &
|
||||
microstructure_maxNconstituents, & !< max number of constituents in any phase
|
||||
texture_maxNgauss !< max number of Gauss components in any texture
|
||||
microstructure_maxNconstituents !< max number of constituents in any phase
|
||||
|
||||
integer, dimension(:), allocatable, private :: &
|
||||
microstructure_Nconstituents, & !< number of constituents in each microstructure
|
||||
texture_Ngauss !< number of Gauss components per texture
|
||||
microstructure_Nconstituents !< number of constituents in each microstructure
|
||||
|
||||
integer, dimension(:,:), allocatable, private :: &
|
||||
microstructure_phase, & !< phase IDs of each microstructure
|
||||
microstructure_texture !< texture IDs of each microstructure
|
||||
|
||||
real(pReal), dimension(:,:), allocatable, private :: &
|
||||
microstructure_fraction !< vol fraction of each constituent in microstructure
|
||||
|
||||
real(pReal), dimension(:,:,:), allocatable, private :: &
|
||||
texture_Gauss, & !< data of each Gauss component
|
||||
texture_transformation !< transformation for each texture
|
||||
microstructure_fraction !< vol fraction of each constituent in microstructure
|
||||
|
||||
logical, dimension(:), allocatable, private :: &
|
||||
homogenization_active
|
||||
|
|
@ -243,18 +245,6 @@ contains
|
|||
!> material.config
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine material_init
|
||||
#if defined(PETSc) || defined(DAMASK_HDF5)
|
||||
use results
|
||||
#endif
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_material, &
|
||||
debug_levelBasic, &
|
||||
debug_levelExtensive
|
||||
use mesh, only: &
|
||||
theMesh
|
||||
|
||||
integer, parameter :: FILEUNIT = 210
|
||||
integer :: m,c,h, myDebug, myPhase, myHomog
|
||||
|
|
@ -323,12 +313,11 @@ subroutine material_init
|
|||
do h = 1,size(config_homogenization)
|
||||
write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h)
|
||||
enddo
|
||||
write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents','homogeneous'
|
||||
write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents'
|
||||
do m = 1,size(config_microstructure)
|
||||
write(6,'(1x,a32,1x,i11,1x,i12,1x,l13)') microstructure_name(m), &
|
||||
microstructure_crystallite(m), &
|
||||
microstructure_Nconstituents(m), &
|
||||
microstructure_elemhomo(m)
|
||||
write(6,'(1x,a32,1x,i11,1x,i12)') microstructure_name(m), &
|
||||
microstructure_crystallite(m), &
|
||||
microstructure_Nconstituents(m)
|
||||
if (microstructure_Nconstituents(m) > 0) then
|
||||
do c = 1,microstructure_Nconstituents(m)
|
||||
write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(c,m)),&
|
||||
|
|
@ -344,12 +333,12 @@ subroutine material_init
|
|||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! new mappings
|
||||
allocate(material_homogenizationAt,source=theMesh%homogenizationAt)
|
||||
allocate(material_homogenizationMemberAt(theMesh%elem%nIPs,theMesh%Nelems),source=0)
|
||||
allocate(material_homogenizationAt,source=discretization_homogenizationAt)
|
||||
allocate(material_homogenizationMemberAt(discretization_nIP,discretization_nElem),source=0)
|
||||
|
||||
allocate(CounterHomogenization(size(config_homogenization)),source=0)
|
||||
do e = 1, theMesh%Nelems
|
||||
do i = 1, theMesh%elem%nIPs
|
||||
do e = 1, discretization_nElem
|
||||
do i = 1, discretization_nIP
|
||||
CounterHomogenization(material_homogenizationAt(e)) = &
|
||||
CounterHomogenization(material_homogenizationAt(e)) + 1
|
||||
material_homogenizationMemberAt(i,e) = CounterHomogenization(material_homogenizationAt(e))
|
||||
|
|
@ -357,12 +346,12 @@ subroutine material_init
|
|||
enddo
|
||||
|
||||
|
||||
allocate(material_phaseAt(homogenization_maxNgrains,theMesh%Nelems), source=material_phase(:,1,:))
|
||||
allocate(material_phaseMemberAt(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0)
|
||||
allocate(material_phaseAt(homogenization_maxNgrains,discretization_nElem), source=material_phase(:,1,:))
|
||||
allocate(material_phaseMemberAt(homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0)
|
||||
|
||||
allocate(CounterPhase(size(config_phase)),source=0)
|
||||
do e = 1, theMesh%Nelems
|
||||
do i = 1, theMesh%elem%nIPs
|
||||
do e = 1, discretization_nElem
|
||||
do i = 1, discretization_nIP
|
||||
do c = 1, homogenization_maxNgrains
|
||||
CounterPhase(material_phaseAt(c,e)) = &
|
||||
CounterPhase(material_phaseAt(c,e)) + 1
|
||||
|
|
@ -371,6 +360,9 @@ subroutine material_init
|
|||
enddo
|
||||
enddo
|
||||
|
||||
call config_deallocate('material.config/microstructure')
|
||||
call config_deallocate('material.config/texture')
|
||||
|
||||
#if defined(PETSc) || defined(DAMASK_HDF5)
|
||||
call results_openJobFile
|
||||
call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,phase_name)
|
||||
|
|
@ -383,18 +375,18 @@ subroutine material_init
|
|||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! BEGIN DEPRECATED
|
||||
allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0)
|
||||
allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0)
|
||||
allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0)
|
||||
allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1)
|
||||
allocate(phaseAt ( homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0)
|
||||
allocate(phasememberAt ( homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0)
|
||||
allocate(mappingHomogenization (2, discretization_nIP,discretization_nElem),source=0)
|
||||
allocate(mappingHomogenizationConst( discretization_nIP,discretization_nElem),source=1)
|
||||
|
||||
CounterHomogenization=0
|
||||
CounterPhase =0
|
||||
|
||||
|
||||
do e = 1,theMesh%Nelems
|
||||
myHomog = theMesh%homogenizationAt(e)
|
||||
do i = 1, theMesh%elem%nIPs
|
||||
do e = 1,discretization_nElem
|
||||
myHomog = discretization_homogenizationAt(e)
|
||||
do i = 1, discretization_nIP
|
||||
CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1
|
||||
mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),huge(1)]
|
||||
do g = 1,homogenization_Ngrains(myHomog)
|
||||
|
|
@ -424,10 +416,6 @@ end subroutine material_init
|
|||
!> @brief parses the homogenization part from the material configuration
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine material_parseHomogenization
|
||||
use mesh, only: &
|
||||
theMesh
|
||||
use IO, only: &
|
||||
IO_error
|
||||
|
||||
integer :: h
|
||||
character(len=65536) :: tag
|
||||
|
|
@ -445,7 +433,7 @@ subroutine material_parseHomogenization
|
|||
allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal)
|
||||
|
||||
forall (h = 1:size(config_homogenization)) &
|
||||
homogenization_active(h) = any(theMesh%homogenizationAt == h)
|
||||
homogenization_active(h) = any(discretization_homogenizationAt == h)
|
||||
|
||||
|
||||
do h=1, size(config_homogenization)
|
||||
|
|
@ -519,14 +507,6 @@ end subroutine material_parseHomogenization
|
|||
!> @brief parses the microstructure part in the material configuration file
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine material_parseMicrostructure
|
||||
use IO, only: &
|
||||
IO_floatValue, &
|
||||
IO_intValue, &
|
||||
IO_stringValue, &
|
||||
IO_stringPos, &
|
||||
IO_error
|
||||
use mesh, only: &
|
||||
theMesh
|
||||
|
||||
character(len=65536), dimension(:), allocatable :: &
|
||||
strings
|
||||
|
|
@ -538,18 +518,16 @@ subroutine material_parseMicrostructure
|
|||
allocate(microstructure_crystallite(size(config_microstructure)), source=0)
|
||||
allocate(microstructure_Nconstituents(size(config_microstructure)), source=0)
|
||||
allocate(microstructure_active(size(config_microstructure)), source=.false.)
|
||||
allocate(microstructure_elemhomo(size(config_microstructure)), source=.false.)
|
||||
|
||||
if(any(theMesh%microstructureAt > size(config_microstructure))) &
|
||||
if(any(discretization_microstructureAt > size(config_microstructure))) &
|
||||
call IO_error(155,ext_msg='More microstructures in geometry than sections in material.config')
|
||||
|
||||
forall (e = 1:theMesh%Nelems) &
|
||||
microstructure_active(theMesh%microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements
|
||||
forall (e = 1:discretization_nElem) &
|
||||
microstructure_active(discretization_microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements
|
||||
|
||||
do m=1, size(config_microstructure)
|
||||
microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)')
|
||||
microstructure_crystallite(m) = config_microstructure(m)%getInt('crystallite')
|
||||
microstructure_elemhomo(m) = config_microstructure(m)%keyExists('/elementhomogeneous/')
|
||||
enddo
|
||||
|
||||
microstructure_maxNconstituents = maxval(microstructure_Nconstituents)
|
||||
|
|
@ -577,12 +555,9 @@ subroutine material_parseMicrostructure
|
|||
|
||||
enddo
|
||||
enddo
|
||||
if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) call IO_error(153,ext_msg=microstructure_name(m))
|
||||
enddo
|
||||
|
||||
do m = 1, size(config_microstructure)
|
||||
if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) &
|
||||
call IO_error(153,ext_msg=microstructure_name(m))
|
||||
enddo
|
||||
|
||||
end subroutine material_parseMicrostructure
|
||||
|
||||
|
|
@ -596,7 +571,7 @@ subroutine material_parseCrystallite
|
|||
|
||||
allocate(crystallite_Noutput(size(config_crystallite)),source=0)
|
||||
do c=1, size(config_crystallite)
|
||||
crystallite_Noutput(c) = config_crystallite(c)%countKeys('(output)')
|
||||
crystallite_Noutput(c) = config_crystallite(c)%countKeys('(output)')
|
||||
enddo
|
||||
|
||||
end subroutine material_parseCrystallite
|
||||
|
|
@ -606,10 +581,6 @@ end subroutine material_parseCrystallite
|
|||
!> @brief parses the phase part in the material configuration file
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine material_parsePhase
|
||||
use IO, only: &
|
||||
IO_error, &
|
||||
IO_getTag, &
|
||||
IO_stringValue
|
||||
|
||||
integer :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p
|
||||
character(len=65536), dimension(:), allocatable :: str
|
||||
|
|
@ -729,81 +700,71 @@ subroutine material_parsePhase
|
|||
|
||||
end subroutine material_parsePhase
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief parses the texture part in the material configuration file
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine material_parseTexture
|
||||
use IO, only: &
|
||||
IO_error, &
|
||||
IO_stringPos, &
|
||||
IO_floatValue, &
|
||||
IO_stringValue
|
||||
|
||||
integer :: section, gauss, j, t, i
|
||||
character(len=65536), dimension(:), allocatable :: strings ! Values for given key in material config
|
||||
integer, dimension(:), allocatable :: chunkPos
|
||||
integer :: j, t, i
|
||||
character(len=65536), dimension(:), allocatable :: strings ! Values for given key in material config
|
||||
integer, dimension(:), allocatable :: chunkPos
|
||||
real(pReal), dimension(3,3) :: texture_transformation ! maps texture to microstructure coordinate system
|
||||
type(rotation) :: eulers
|
||||
|
||||
allocate(texture_Ngauss(size(config_texture)), source=0)
|
||||
do t=1, size(config_texture)
|
||||
if (config_texture(t)%countKeys('(gauss)') /= 1) call IO_error(147,ext_msg='count((gauss)) != 1')
|
||||
if (config_texture(t)%keyExists('symmetry')) call IO_error(147,ext_msg='symmetry')
|
||||
if (config_texture(t)%keyExists('(random)')) call IO_error(147,ext_msg='(random)')
|
||||
if (config_texture(t)%keyExists('(fiber)')) call IO_error(147,ext_msg='(fiber)')
|
||||
enddo
|
||||
|
||||
do t=1, size(config_texture)
|
||||
texture_Ngauss(t) = config_texture(t)%countKeys('(gauss)')
|
||||
if (config_texture(t)%keyExists('symmetry')) call IO_error(147,ext_msg='symmetry')
|
||||
if (config_texture(t)%keyExists('(random)')) call IO_error(147,ext_msg='(random)')
|
||||
if (config_texture(t)%keyExists('(fiber)')) call IO_error(147,ext_msg='(fiber)')
|
||||
enddo
|
||||
allocate(texture_Gauss (3,size(config_texture)), source=0.0_pReal)
|
||||
|
||||
texture_maxNgauss = maxval(texture_Ngauss)
|
||||
allocate(texture_Gauss (5,texture_maxNgauss,size(config_texture)), source=0.0_pReal)
|
||||
allocate(texture_transformation(3,3,size(config_texture)), source=0.0_pReal)
|
||||
texture_transformation = spread(math_I3,3,size(config_texture))
|
||||
|
||||
do t=1, size(config_texture)
|
||||
section = t
|
||||
gauss = 0
|
||||
|
||||
if (config_texture(t)%keyExists('axes')) then
|
||||
strings = config_texture(t)%getStrings('axes')
|
||||
do j = 1, 3 ! look for "x", "y", and "z" entries
|
||||
select case (strings(j))
|
||||
case('x', '+x')
|
||||
texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis
|
||||
case('-x')
|
||||
texture_transformation(j,1:3,t) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis
|
||||
case('y', '+y')
|
||||
texture_transformation(j,1:3,t) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis
|
||||
case('-y')
|
||||
texture_transformation(j,1:3,t) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis
|
||||
case('z', '+z')
|
||||
texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis
|
||||
case('-z')
|
||||
texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis
|
||||
case default
|
||||
call IO_error(157,t)
|
||||
end select
|
||||
enddo
|
||||
if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157,t)
|
||||
endif
|
||||
|
||||
if (config_texture(t)%keyExists('(gauss)')) then
|
||||
gauss = gauss + 1
|
||||
strings = config_texture(t)%getStrings('(gauss)',raw= .true.)
|
||||
do i = 1 , size(strings)
|
||||
chunkPos = IO_stringPos(strings(i))
|
||||
do j = 1,9,2
|
||||
select case (IO_stringValue(strings(i),chunkPos,j))
|
||||
case('phi1')
|
||||
texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
|
||||
case('phi')
|
||||
texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
|
||||
case('phi2')
|
||||
texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
|
||||
end select
|
||||
do t=1, size(config_texture)
|
||||
|
||||
strings = config_texture(t)%getStrings('(gauss)',raw= .true.)
|
||||
do i = 1 , size(strings)
|
||||
chunkPos = IO_stringPos(strings(i))
|
||||
do j = 1,9,2
|
||||
select case (IO_stringValue(strings(i),chunkPos,j))
|
||||
case('phi1')
|
||||
texture_Gauss(1,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
|
||||
case('phi')
|
||||
texture_Gauss(2,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
|
||||
case('phi2')
|
||||
texture_Gauss(3,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
|
||||
end select
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
|
||||
call config_deallocate('material.config/texture')
|
||||
enddo
|
||||
|
||||
if (config_texture(t)%keyExists('axes')) then
|
||||
strings = config_texture(t)%getStrings('axes')
|
||||
do j = 1, 3 ! look for "x", "y", and "z" entries
|
||||
select case (strings(j))
|
||||
case('x', '+x')
|
||||
texture_transformation(j,1:3) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis
|
||||
case('-x')
|
||||
texture_transformation(j,1:3) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis
|
||||
case('y', '+y')
|
||||
texture_transformation(j,1:3) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis
|
||||
case('-y')
|
||||
texture_transformation(j,1:3) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis
|
||||
case('z', '+z')
|
||||
texture_transformation(j,1:3) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis
|
||||
case('-z')
|
||||
texture_transformation(j,1:3) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis
|
||||
case default
|
||||
call IO_error(157,t)
|
||||
end select
|
||||
enddo
|
||||
if(dNeq(math_det33(texture_transformation),1.0_pReal)) call IO_error(157,t)
|
||||
call eulers%fromEulerAngles(texture_Gauss(:,t))
|
||||
texture_Gauss(:,t) = math_RtoEuler(matmul(eulers%asRotationMatrix(),texture_transformation))
|
||||
endif
|
||||
|
||||
enddo
|
||||
|
||||
|
||||
end subroutine material_parseTexture
|
||||
|
||||
|
|
@ -814,8 +775,6 @@ end subroutine material_parseTexture
|
|||
subroutine material_allocatePlasticState(phase,NofMyPhase,&
|
||||
sizeState,sizeDotState,sizeDeltaState,&
|
||||
Nslip,Ntwin,Ntrans)
|
||||
use numerics, only: &
|
||||
numerics_integrator
|
||||
|
||||
integer, intent(in) :: &
|
||||
phase, &
|
||||
|
|
@ -861,8 +820,6 @@ end subroutine material_allocatePlasticState
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine material_allocateSourceState(phase,of,NofMyPhase,&
|
||||
sizeState,sizeDotState,sizeDeltaState)
|
||||
use numerics, only: &
|
||||
numerics_integrator
|
||||
|
||||
integer, intent(in) :: &
|
||||
phase, &
|
||||
|
|
@ -902,36 +859,27 @@ end subroutine material_allocateSourceState
|
|||
!! calculates the volume of the grains and deals with texture components
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine material_populateGrains
|
||||
use mesh, only: &
|
||||
theMesh
|
||||
|
||||
integer :: e,i,c,homog,micro
|
||||
|
||||
allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0)
|
||||
allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0)
|
||||
allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal)
|
||||
allocate(material_phase(homogenization_maxNgrains,discretization_nIP,discretization_nElem), source=0)
|
||||
allocate(material_texture(homogenization_maxNgrains,discretization_nIP,discretization_nElem), source=0)
|
||||
allocate(material_EulerAngles(3,homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0.0_pReal)
|
||||
|
||||
do e = 1, theMesh%Nelems
|
||||
do i = 1, theMesh%elem%nIPs
|
||||
homog = theMesh%homogenizationAt(e)
|
||||
micro = theMesh%microstructureAt(e)
|
||||
do e = 1, discretization_nElem
|
||||
do i = 1, discretization_nIP
|
||||
homog = discretization_homogenizationAt(e)
|
||||
micro = discretization_microstructureAt(e)
|
||||
do c = 1, homogenization_Ngrains(homog)
|
||||
material_phase(c,i,e) = microstructure_phase(c,micro)
|
||||
material_texture(c,i,e) = microstructure_texture(c,micro)
|
||||
material_EulerAngles(1:3,c,i,e) = texture_Gauss(1:3,1,material_texture(c,i,e))
|
||||
material_EulerAngles(1:3,c,i,e) = math_RtoEuler( & ! translate back to Euler angles
|
||||
matmul( & ! pre-multiply
|
||||
math_EulertoR(material_EulerAngles(1:3,c,i,e)), & ! face-value orientation
|
||||
texture_transformation(1:3,1:3,material_texture(c,i,e)) & ! and transformation matrix
|
||||
) &
|
||||
)
|
||||
material_phase(c,i,e) = microstructure_phase(c,micro)
|
||||
material_texture(c,i,e) = microstructure_texture(c,micro)
|
||||
material_EulerAngles(1:3,c,i,e) = texture_Gauss(1:3,material_texture(c,i,e))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
deallocate(texture_transformation)
|
||||
|
||||
call config_deallocate('material.config/microstructure')
|
||||
deallocate(microstructure_phase)
|
||||
deallocate(microstructure_texture)
|
||||
|
||||
end subroutine material_populateGrains
|
||||
|
||||
|
|
|
|||
11
src/math.f90
11
src/math.f90
|
|
@ -8,7 +8,9 @@
|
|||
module math
|
||||
use prec
|
||||
use future
|
||||
|
||||
use IO
|
||||
use debug
|
||||
use numerics
|
||||
implicit none
|
||||
public
|
||||
#if __INTEL_COMPILER >= 1900
|
||||
|
|
@ -91,8 +93,6 @@ contains
|
|||
!> @brief initialization of random seed generator and internal checks
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine math_init
|
||||
use numerics, only: &
|
||||
randomSeed
|
||||
|
||||
integer :: i
|
||||
real(pReal), dimension(4) :: randTest
|
||||
|
|
@ -133,7 +133,6 @@ end subroutine math_init
|
|||
!> @brief check correctness of (some) math functions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine unitTest
|
||||
use IO, only: IO_error
|
||||
|
||||
character(len=64) :: error_msg
|
||||
|
||||
|
|
@ -526,8 +525,6 @@ end subroutine math_invert33
|
|||
!> @brief Inversion of symmetriced 3x3x3x3 tensor.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function math_invSym3333(A)
|
||||
use IO, only: &
|
||||
IO_error
|
||||
|
||||
real(pReal),dimension(3,3,3,3) :: math_invSym3333
|
||||
|
||||
|
|
@ -1443,8 +1440,6 @@ end function math_eigenvectorBasisSym33_log
|
|||
!> @brief rotational part from polar decomposition of 33 tensor m
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function math_rotationalPart33(m)
|
||||
use IO, only: &
|
||||
IO_warning
|
||||
|
||||
real(pReal), intent(in), dimension(3,3) :: m
|
||||
real(pReal), dimension(3,3) :: math_rotationalPart33
|
||||
|
|
|
|||
|
|
@ -8,452 +8,418 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
program DAMASK_FEM
|
||||
#include <petsc/finclude/petscsys.h>
|
||||
use PetscDM
|
||||
use prec, only: &
|
||||
pInt, &
|
||||
pReal, &
|
||||
tol_math_check
|
||||
use DAMASK_interface, only: &
|
||||
DAMASK_interface_init, &
|
||||
loadCaseFile, &
|
||||
getSolverJobName
|
||||
use IO, only: &
|
||||
IO_isBlank, &
|
||||
IO_stringPos, &
|
||||
IO_stringValue, &
|
||||
IO_floatValue, &
|
||||
IO_intValue, &
|
||||
IO_error, &
|
||||
IO_lc, &
|
||||
IO_intOut, &
|
||||
IO_warning
|
||||
use math ! need to include the whole module for FFTW
|
||||
use CPFEM2
|
||||
use FEsolving, only: &
|
||||
restartWrite, &
|
||||
restartInc
|
||||
use numerics, only: &
|
||||
worldrank, &
|
||||
maxCutBack, &
|
||||
stagItMax
|
||||
use mesh, only: &
|
||||
mesh_Nboundaries, &
|
||||
mesh_boundaries, &
|
||||
geomMesh
|
||||
use FEM_Utilities, only: &
|
||||
utilities_init, &
|
||||
tSolutionState, &
|
||||
tLoadCase, &
|
||||
cutBack, &
|
||||
maxFields, &
|
||||
nActiveFields, &
|
||||
FIELD_MECH_ID, &
|
||||
COMPONENT_MECH_X_ID, &
|
||||
COMPONENT_MECH_Y_ID, &
|
||||
COMPONENT_MECH_Z_ID, &
|
||||
FIELD_MECH_label
|
||||
use FEM_mech
|
||||
|
||||
implicit none
|
||||
use PetscDM
|
||||
use prec
|
||||
use DAMASK_interface
|
||||
use IO
|
||||
use math
|
||||
use CPFEM2
|
||||
use FEsolving
|
||||
use numerics
|
||||
use mesh
|
||||
use FEM_Utilities
|
||||
use FEM_mech
|
||||
|
||||
implicit none
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! variables related to information from load case and geom file
|
||||
integer(pInt), allocatable, dimension(:) :: chunkPos ! this is longer than needed for geometry parsing
|
||||
integer(pInt) :: &
|
||||
N_def = 0_pInt !< # of rate of deformation specifiers found in load case file
|
||||
character(len=65536) :: &
|
||||
line
|
||||
integer, allocatable, dimension(:) :: chunkPos ! this is longer than needed for geometry parsing
|
||||
integer :: &
|
||||
N_def = 0 !< # of rate of deformation specifiers found in load case file
|
||||
character(len=65536) :: &
|
||||
line
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! loop variables, convergence etc.
|
||||
integer(pInt), parameter :: &
|
||||
subStepFactor = 2_pInt !< for each substep, divide the last time increment by 2.0
|
||||
real(pReal) :: &
|
||||
time = 0.0_pReal, & !< elapsed time
|
||||
time0 = 0.0_pReal, & !< begin of interval
|
||||
timeinc = 0.0_pReal, & !< current time interval
|
||||
timeIncOld = 0.0_pReal, & !< previous time interval
|
||||
remainingLoadCaseTime = 0.0_pReal !< remaining time of current load case
|
||||
logical :: &
|
||||
guess, & !< guess along former trajectory
|
||||
stagIterate
|
||||
integer(pInt) :: &
|
||||
i, &
|
||||
errorID, &
|
||||
cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
|
||||
stepFraction = 0_pInt !< fraction of current time interval
|
||||
integer(pInt) :: &
|
||||
currentLoadcase = 0_pInt, & !< current load case
|
||||
currentFace = 0_pInt, &
|
||||
inc, & !< current increment in current load case
|
||||
totalIncsCounter = 0_pInt, & !< total # of increments
|
||||
convergedCounter = 0_pInt, & !< # of converged increments
|
||||
notConvergedCounter = 0_pInt, & !< # of non-converged increments
|
||||
fileUnit = 0_pInt, & !< file unit for reading load case and writing results
|
||||
myStat, &
|
||||
statUnit = 0_pInt, & !< file unit for statistics output
|
||||
lastRestartWritten = 0_pInt, & !< total increment No. at which last restart information was written
|
||||
stagIter, &
|
||||
component
|
||||
character(len=6) :: loadcase_string
|
||||
character(len=1024) :: &
|
||||
incInfo
|
||||
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
|
||||
type(tSolutionState), allocatable, dimension(:) :: solres
|
||||
PetscInt :: faceSet, currentFaceSet
|
||||
PetscInt :: field, dimPlex
|
||||
PetscErrorCode :: ierr
|
||||
|
||||
external :: &
|
||||
quit
|
||||
integer, parameter :: &
|
||||
subStepFactor = 2 !< for each substep, divide the last time increment by 2.0
|
||||
real(pReal) :: &
|
||||
time = 0.0_pReal, & !< elapsed time
|
||||
time0 = 0.0_pReal, & !< begin of interval
|
||||
timeinc = 0.0_pReal, & !< current time interval
|
||||
timeIncOld = 0.0_pReal, & !< previous time interval
|
||||
remainingLoadCaseTime = 0.0_pReal !< remaining time of current load case
|
||||
logical :: &
|
||||
guess, & !< guess along former trajectory
|
||||
stagIterate
|
||||
integer :: &
|
||||
i, &
|
||||
errorID, &
|
||||
cutBackLevel = 0, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
|
||||
stepFraction = 0 !< fraction of current time interval
|
||||
integer :: &
|
||||
currentLoadcase = 0, & !< current load case
|
||||
currentFace = 0, &
|
||||
inc, & !< current increment in current load case
|
||||
totalIncsCounter = 0, & !< total # of increments
|
||||
convergedCounter = 0, & !< # of converged increments
|
||||
notConvergedCounter = 0, & !< # of non-converged increments
|
||||
fileUnit = 0, & !< file unit for reading load case and writing results
|
||||
myStat, &
|
||||
statUnit = 0, & !< file unit for statistics output
|
||||
lastRestartWritten = 0, & !< total increment No. at which last restart information was written
|
||||
stagIter, &
|
||||
component
|
||||
character(len=6) :: loadcase_string
|
||||
character(len=1024) :: &
|
||||
incInfo
|
||||
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
|
||||
type(tSolutionState), allocatable, dimension(:) :: solres
|
||||
PetscInt :: faceSet, currentFaceSet
|
||||
PetscInt :: field, dimPlex
|
||||
PetscErrorCode :: ierr
|
||||
|
||||
external :: &
|
||||
quit
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! init DAMASK (all modules)
|
||||
call CPFEM_initAll
|
||||
write(6,'(/,a)') ' <<<+- DAMASK_FEM init -+>>>'
|
||||
call CPFEM_initAll
|
||||
write(6,'(/,a)') ' <<<+- DAMASK_FEM init -+>>>'
|
||||
|
||||
! reading basic information from load case file and allocate data structure containing load cases
|
||||
call DMGetDimension(geomMesh,dimPlex,ierr); CHKERRA(ierr) !< dimension of mesh (2D or 3D)
|
||||
nActiveFields = 1
|
||||
allocate(solres(nActiveFields))
|
||||
call DMGetDimension(geomMesh,dimPlex,ierr); CHKERRA(ierr) !< dimension of mesh (2D or 3D)
|
||||
nActiveFields = 1
|
||||
allocate(solres(nActiveFields))
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! reading basic information from load case file and allocate data structure containing load cases
|
||||
open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read')
|
||||
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile))
|
||||
do
|
||||
read(fileUnit, '(A)', iostat=myStat) line
|
||||
if ( myStat /= 0_pInt) exit
|
||||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
|
||||
chunkPos = IO_stringPos(line)
|
||||
do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase
|
||||
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
|
||||
case('$loadcase')
|
||||
N_def = N_def + 1_pInt
|
||||
end select
|
||||
enddo ! count all identifiers to allocate memory and do sanity check
|
||||
enddo
|
||||
|
||||
allocate (loadCases(N_def))
|
||||
|
||||
do i = 1, size(loadCases)
|
||||
allocate(loadCases(i)%fieldBC(nActiveFields))
|
||||
field = 1
|
||||
loadCases(i)%fieldBC(field)%ID = FIELD_MECH_ID
|
||||
enddo
|
||||
|
||||
do i = 1, size(loadCases)
|
||||
do field = 1, nActiveFields
|
||||
select case (loadCases(i)%fieldBC(field)%ID)
|
||||
case(FIELD_MECH_ID)
|
||||
loadCases(i)%fieldBC(field)%nComponents = dimPlex !< X, Y (, Z) displacements
|
||||
allocate(loadCases(i)%fieldBC(field)%componentBC(loadCases(i)%fieldBC(field)%nComponents))
|
||||
do component = 1, loadCases(i)%fieldBC(field)%nComponents
|
||||
select case (component)
|
||||
case (1)
|
||||
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_X_ID
|
||||
case (2)
|
||||
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_Y_ID
|
||||
case (3)
|
||||
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_Z_ID
|
||||
end select
|
||||
enddo
|
||||
end select
|
||||
do component = 1, loadCases(i)%fieldBC(field)%nComponents
|
||||
allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pReal)
|
||||
allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read')
|
||||
if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=trim(loadCaseFile))
|
||||
do
|
||||
read(fileUnit, '(A)', iostat=myStat) line
|
||||
if ( myStat /= 0) exit
|
||||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
|
||||
chunkPos = IO_stringPos(line)
|
||||
do i = 1, chunkPos(1) ! reading compulsory parameters for loadcase
|
||||
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
|
||||
case('$loadcase')
|
||||
N_def = N_def + 1
|
||||
end select
|
||||
enddo ! count all identifiers to allocate memory and do sanity check
|
||||
enddo
|
||||
|
||||
allocate (loadCases(N_def))
|
||||
|
||||
do i = 1, size(loadCases)
|
||||
allocate(loadCases(i)%fieldBC(nActiveFields))
|
||||
field = 1
|
||||
loadCases(i)%fieldBC(field)%ID = FIELD_MECH_ID
|
||||
enddo
|
||||
|
||||
do i = 1, size(loadCases)
|
||||
do field = 1, nActiveFields
|
||||
select case (loadCases(i)%fieldBC(field)%ID)
|
||||
case(FIELD_MECH_ID)
|
||||
loadCases(i)%fieldBC(field)%nComponents = dimPlex !< X, Y (, Z) displacements
|
||||
allocate(loadCases(i)%fieldBC(field)%componentBC(loadCases(i)%fieldBC(field)%nComponents))
|
||||
do component = 1, loadCases(i)%fieldBC(field)%nComponents
|
||||
select case (component)
|
||||
case (1)
|
||||
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_X_ID
|
||||
case (2)
|
||||
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_Y_ID
|
||||
case (3)
|
||||
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_Z_ID
|
||||
end select
|
||||
enddo
|
||||
end select
|
||||
do component = 1, loadCases(i)%fieldBC(field)%nComponents
|
||||
allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pReal)
|
||||
allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! reading the load case and assign values to the allocated data structure
|
||||
rewind(fileUnit)
|
||||
do
|
||||
read(fileUnit, '(A)', iostat=myStat) line
|
||||
if ( myStat /= 0_pInt) exit
|
||||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
|
||||
chunkPos = IO_stringPos(line)
|
||||
do i = 1_pInt, chunkPos(1)
|
||||
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
|
||||
rewind(fileUnit)
|
||||
do
|
||||
read(fileUnit, '(A)', iostat=myStat) line
|
||||
if ( myStat /= 0) exit
|
||||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
|
||||
chunkPos = IO_stringPos(line)
|
||||
do i = 1, chunkPos(1)
|
||||
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! loadcase information
|
||||
case('$loadcase')
|
||||
currentLoadCase = IO_intValue(line,chunkPos,i+1_pInt)
|
||||
case('face')
|
||||
currentFace = IO_intValue(line,chunkPos,i+1_pInt)
|
||||
currentFaceSet = -1_pInt
|
||||
do faceSet = 1, mesh_Nboundaries
|
||||
if (mesh_boundaries(faceSet) == currentFace) currentFaceSet = faceSet
|
||||
enddo
|
||||
if (currentFaceSet < 0_pInt) call IO_error(error_ID = errorID, ext_msg = 'invalid BC')
|
||||
case('t','time','delta') ! increment time
|
||||
loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt)
|
||||
case('n','incs','increments','steps') ! number of increments
|
||||
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt)
|
||||
case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling)
|
||||
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt)
|
||||
loadCases(currentLoadCase)%logscale = 1_pInt
|
||||
case('freq','frequency','outputfreq') ! frequency of result writings
|
||||
loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt)
|
||||
case('r','restart','restartwrite') ! frequency of writing restart information
|
||||
loadCases(currentLoadCase)%restartfrequency = &
|
||||
max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt))
|
||||
case('guessreset','dropguessing')
|
||||
loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
|
||||
case('$loadcase')
|
||||
currentLoadCase = IO_intValue(line,chunkPos,i+1)
|
||||
case('face')
|
||||
currentFace = IO_intValue(line,chunkPos,i+1)
|
||||
currentFaceSet = -1
|
||||
do faceSet = 1, mesh_Nboundaries
|
||||
if (mesh_boundaries(faceSet) == currentFace) currentFaceSet = faceSet
|
||||
enddo
|
||||
if (currentFaceSet < 0) call IO_error(error_ID = errorID, ext_msg = 'invalid BC')
|
||||
case('t','time','delta') ! increment time
|
||||
loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1)
|
||||
case('n','incs','increments','steps') ! number of increments
|
||||
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1)
|
||||
case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling)
|
||||
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1)
|
||||
loadCases(currentLoadCase)%logscale = 1
|
||||
case('freq','frequency','outputfreq') ! frequency of result writings
|
||||
loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1)
|
||||
case('r','restart','restartwrite') ! frequency of writing restart information
|
||||
loadCases(currentLoadCase)%restartfrequency = &
|
||||
max(0,IO_intValue(line,chunkPos,i+1))
|
||||
case('guessreset','dropguessing')
|
||||
loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! boundary condition information
|
||||
case('x') ! X displacement field
|
||||
do field = 1, nActiveFields
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
|
||||
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_X_ID) then
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
|
||||
.true.
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
|
||||
IO_floatValue(line,chunkPos,i+1_pInt)
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
case('y') ! Y displacement field
|
||||
do field = 1, nActiveFields
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
|
||||
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Y_ID) then
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
|
||||
.true.
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
|
||||
IO_floatValue(line,chunkPos,i+1_pInt)
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
case('z') ! Z displacement field
|
||||
do field = 1, nActiveFields
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
|
||||
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Z_ID) then
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
|
||||
.true.
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
|
||||
IO_floatValue(line,chunkPos,i+1_pInt)
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
end select
|
||||
enddo; enddo
|
||||
close(fileUnit)
|
||||
case('x') ! X displacement field
|
||||
do field = 1, nActiveFields
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
|
||||
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_X_ID) then
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
|
||||
.true.
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
|
||||
IO_floatValue(line,chunkPos,i+1)
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
case('y') ! Y displacement field
|
||||
do field = 1, nActiveFields
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
|
||||
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Y_ID) then
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
|
||||
.true.
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
|
||||
IO_floatValue(line,chunkPos,i+1)
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
case('z') ! Z displacement field
|
||||
do field = 1, nActiveFields
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
|
||||
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Z_ID) then
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
|
||||
.true.
|
||||
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
|
||||
IO_floatValue(line,chunkPos,i+1)
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
end select
|
||||
enddo; enddo
|
||||
close(fileUnit)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! consistency checks and output of load case
|
||||
loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase
|
||||
errorID = 0_pInt
|
||||
checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases)
|
||||
write (loadcase_string, '(i6)' ) currentLoadCase
|
||||
write(6,'(1x,a,i6)') 'load case: ', currentLoadCase
|
||||
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
|
||||
write(6,'(2x,a)') 'drop guessing along trajectory'
|
||||
do field = 1_pInt, nActiveFields
|
||||
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
|
||||
case(FIELD_MECH_ID)
|
||||
write(6,'(2x,a)') 'Field '//trim(FIELD_MECH_label)
|
||||
|
||||
end select
|
||||
do faceSet = 1_pInt, mesh_Nboundaries
|
||||
do component = 1_pInt, loadCases(currentLoadCase)%fieldBC(field)%nComponents
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) &
|
||||
write(6,'(4x,a,i2,a,i2,a,f12.7)') 'Face ', mesh_boundaries(faceSet), &
|
||||
' Component ', component, &
|
||||
' Value ', loadCases(currentLoadCase)%fieldBC(field)% &
|
||||
componentBC(component)%Value(faceSet)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
|
||||
if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count
|
||||
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
|
||||
if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency
|
||||
write(6,'(2x,a,i5)') 'output frequency: ', &
|
||||
loadCases(currentLoadCase)%outputfrequency
|
||||
write(6,'(2x,a,i5,/)') 'restart frequency: ', &
|
||||
loadCases(currentLoadCase)%restartfrequency
|
||||
if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
|
||||
enddo checkLoadcases
|
||||
loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase
|
||||
errorID = 0
|
||||
checkLoadcases: do currentLoadCase = 1, size(loadCases)
|
||||
write (loadcase_string, '(i6)' ) currentLoadCase
|
||||
write(6,'(1x,a,i6)') 'load case: ', currentLoadCase
|
||||
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
|
||||
write(6,'(2x,a)') 'drop guessing along trajectory'
|
||||
do field = 1, nActiveFields
|
||||
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
|
||||
case(FIELD_MECH_ID)
|
||||
write(6,'(2x,a)') 'Field '//trim(FIELD_MECH_label)
|
||||
|
||||
end select
|
||||
do faceSet = 1, mesh_Nboundaries
|
||||
do component = 1, loadCases(currentLoadCase)%fieldBC(field)%nComponents
|
||||
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) &
|
||||
write(6,'(4x,a,i2,a,i2,a,f12.7)') 'Face ', mesh_boundaries(faceSet), &
|
||||
' Component ', component, &
|
||||
' Value ', loadCases(currentLoadCase)%fieldBC(field)% &
|
||||
componentBC(component)%Value(faceSet)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
|
||||
if (loadCases(currentLoadCase)%incs < 1) errorID = 835 ! non-positive incs count
|
||||
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
|
||||
if (loadCases(currentLoadCase)%outputfrequency < 1) errorID = 836 ! non-positive result frequency
|
||||
write(6,'(2x,a,i5)') 'output frequency: ', &
|
||||
loadCases(currentLoadCase)%outputfrequency
|
||||
write(6,'(2x,a,i5,/)') 'restart frequency: ', &
|
||||
loadCases(currentLoadCase)%restartfrequency
|
||||
if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
|
||||
enddo checkLoadcases
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! doing initialization depending on active solvers
|
||||
call Utilities_init()
|
||||
do field = 1, nActiveFields
|
||||
select case (loadCases(1)%fieldBC(field)%ID)
|
||||
case(FIELD_MECH_ID)
|
||||
call FEM_mech_init(loadCases(1)%fieldBC(field))
|
||||
end select
|
||||
enddo
|
||||
call Utilities_init
|
||||
do field = 1, nActiveFields
|
||||
select case (loadCases(1)%fieldBC(field)%ID)
|
||||
case(FIELD_MECH_ID)
|
||||
call FEM_mech_init(loadCases(1)%fieldBC(field))
|
||||
end select
|
||||
enddo
|
||||
|
||||
|
||||
loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases)
|
||||
time0 = time ! load case start time
|
||||
guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc
|
||||
|
||||
incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs
|
||||
totalIncsCounter = totalIncsCounter + 1_pInt
|
||||
loadCaseLooping: do currentLoadCase = 1, size(loadCases)
|
||||
time0 = time ! load case start time
|
||||
guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc
|
||||
|
||||
incLooping: do inc = 1, loadCases(currentLoadCase)%incs
|
||||
totalIncsCounter = totalIncsCounter + 1
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! forwarding time
|
||||
timeIncOld = timeinc ! last timeinc that brought former inc to an end
|
||||
if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale
|
||||
timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal)
|
||||
else
|
||||
if (currentLoadCase == 1_pInt) then ! 1st load case of logarithmic scale
|
||||
if (inc == 1_pInt) then ! 1st inc of 1st load case of logarithmic scale
|
||||
timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
|
||||
else ! not-1st inc of 1st load case of logarithmic scale
|
||||
timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal))
|
||||
endif
|
||||
else ! not-1st load case of logarithmic scale
|
||||
timeinc = time0 * &
|
||||
( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc,pReal)/&
|
||||
real(loadCases(currentLoadCase)%incs ,pReal))&
|
||||
-(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1_pInt ,pReal)/&
|
||||
real(loadCases(currentLoadCase)%incs ,pReal)))
|
||||
endif
|
||||
endif
|
||||
timeinc = timeinc * real(subStepFactor,pReal)**real(-cutBackLevel,pReal) ! depending on cut back level, decrease time step
|
||||
timeIncOld = timeinc ! last timeinc that brought former inc to an end
|
||||
if (loadCases(currentLoadCase)%logscale == 0) then ! linear scale
|
||||
timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal)
|
||||
else
|
||||
if (currentLoadCase == 1) then ! 1st load case of logarithmic scale
|
||||
if (inc == 1) then ! 1st inc of 1st load case of logarithmic scale
|
||||
timeinc = loadCases(1)%time*(2.0_pReal**real( 1-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
|
||||
else ! not-1st inc of 1st load case of logarithmic scale
|
||||
timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1-loadCases(1)%incs ,pReal))
|
||||
endif
|
||||
else ! not-1st load case of logarithmic scale
|
||||
timeinc = time0 * &
|
||||
( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc,pReal)/&
|
||||
real(loadCases(currentLoadCase)%incs ,pReal))&
|
||||
-(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1 ,pReal)/&
|
||||
real(loadCases(currentLoadCase)%incs ,pReal)))
|
||||
endif
|
||||
endif
|
||||
timeinc = timeinc * real(subStepFactor,pReal)**real(-cutBackLevel,pReal) ! depending on cut back level, decrease time step
|
||||
|
||||
skipping: if (totalIncsCounter <= restartInc) then ! not yet at restart inc?
|
||||
time = time + timeinc ! just advance time, skip already performed calculation
|
||||
guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference
|
||||
else skipping
|
||||
stepFraction = 0_pInt ! fraction scaled by stepFactor**cutLevel
|
||||
skipping: if (totalIncsCounter <= restartInc) then ! not yet at restart inc?
|
||||
time = time + timeinc ! just advance time, skip already performed calculation
|
||||
guess = .true.
|
||||
else skipping
|
||||
stepFraction = 0 ! fraction scaled by stepFactor**cutLevel
|
||||
|
||||
subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel)
|
||||
remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time
|
||||
time = time + timeinc ! forward target time
|
||||
stepFraction = stepFraction + 1_pInt ! count step
|
||||
subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel)
|
||||
remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time
|
||||
time = time + timeinc ! forward target time
|
||||
stepFraction = stepFraction + 1 ! count step
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! report begin of new step
|
||||
write(6,'(/,a)') ' ###########################################################################'
|
||||
write(6,'(1x,a,es12.5'//&
|
||||
',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//&
|
||||
',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//&
|
||||
',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') &
|
||||
'Time', time, &
|
||||
's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,&
|
||||
'-', stepFraction, '/', subStepFactor**cutBackLevel,&
|
||||
' of load case ', currentLoadCase,'/',size(loadCases)
|
||||
write(incInfo,&
|
||||
write(6,'(/,a)') ' ###########################################################################'
|
||||
write(6,'(1x,a,es12.5'//&
|
||||
',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//&
|
||||
',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//&
|
||||
',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') &
|
||||
'Time', time, &
|
||||
's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,&
|
||||
'-', stepFraction, '/', subStepFactor**cutBackLevel,&
|
||||
' of load case ', currentLoadCase,'/',size(loadCases)
|
||||
write(incInfo,&
|
||||
'(a,'//IO_intOut(totalIncsCounter)//&
|
||||
',a,'//IO_intOut(sum(loadCases%incs))//&
|
||||
',a,'//IO_intOut(stepFraction)//&
|
||||
',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') &
|
||||
'Increment ',totalIncsCounter,'/',sum(loadCases%incs),&
|
||||
'-',stepFraction, '/', subStepFactor**cutBackLevel
|
||||
flush(6)
|
||||
flush(6)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! forward fields
|
||||
do field = 1, nActiveFields
|
||||
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
|
||||
case(FIELD_MECH_ID)
|
||||
call FEM_mech_forward (&
|
||||
guess,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field))
|
||||
do field = 1, nActiveFields
|
||||
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
|
||||
case(FIELD_MECH_ID)
|
||||
call FEM_mech_forward (&
|
||||
guess,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field))
|
||||
|
||||
end select
|
||||
enddo
|
||||
end select
|
||||
enddo
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! solve fields
|
||||
stagIter = 0_pInt
|
||||
stagIterate = .true.
|
||||
do while (stagIterate)
|
||||
do field = 1, nActiveFields
|
||||
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
|
||||
case(FIELD_MECH_ID)
|
||||
solres(field) = FEM_mech_solution (&
|
||||
incInfo,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field))
|
||||
stagIter = 0
|
||||
stagIterate = .true.
|
||||
do while (stagIterate)
|
||||
do field = 1, nActiveFields
|
||||
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
|
||||
case(FIELD_MECH_ID)
|
||||
solres(field) = FEM_mech_solution (&
|
||||
incInfo,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field))
|
||||
|
||||
end select
|
||||
end select
|
||||
|
||||
if(.not. solres(field)%converged) exit ! no solution found
|
||||
if(.not. solres(field)%converged) exit ! no solution found
|
||||
|
||||
enddo
|
||||
stagIter = stagIter + 1_pInt
|
||||
stagIterate = stagIter < stagItMax &
|
||||
.and. all(solres(:)%converged) &
|
||||
.and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration
|
||||
enddo
|
||||
enddo
|
||||
stagIter = stagIter + 1
|
||||
stagIterate = stagIter < stagItMax &
|
||||
.and. all(solres(:)%converged) &
|
||||
.and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration
|
||||
enddo
|
||||
|
||||
! check solution
|
||||
cutBack = .False.
|
||||
if(.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found
|
||||
if (cutBackLevel < maxCutBack) then ! do cut back
|
||||
write(6,'(/,a)') ' cut back detected'
|
||||
cutBack = .True.
|
||||
stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator
|
||||
cutBackLevel = cutBackLevel + 1_pInt
|
||||
time = time - timeinc ! rewind time
|
||||
timeinc = timeinc/2.0_pReal
|
||||
else ! default behavior, exit if spectral solver does not converge
|
||||
call IO_warning(850_pInt)
|
||||
call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written
|
||||
endif
|
||||
else
|
||||
guess = .true. ! start guessing after first converged (sub)inc
|
||||
timeIncOld = timeinc
|
||||
endif
|
||||
if (.not. cutBack) then
|
||||
if (worldrank == 0) write(statUnit,*) totalIncsCounter, time, cutBackLevel, &
|
||||
solres%converged, solres%iterationsNeeded ! write statistics about accepted solution
|
||||
endif
|
||||
enddo subStepLooping
|
||||
cutBack = .False.
|
||||
if(.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found
|
||||
if (cutBackLevel < maxCutBack) then ! do cut back
|
||||
write(6,'(/,a)') ' cut back detected'
|
||||
cutBack = .True.
|
||||
stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator
|
||||
cutBackLevel = cutBackLevel + 1
|
||||
time = time - timeinc ! rewind time
|
||||
timeinc = timeinc/2.0_pReal
|
||||
else ! default behavior, exit if spectral solver does not converge
|
||||
call IO_warning(850)
|
||||
call quit(-1*(lastRestartWritten+1)) ! quit and provide information about last restart inc written
|
||||
endif
|
||||
else
|
||||
guess = .true. ! start guessing after first converged (sub)inc
|
||||
timeIncOld = timeinc
|
||||
endif
|
||||
if (.not. cutBack) then
|
||||
if (worldrank == 0) write(statUnit,*) totalIncsCounter, time, cutBackLevel, &
|
||||
solres%converged, solres%iterationsNeeded ! write statistics about accepted solution
|
||||
endif
|
||||
enddo subStepLooping
|
||||
|
||||
cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc
|
||||
cutBackLevel = max(0, cutBackLevel - 1) ! try half number of subincs next inc
|
||||
|
||||
if (all(solres(:)%converged)) then
|
||||
convergedCounter = convergedCounter + 1_pInt
|
||||
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc
|
||||
' increment ', totalIncsCounter, ' converged'
|
||||
else
|
||||
notConvergedCounter = notConvergedCounter + 1_pInt
|
||||
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc
|
||||
' increment ', totalIncsCounter, ' NOT converged'
|
||||
endif; flush(6)
|
||||
if (all(solres(:)%converged)) then
|
||||
convergedCounter = convergedCounter + 1
|
||||
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc
|
||||
' increment ', totalIncsCounter, ' converged'
|
||||
else
|
||||
notConvergedCounter = notConvergedCounter + 1
|
||||
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc
|
||||
' increment ', totalIncsCounter, ' NOT converged'
|
||||
endif; flush(6)
|
||||
|
||||
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency
|
||||
write(6,'(1/,a)') ' ... writing results to file ......................................'
|
||||
call CPFEM_results(totalIncsCounter,time)
|
||||
endif
|
||||
if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ...
|
||||
.and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information
|
||||
restartWrite = .true. ! set restart parameter for FEsolving
|
||||
lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write?
|
||||
endif
|
||||
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then ! at output frequency
|
||||
write(6,'(1/,a)') ' ... writing results to file ......................................'
|
||||
call CPFEM_results(totalIncsCounter,time)
|
||||
endif
|
||||
if ( loadCases(currentLoadCase)%restartFrequency > 0 & ! writing of restart info requested ...
|
||||
.and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0) then ! ... and at frequency of writing restart information
|
||||
restartWrite = .true. ! set restart parameter for FEsolving
|
||||
lastRestartWritten = inc ! first call to CPFEM_general will write
|
||||
endif
|
||||
|
||||
endif skipping
|
||||
endif skipping
|
||||
|
||||
enddo incLooping
|
||||
|
||||
enddo loadCaseLooping
|
||||
enddo loadCaseLooping
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! report summary of whole calculation
|
||||
write(6,'(/,a)') ' ###########################################################################'
|
||||
write(6,'(1x,'//IO_intOut(convergedCounter)//',a,'//IO_intOut(notConvergedCounter + convergedCounter)//',a,f5.1,a)') &
|
||||
convergedCounter, ' out of ', &
|
||||
notConvergedCounter + convergedCounter, ' (', &
|
||||
real(convergedCounter, pReal)/&
|
||||
real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, ' %) increments converged!'
|
||||
flush(6)
|
||||
close(statUnit)
|
||||
write(6,'(/,a)') ' ###########################################################################'
|
||||
write(6,'(1x,'//IO_intOut(convergedCounter)//',a,'//IO_intOut(notConvergedCounter + convergedCounter)//',a,f5.1,a)') &
|
||||
convergedCounter, ' out of ', &
|
||||
notConvergedCounter + convergedCounter, ' (', &
|
||||
real(convergedCounter, pReal)/&
|
||||
real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, ' %) increments converged!'
|
||||
flush(6)
|
||||
close(statUnit)
|
||||
|
||||
if (notConvergedCounter > 0_pInt) call quit(2_pInt) ! error if some are not converged
|
||||
call quit(0_pInt) ! no complains ;)
|
||||
if (notConvergedCounter > 0) call quit(2) ! error if some are not converged
|
||||
call quit(0) ! no complains ;)
|
||||
|
||||
end program DAMASK_FEM
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -6,85 +6,92 @@ module FEM_utilities
|
|||
#include <petsc/finclude/petscdmplex.h>
|
||||
#include <petsc/finclude/petscdmda.h>
|
||||
#include <petsc/finclude/petscis.h>
|
||||
use prec, only: pReal, pInt
|
||||
|
||||
use PETScdmplex
|
||||
use PETScdmda
|
||||
use PETScis
|
||||
use PETScdmplex
|
||||
use PETScdmda
|
||||
use PETScis
|
||||
|
||||
use prec
|
||||
use FEsolving
|
||||
use homogenization
|
||||
use numerics
|
||||
use debug
|
||||
use math
|
||||
use mesh
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
implicit none
|
||||
private
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!
|
||||
logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
|
||||
integer(pInt), public, parameter :: maxFields = 6_pInt
|
||||
integer(pInt), public :: nActiveFields = 0_pInt
|
||||
logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
|
||||
integer, public, parameter :: maxFields = 6
|
||||
integer, public :: nActiveFields = 0
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! grid related information information
|
||||
real(pReal), public :: wgt !< weighting factor 1/Nelems
|
||||
real(pReal), public :: wgt !< weighting factor 1/Nelems
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! field labels information
|
||||
character(len=*), parameter, public :: &
|
||||
FIELD_MECH_label = 'mechanical'
|
||||
|
||||
enum, bind(c)
|
||||
enumerator :: FIELD_UNDEFINED_ID, &
|
||||
FIELD_MECH_ID
|
||||
end enum
|
||||
enum, bind(c)
|
||||
enumerator :: COMPONENT_UNDEFINED_ID, &
|
||||
COMPONENT_MECH_X_ID, &
|
||||
COMPONENT_MECH_Y_ID, &
|
||||
COMPONENT_MECH_Z_ID
|
||||
end enum
|
||||
character(len=*), parameter, public :: &
|
||||
FIELD_MECH_label = 'mechanical'
|
||||
|
||||
enum, bind(c)
|
||||
enumerator :: FIELD_UNDEFINED_ID, &
|
||||
FIELD_MECH_ID
|
||||
end enum
|
||||
enum, bind(c)
|
||||
enumerator :: COMPONENT_UNDEFINED_ID, &
|
||||
COMPONENT_MECH_X_ID, &
|
||||
COMPONENT_MECH_Y_ID, &
|
||||
COMPONENT_MECH_Z_ID
|
||||
end enum
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! variables controlling debugging
|
||||
logical, private :: &
|
||||
logical :: &
|
||||
debugPETSc !< use some in debug defined options for more verbose PETSc solution
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! derived types
|
||||
type, public :: tSolutionState !< return type of solution from FEM solver variants
|
||||
logical :: converged = .true.
|
||||
logical :: stagConverged = .true.
|
||||
integer(pInt) :: iterationsNeeded = 0_pInt
|
||||
end type tSolutionState
|
||||
|
||||
type, public :: tComponentBC
|
||||
integer(kind(COMPONENT_UNDEFINED_ID)) :: ID
|
||||
real(pReal), allocatable :: Value(:)
|
||||
logical, allocatable :: Mask(:)
|
||||
end type tComponentBC
|
||||
|
||||
type, public :: tFieldBC
|
||||
integer(kind(FIELD_UNDEFINED_ID)) :: ID
|
||||
integer(pInt) :: nComponents = 0_pInt
|
||||
type(tComponentBC), allocatable :: componentBC(:)
|
||||
end type tFieldBC
|
||||
|
||||
type, public :: tLoadCase
|
||||
real(pReal) :: time = 0.0_pReal !< length of increment
|
||||
integer(pInt) :: incs = 0_pInt, & !< number of increments
|
||||
outputfrequency = 1_pInt, & !< frequency of result writes
|
||||
restartfrequency = 0_pInt, & !< frequency of restart writes
|
||||
logscale = 0_pInt !< linear/logarithmic time inc flag
|
||||
logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase
|
||||
integer(pInt), allocatable :: faceID(:)
|
||||
type(tFieldBC), allocatable :: fieldBC(:)
|
||||
end type tLoadCase
|
||||
type, public :: tSolutionState !< return type of solution from FEM solver variants
|
||||
logical :: converged = .true.
|
||||
logical :: stagConverged = .true.
|
||||
integer :: iterationsNeeded = 0
|
||||
end type tSolutionState
|
||||
|
||||
public :: &
|
||||
utilities_init, &
|
||||
utilities_constitutiveResponse, &
|
||||
utilities_projectBCValues, &
|
||||
FIELD_MECH_ID, &
|
||||
COMPONENT_MECH_X_ID, &
|
||||
COMPONENT_MECH_Y_ID, &
|
||||
COMPONENT_MECH_Z_ID
|
||||
type, public :: tComponentBC
|
||||
integer(kind(COMPONENT_UNDEFINED_ID)) :: ID
|
||||
real(pReal), allocatable :: Value(:)
|
||||
logical, allocatable :: Mask(:)
|
||||
end type tComponentBC
|
||||
|
||||
type, public :: tFieldBC
|
||||
integer(kind(FIELD_UNDEFINED_ID)) :: ID
|
||||
integer :: nComponents = 0
|
||||
type(tComponentBC), allocatable :: componentBC(:)
|
||||
end type tFieldBC
|
||||
|
||||
type, public :: tLoadCase
|
||||
real(pReal) :: time = 0.0_pReal !< length of increment
|
||||
integer :: incs = 0, & !< number of increments
|
||||
outputfrequency = 1, & !< frequency of result writes
|
||||
restartfrequency = 0, & !< frequency of restart writes
|
||||
logscale = 0 !< linear/logarithmic time inc flag
|
||||
logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase
|
||||
integer, allocatable :: faceID(:)
|
||||
type(tFieldBC), allocatable :: fieldBC(:)
|
||||
end type tLoadCase
|
||||
|
||||
public :: &
|
||||
utilities_init, &
|
||||
utilities_constitutiveResponse, &
|
||||
utilities_projectBCValues, &
|
||||
FIELD_MECH_ID, &
|
||||
COMPONENT_MECH_X_ID, &
|
||||
COMPONENT_MECH_Y_ID, &
|
||||
COMPONENT_MECH_Z_ID
|
||||
|
||||
contains
|
||||
|
||||
|
|
@ -92,45 +99,32 @@ contains
|
|||
!> @brief allocates all neccessary fields, sets debug flags
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_init
|
||||
use numerics, only: &
|
||||
structOrder, &
|
||||
petsc_defaultOptions, &
|
||||
petsc_options
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_SPECTRAL, &
|
||||
debug_SPECTRALPETSC,&
|
||||
PETSCDEBUG
|
||||
use math ! must use the whole module for use of FFTW
|
||||
use mesh, only: &
|
||||
mesh_NcpElemsGlobal, &
|
||||
mesh_maxNips
|
||||
|
||||
character(len=1024) :: petsc_optionsPhysics
|
||||
PetscErrorCode :: ierr
|
||||
character(len=1024) :: petsc_optionsPhysics
|
||||
PetscErrorCode :: ierr
|
||||
|
||||
write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>'
|
||||
write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! set debugging parameters
|
||||
debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0
|
||||
if(debugPETSc) write(6,'(3(/,a),/)') &
|
||||
' Initializing PETSc with debug options: ', &
|
||||
trim(PETScDebug), &
|
||||
' add more using the PETSc_Options keyword in numerics.config '
|
||||
flush(6)
|
||||
call PetscOptionsClear(PETSC_NULL_OPTIONS,ierr)
|
||||
CHKERRQ(ierr)
|
||||
if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr)
|
||||
CHKERRQ(ierr)
|
||||
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_defaultOptions),ierr)
|
||||
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr)
|
||||
CHKERRQ(ierr)
|
||||
write(petsc_optionsPhysics,'(a,i0)') '-mechFE_petscspace_degree ' , structOrder
|
||||
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsPhysics),ierr)
|
||||
CHKERRQ(ierr)
|
||||
|
||||
wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal)
|
||||
debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0
|
||||
if(debugPETSc) write(6,'(3(/,a),/)') &
|
||||
' Initializing PETSc with debug options: ', &
|
||||
trim(PETScDebug), &
|
||||
' add more using the PETSc_Options keyword in numerics.config '
|
||||
flush(6)
|
||||
call PetscOptionsClear(PETSC_NULL_OPTIONS,ierr)
|
||||
CHKERRQ(ierr)
|
||||
if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr)
|
||||
CHKERRQ(ierr)
|
||||
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_defaultOptions),ierr)
|
||||
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr)
|
||||
CHKERRQ(ierr)
|
||||
write(petsc_optionsPhysics,'(a,i0)') '-mechFE_petscspace_degree ' , structOrder
|
||||
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsPhysics),ierr)
|
||||
CHKERRQ(ierr)
|
||||
|
||||
wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal)
|
||||
|
||||
|
||||
end subroutine utilities_init
|
||||
|
|
@ -139,28 +133,23 @@ end subroutine utilities_init
|
|||
!> @brief calculates constitutive response
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData)
|
||||
use FEsolving, only: &
|
||||
restartWrite
|
||||
use homogenization, only: &
|
||||
materialpoint_P, &
|
||||
materialpoint_stressAndItsTangent
|
||||
|
||||
real(pReal), intent(in) :: timeinc !< loading time
|
||||
logical, intent(in) :: forwardData !< age results
|
||||
|
||||
real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress
|
||||
|
||||
PetscErrorCode :: ierr
|
||||
real(pReal), intent(in) :: timeinc !< loading time
|
||||
logical, intent(in) :: forwardData !< age results
|
||||
|
||||
real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress
|
||||
|
||||
PetscErrorCode :: ierr
|
||||
|
||||
write(6,'(/,a)') ' ... evaluating constitutive response ......................................'
|
||||
write(6,'(/,a)') ' ... evaluating constitutive response ......................................'
|
||||
|
||||
call materialpoint_stressAndItsTangent(.true.,timeinc) ! calculate P field
|
||||
call materialpoint_stressAndItsTangent(.true.,timeinc) ! calculate P field
|
||||
|
||||
restartWrite = .false. ! reset restartWrite status
|
||||
cutBack = .false. ! reset cutBack status
|
||||
|
||||
P_av = sum(sum(materialpoint_P,dim=4),dim=3) * wgt ! average of P
|
||||
call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
restartWrite = .false. ! reset restartWrite status
|
||||
cutBack = .false. ! reset cutBack status
|
||||
|
||||
P_av = sum(sum(materialpoint_P,dim=4),dim=3) * wgt ! average of P
|
||||
call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
|
||||
end subroutine utilities_constitutiveResponse
|
||||
|
||||
|
|
@ -170,32 +159,32 @@ end subroutine utilities_constitutiveResponse
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_projectBCValues(localVec,section,field,comp,bcPointsIS,BCValue,BCDotValue,timeinc)
|
||||
|
||||
Vec :: localVec
|
||||
PetscInt :: field, comp, nBcPoints, point, dof, numDof, numComp, offset
|
||||
PetscSection :: section
|
||||
IS :: bcPointsIS
|
||||
PetscInt, pointer :: bcPoints(:)
|
||||
PetscScalar, pointer :: localArray(:)
|
||||
PetscScalar :: BCValue,BCDotValue,timeinc
|
||||
PetscErrorCode :: ierr
|
||||
Vec :: localVec
|
||||
PetscInt :: field, comp, nBcPoints, point, dof, numDof, numComp, offset
|
||||
PetscSection :: section
|
||||
IS :: bcPointsIS
|
||||
PetscInt, pointer :: bcPoints(:)
|
||||
PetscScalar, pointer :: localArray(:)
|
||||
PetscScalar :: BCValue,BCDotValue,timeinc
|
||||
PetscErrorCode :: ierr
|
||||
|
||||
call PetscSectionGetFieldComponents(section,field,numComp,ierr); CHKERRQ(ierr)
|
||||
call ISGetSize(bcPointsIS,nBcPoints,ierr); CHKERRQ(ierr)
|
||||
if (nBcPoints > 0) call ISGetIndicesF90(bcPointsIS,bcPoints,ierr)
|
||||
call VecGetArrayF90(localVec,localArray,ierr); CHKERRQ(ierr)
|
||||
do point = 1, nBcPoints
|
||||
call PetscSectionGetFieldDof(section,bcPoints(point),field,numDof,ierr)
|
||||
CHKERRQ(ierr)
|
||||
call PetscSectionGetFieldOffset(section,bcPoints(point),field,offset,ierr)
|
||||
CHKERRQ(ierr)
|
||||
do dof = offset+comp+1, offset+numDof, numComp
|
||||
localArray(dof) = localArray(dof) + BCValue + BCDotValue*timeinc
|
||||
enddo
|
||||
enddo
|
||||
call VecRestoreArrayF90(localVec,localArray,ierr); CHKERRQ(ierr)
|
||||
call VecAssemblyBegin(localVec, ierr); CHKERRQ(ierr)
|
||||
call VecAssemblyEnd (localVec, ierr); CHKERRQ(ierr)
|
||||
if (nBcPoints > 0) call ISRestoreIndicesF90(bcPointsIS,bcPoints,ierr)
|
||||
call PetscSectionGetFieldComponents(section,field,numComp,ierr); CHKERRQ(ierr)
|
||||
call ISGetSize(bcPointsIS,nBcPoints,ierr); CHKERRQ(ierr)
|
||||
if (nBcPoints > 0) call ISGetIndicesF90(bcPointsIS,bcPoints,ierr)
|
||||
call VecGetArrayF90(localVec,localArray,ierr); CHKERRQ(ierr)
|
||||
do point = 1, nBcPoints
|
||||
call PetscSectionGetFieldDof(section,bcPoints(point),field,numDof,ierr)
|
||||
CHKERRQ(ierr)
|
||||
call PetscSectionGetFieldOffset(section,bcPoints(point),field,offset,ierr)
|
||||
CHKERRQ(ierr)
|
||||
do dof = offset+comp+1, offset+numDof, numComp
|
||||
localArray(dof) = localArray(dof) + BCValue + BCDotValue*timeinc
|
||||
enddo
|
||||
enddo
|
||||
call VecRestoreArrayF90(localVec,localArray,ierr); CHKERRQ(ierr)
|
||||
call VecAssemblyBegin(localVec, ierr); CHKERRQ(ierr)
|
||||
call VecAssemblyEnd (localVec, ierr); CHKERRQ(ierr)
|
||||
if (nBcPoints > 0) call ISRestoreIndicesF90(bcPointsIS,bcPoints,ierr)
|
||||
|
||||
end subroutine utilities_projectBCValues
|
||||
|
||||
|
|
|
|||
|
|
@ -3,29 +3,31 @@
|
|||
!> @brief Interpolation data used by the FEM solver
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module FEM_Zoo
|
||||
use prec, only: pReal, pInt, group_float
|
||||
use prec
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
integer, parameter :: &
|
||||
maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary)
|
||||
real(pReal), dimension(2,3), parameter :: &
|
||||
triangle = reshape([-1.0_pReal, -1.0_pReal, &
|
||||
1.0_pReal, -1.0_pReal, &
|
||||
-1.0_pReal, 1.0_pReal], shape=[2,3])
|
||||
real(pReal), dimension(3,4), parameter :: &
|
||||
tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, &
|
||||
1.0_pReal, -1.0_pReal, -1.0_pReal, &
|
||||
-1.0_pReal, 1.0_pReal, -1.0_pReal, &
|
||||
-1.0_pReal, -1.0_pReal, 1.0_pReal], shape=[3,4])
|
||||
|
||||
implicit none
|
||||
private
|
||||
integer(pInt), parameter, public:: &
|
||||
maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary)
|
||||
real(pReal), dimension(2,3), private, parameter :: &
|
||||
triangle = reshape([-1.0_pReal, -1.0_pReal, &
|
||||
1.0_pReal, -1.0_pReal, &
|
||||
-1.0_pReal, 1.0_pReal], shape=[2,3])
|
||||
real(pReal), dimension(3,4), private, parameter :: &
|
||||
tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, &
|
||||
1.0_pReal, -1.0_pReal, -1.0_pReal, &
|
||||
-1.0_pReal, 1.0_pReal, -1.0_pReal, &
|
||||
-1.0_pReal, -1.0_pReal, 1.0_pReal], shape=[3,4])
|
||||
integer(pInt), dimension(3,maxOrder), public, protected :: &
|
||||
FEM_Zoo_nQuadrature !< number of quadrature points for a given spatial dimension(1-3) and interpolation order(1-maxOrder)
|
||||
type(group_float), dimension(3,maxOrder), public, protected :: &
|
||||
FEM_Zoo_QuadratureWeights, & !< quadrature weights for each quadrature rule
|
||||
FEM_Zoo_QuadraturePoints !< quadrature point coordinates (in simplical system) for each quadrature rule
|
||||
|
||||
public :: &
|
||||
FEM_Zoo_init
|
||||
integer, dimension(2:3,maxOrder), public, protected :: &
|
||||
FEM_Zoo_nQuadrature !< number of quadrature points for a given spatial dimension(2-3) and interpolation order(1-maxOrder)
|
||||
type(group_float), dimension(2:3,maxOrder), public, protected :: &
|
||||
FEM_Zoo_QuadratureWeights, & !< quadrature weights for each quadrature rule
|
||||
FEM_Zoo_QuadraturePoints !< quadrature point coordinates (in simplical system) for each quadrature rule
|
||||
|
||||
public :: &
|
||||
FEM_Zoo_init
|
||||
|
||||
contains
|
||||
|
||||
|
|
@ -34,306 +36,329 @@ contains
|
|||
!> @brief initializes FEM interpolation data
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine FEM_Zoo_init
|
||||
implicit none
|
||||
|
||||
write(6,'(/,a)') ' <<<+- FEM_Zoo init -+>>>'
|
||||
write(6,'(/,a)') ' <<<+- FEM_Zoo init -+>>>'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 2D linear
|
||||
FEM_Zoo_nQuadrature(2,1) = 1
|
||||
allocate(FEM_Zoo_QuadratureWeights(2,1)%p(1))
|
||||
allocate(FEM_Zoo_QuadraturePoints (2,1)%p(2))
|
||||
FEM_Zoo_QuadratureWeights(2,1)%p(1) = 1.0_pReal
|
||||
call FEM_Zoo_permutationStar3([1.0_pReal/3.0_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,1)%p(1:2))
|
||||
FEM_Zoo_nQuadrature(2,1) = 1
|
||||
|
||||
allocate(FEM_Zoo_QuadratureWeights(2,1)%p(1))
|
||||
FEM_Zoo_QuadratureWeights(2,1)%p(1) = 1.0_pReal
|
||||
|
||||
allocate(FEM_Zoo_QuadraturePoints (2,1)%p(2))
|
||||
FEM_Zoo_QuadraturePoints (2,1)%p(1:2) = FEM_Zoo_permutationStar3([1.0_pReal/3.0_pReal])
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 2D quadratic
|
||||
FEM_Zoo_nQuadrature(2,2) = 3
|
||||
FEM_Zoo_nQuadrature(2,2) = 3
|
||||
|
||||
allocate(FEM_Zoo_QuadratureWeights(2,2)%p(3))
|
||||
allocate(FEM_Zoo_QuadraturePoints (2,2)%p(6))
|
||||
FEM_Zoo_QuadratureWeights(2,2)%p(1:3) = 1.0_pReal/3.0_pReal
|
||||
call FEM_Zoo_permutationStar21([1.0_pReal/6.0_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,2)%p(1:6))
|
||||
FEM_Zoo_QuadratureWeights(2,2)%p(1:3) = 1.0_pReal/3.0_pReal
|
||||
|
||||
allocate(FEM_Zoo_QuadraturePoints (2,2)%p(6))
|
||||
FEM_Zoo_QuadraturePoints (2,2)%p(1:6) = FEM_Zoo_permutationStar21([1.0_pReal/6.0_pReal])
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 2D cubic
|
||||
FEM_Zoo_nQuadrature(2,3) = 6
|
||||
allocate(FEM_Zoo_QuadratureWeights(2,3)%p(6 ))
|
||||
allocate(FEM_Zoo_QuadraturePoints (2,3)%p(12))
|
||||
FEM_Zoo_QuadratureWeights(2,3)%p(1:3) = 0.22338158967801146570_pReal
|
||||
call FEM_Zoo_permutationStar21([0.44594849091596488632_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,3)%p(1:6))
|
||||
FEM_Zoo_QuadratureWeights(2,3)%p(4:6) = 0.10995174365532186764_pReal
|
||||
call FEM_Zoo_permutationStar21([0.091576213509770743460_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,3)%p(7:12))
|
||||
FEM_Zoo_nQuadrature(2,3) = 6
|
||||
|
||||
allocate(FEM_Zoo_QuadratureWeights(2,3)%p(6))
|
||||
FEM_Zoo_QuadratureWeights(2,3)%p(1:3) = 0.22338158967801146570_pReal
|
||||
FEM_Zoo_QuadratureWeights(2,3)%p(4:6) = 0.10995174365532186764_pReal
|
||||
|
||||
allocate(FEM_Zoo_QuadraturePoints (2,3)%p(12))
|
||||
FEM_Zoo_QuadraturePoints (2,3)%p(1:6) = FEM_Zoo_permutationStar21([0.44594849091596488632_pReal])
|
||||
FEM_Zoo_QuadraturePoints (2,3)%p(7:12)= FEM_Zoo_permutationStar21([0.091576213509770743460_pReal])
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 2D quartic
|
||||
FEM_Zoo_nQuadrature(2,4) = 12
|
||||
allocate(FEM_Zoo_QuadratureWeights(2,4)%p(12))
|
||||
allocate(FEM_Zoo_QuadraturePoints (2,4)%p(24))
|
||||
FEM_Zoo_QuadratureWeights(2,4)%p(1:3) = 0.11678627572638_pReal
|
||||
call FEM_Zoo_permutationStar21([0.24928674517091_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,4)%p(1:6))
|
||||
FEM_Zoo_QuadratureWeights(2,4)%p(4:6) = 0.05084490637021_pReal
|
||||
call FEM_Zoo_permutationStar21([0.06308901449150_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,4)%p(7:12))
|
||||
FEM_Zoo_QuadratureWeights(2,4)%p(7:12) = 0.08285107561837_pReal
|
||||
call FEM_Zoo_permutationStar111([0.31035245103378_pReal, 0.63650249912140_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,4)%p(13:24))
|
||||
FEM_Zoo_nQuadrature(2,4) = 12
|
||||
|
||||
allocate(FEM_Zoo_QuadratureWeights(2,4)%p(12))
|
||||
FEM_Zoo_QuadratureWeights(2,4)%p(1:3) = 0.11678627572638_pReal
|
||||
FEM_Zoo_QuadratureWeights(2,4)%p(4:6) = 0.05084490637021_pReal
|
||||
FEM_Zoo_QuadratureWeights(2,4)%p(7:12) = 0.08285107561837_pReal
|
||||
|
||||
allocate(FEM_Zoo_QuadraturePoints (2,4)%p(24))
|
||||
FEM_Zoo_QuadraturePoints (2,4)%p(1:6) = FEM_Zoo_permutationStar21([0.24928674517091_pReal])
|
||||
FEM_Zoo_QuadraturePoints (2,4)%p(7:12) = FEM_Zoo_permutationStar21([0.06308901449150_pReal])
|
||||
FEM_Zoo_QuadraturePoints (2,4)%p(13:24)= FEM_Zoo_permutationStar111([0.31035245103378_pReal, 0.63650249912140_pReal])
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 2D order 5
|
||||
FEM_Zoo_nQuadrature(2,5) = 16
|
||||
allocate(FEM_Zoo_QuadratureWeights(2,5)%p(16))
|
||||
allocate(FEM_Zoo_QuadraturePoints (2,5)%p(32))
|
||||
FEM_Zoo_QuadratureWeights(2,5)%p(1 ) = 0.14431560767779_pReal
|
||||
call FEM_Zoo_permutationStar3([0.33333333333333_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,5)%p(1:2))
|
||||
FEM_Zoo_QuadratureWeights(2,5)%p(2:4) = 0.09509163426728_pReal
|
||||
call FEM_Zoo_permutationStar21([0.45929258829272_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,5)%p(3:8))
|
||||
FEM_Zoo_QuadratureWeights(2,5)%p(5:7) = 0.10321737053472_pReal
|
||||
call FEM_Zoo_permutationStar21([0.17056930775176_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,5)%p(9:14))
|
||||
FEM_Zoo_QuadratureWeights(2,5)%p(8:10) = 0.03245849762320_pReal
|
||||
call FEM_Zoo_permutationStar21([0.05054722831703_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,5)%p(15:20))
|
||||
FEM_Zoo_QuadratureWeights(2,5)%p(11:16) = 0.02723031417443_pReal
|
||||
call FEM_Zoo_permutationStar111([0.26311282963464_pReal, 0.72849239295540_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(2,5)%p(21:32))
|
||||
FEM_Zoo_nQuadrature(2,5) = 16
|
||||
|
||||
allocate(FEM_Zoo_QuadratureWeights(2,5)%p(16))
|
||||
FEM_Zoo_QuadratureWeights(2,5)%p(1 ) = 0.14431560767779_pReal
|
||||
FEM_Zoo_QuadratureWeights(2,5)%p(2:4) = 0.09509163426728_pReal
|
||||
FEM_Zoo_QuadratureWeights(2,5)%p(5:7) = 0.10321737053472_pReal
|
||||
FEM_Zoo_QuadratureWeights(2,5)%p(8:10) = 0.03245849762320_pReal
|
||||
FEM_Zoo_QuadratureWeights(2,5)%p(11:16)= 0.02723031417443_pReal
|
||||
|
||||
allocate(FEM_Zoo_QuadraturePoints (2,5)%p(32))
|
||||
FEM_Zoo_QuadraturePoints (2,5)%p(1:2) = FEM_Zoo_permutationStar3([0.33333333333333_pReal])
|
||||
FEM_Zoo_QuadraturePoints (2,5)%p(3:8) = FEM_Zoo_permutationStar21([0.45929258829272_pReal])
|
||||
FEM_Zoo_QuadraturePoints (2,5)%p(9:14) = FEM_Zoo_permutationStar21([0.17056930775176_pReal])
|
||||
FEM_Zoo_QuadraturePoints (2,5)%p(15:20)= FEM_Zoo_permutationStar21([0.05054722831703_pReal])
|
||||
FEM_Zoo_QuadraturePoints (2,5)%p(21:32)=FEM_Zoo_permutationStar111([0.26311282963464_pReal, 0.72849239295540_pReal])
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 3D linear
|
||||
FEM_Zoo_nQuadrature(3,1) = 1
|
||||
allocate(FEM_Zoo_QuadratureWeights(3,1)%p(1))
|
||||
allocate(FEM_Zoo_QuadraturePoints (3,1)%p(3))
|
||||
FEM_Zoo_QuadratureWeights(3,1)%p(1) = 1.0_pReal
|
||||
call FEM_Zoo_permutationStar4([0.25_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,1)%p(1:3))
|
||||
FEM_Zoo_nQuadrature(3,1) = 1
|
||||
|
||||
allocate(FEM_Zoo_QuadratureWeights(3,1)%p(1))
|
||||
FEM_Zoo_QuadratureWeights(3,1)%p(1) = 1.0_pReal
|
||||
|
||||
allocate(FEM_Zoo_QuadraturePoints (3,1)%p(3))
|
||||
FEM_Zoo_QuadraturePoints (3,1)%p(1:3)= FEM_Zoo_permutationStar4([0.25_pReal])
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 3D quadratic
|
||||
FEM_Zoo_nQuadrature(3,2) = 4
|
||||
allocate(FEM_Zoo_QuadratureWeights(3,2)%p(4 ))
|
||||
allocate(FEM_Zoo_QuadraturePoints (3,2)%p(12))
|
||||
FEM_Zoo_QuadratureWeights(3,2)%p(1:4) = 0.25_pReal
|
||||
call FEM_Zoo_permutationStar31([0.13819660112501051518_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,2)%p(1:12))
|
||||
FEM_Zoo_nQuadrature(3,2) = 4
|
||||
|
||||
allocate(FEM_Zoo_QuadratureWeights(3,2)%p(4))
|
||||
FEM_Zoo_QuadratureWeights(3,2)%p(1:4) = 0.25_pReal
|
||||
|
||||
allocate(FEM_Zoo_QuadraturePoints (3,2)%p(12))
|
||||
FEM_Zoo_QuadraturePoints (3,2)%p(1:12)= FEM_Zoo_permutationStar31([0.13819660112501051518_pReal])
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 3D cubic
|
||||
FEM_Zoo_nQuadrature(3,3) = 14
|
||||
allocate(FEM_Zoo_QuadratureWeights(3,3)%p(14))
|
||||
allocate(FEM_Zoo_QuadraturePoints (3,3)%p(42))
|
||||
FEM_Zoo_QuadratureWeights(3,3)%p(1:4) = 0.073493043116361949544_pReal
|
||||
call FEM_Zoo_permutationStar31([0.092735250310891226402_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,3)%p(1:12))
|
||||
FEM_Zoo_QuadratureWeights(3,3)%p(5:8) = 0.11268792571801585080_pReal
|
||||
call FEM_Zoo_permutationStar31([0.31088591926330060980_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,3)%p(13:24))
|
||||
FEM_Zoo_QuadratureWeights(3,3)%p(9:14) = 0.042546020777081466438_pReal
|
||||
call FEM_Zoo_permutationStar22([0.045503704125649649492_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,3)%p(25:42))
|
||||
FEM_Zoo_nQuadrature(3,3) = 14
|
||||
|
||||
allocate(FEM_Zoo_QuadratureWeights(3,3)%p(14))
|
||||
FEM_Zoo_QuadratureWeights(3,3)%p(5:8) = 0.11268792571801585080_pReal
|
||||
FEM_Zoo_QuadratureWeights(3,3)%p(1:4) = 0.073493043116361949544_pReal
|
||||
FEM_Zoo_QuadratureWeights(3,3)%p(9:14) = 0.042546020777081466438_pReal
|
||||
|
||||
allocate(FEM_Zoo_QuadraturePoints (3,3)%p(42))
|
||||
FEM_Zoo_QuadraturePoints (3,3)%p(1:12) = FEM_Zoo_permutationStar31([0.092735250310891226402_pReal])
|
||||
FEM_Zoo_QuadraturePoints (3,3)%p(13:24)= FEM_Zoo_permutationStar31([0.31088591926330060980_pReal])
|
||||
FEM_Zoo_QuadraturePoints (3,3)%p(25:42)= FEM_Zoo_permutationStar22([0.045503704125649649492_pReal])
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 3D quartic
|
||||
FEM_Zoo_nQuadrature(3,4) = 35
|
||||
allocate(FEM_Zoo_QuadratureWeights(3,4)%p(35))
|
||||
allocate(FEM_Zoo_QuadraturePoints (3,4)%p(105))
|
||||
FEM_Zoo_QuadratureWeights(3,4)%p(1:4) = 0.0021900463965388_pReal
|
||||
call FEM_Zoo_permutationStar31([0.0267367755543735_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,4)%p(1:12))
|
||||
FEM_Zoo_QuadratureWeights(3,4)%p(5:16) = 0.0143395670177665_pReal
|
||||
call FEM_Zoo_permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,4)%p(13:48))
|
||||
FEM_Zoo_QuadratureWeights(3,4)%p(17:22) = 0.0250305395686746_pReal
|
||||
call FEM_Zoo_permutationStar22([0.4547545999844830_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,4)%p(49:66))
|
||||
FEM_Zoo_QuadratureWeights(3,4)%p(23:34) = 0.0479839333057554_pReal
|
||||
call FEM_Zoo_permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,4)%p(67:102))
|
||||
FEM_Zoo_QuadratureWeights(3,4)%p(35) = 0.0931745731195340_pReal
|
||||
call FEM_Zoo_permutationStar4([0.25_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,4)%p(103:105))
|
||||
FEM_Zoo_nQuadrature(3,4) = 35
|
||||
|
||||
allocate(FEM_Zoo_QuadratureWeights(3,4)%p(35))
|
||||
FEM_Zoo_QuadratureWeights(3,4)%p(1:4) = 0.0021900463965388_pReal
|
||||
FEM_Zoo_QuadratureWeights(3,4)%p(5:16) = 0.0143395670177665_pReal
|
||||
FEM_Zoo_QuadratureWeights(3,4)%p(17:22) = 0.0250305395686746_pReal
|
||||
FEM_Zoo_QuadratureWeights(3,4)%p(23:34) = 0.0479839333057554_pReal
|
||||
FEM_Zoo_QuadratureWeights(3,4)%p(35) = 0.0931745731195340_pReal
|
||||
|
||||
allocate(FEM_Zoo_QuadraturePoints (3,4)%p(105))
|
||||
FEM_Zoo_QuadraturePoints (3,4)%p(1:12) = FEM_Zoo_permutationStar31([0.0267367755543735_pReal])
|
||||
FEM_Zoo_QuadraturePoints (3,4)%p(13:48) = FEM_Zoo_permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal])
|
||||
FEM_Zoo_QuadraturePoints (3,4)%p(49:66) = FEM_Zoo_permutationStar22([0.4547545999844830_pReal])
|
||||
FEM_Zoo_QuadraturePoints (3,4)%p(67:102) = FEM_Zoo_permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal])
|
||||
FEM_Zoo_QuadraturePoints (3,4)%p(103:105)= FEM_Zoo_permutationStar4([0.25_pReal])
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 3D quintic
|
||||
FEM_Zoo_nQuadrature(3,5) = 56
|
||||
allocate(FEM_Zoo_QuadratureWeights(3,5)%p(56))
|
||||
allocate(FEM_Zoo_QuadraturePoints (3,5)%p(168))
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(1:4) = 0.0010373112336140_pReal
|
||||
call FEM_Zoo_permutationStar31([0.0149520651530592_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,5)%p(1:12))
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(5:16) = 0.0096016645399480_pReal
|
||||
call FEM_Zoo_permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,5)%p(13:48))
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(17:28) = 0.0164493976798232_pReal
|
||||
call FEM_Zoo_permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,5)%p(49:84))
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(29:40) = 0.0153747766513310_pReal
|
||||
call FEM_Zoo_permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,5)%p(85:120))
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(41:52) = 0.0293520118375230_pReal
|
||||
call FEM_Zoo_permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,5)%p(121:156))
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(53:56) = 0.0366291366405108_pReal
|
||||
call FEM_Zoo_permutationStar31([0.1344783347929940_pReal], &
|
||||
FEM_Zoo_QuadraturePoints(3,5)%p(157:168))
|
||||
FEM_Zoo_nQuadrature(3,5) = 56
|
||||
|
||||
allocate(FEM_Zoo_QuadratureWeights(3,5)%p(56))
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(1:4) = 0.0010373112336140_pReal
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(5:16) = 0.0096016645399480_pReal
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(17:28) = 0.0164493976798232_pReal
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(29:40) = 0.0153747766513310_pReal
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(41:52) = 0.0293520118375230_pReal
|
||||
FEM_Zoo_QuadratureWeights(3,5)%p(53:56) = 0.0366291366405108_pReal
|
||||
|
||||
allocate(FEM_Zoo_QuadraturePoints (3,5)%p(168))
|
||||
FEM_Zoo_QuadraturePoints (3,5)%p(1:12) = FEM_Zoo_permutationStar31([0.0149520651530592_pReal])
|
||||
FEM_Zoo_QuadraturePoints (3,5)%p(13:48) = FEM_Zoo_permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal])
|
||||
FEM_Zoo_QuadraturePoints (3,5)%p(49:84) = FEM_Zoo_permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal])
|
||||
FEM_Zoo_QuadraturePoints (3,5)%p(85:120) = FEM_Zoo_permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal])
|
||||
FEM_Zoo_QuadraturePoints (3,5)%p(121:156)= FEM_Zoo_permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal])
|
||||
FEM_Zoo_QuadraturePoints (3,5)%p(157:168)= FEM_Zoo_permutationStar31([0.1344783347929940_pReal])
|
||||
|
||||
end subroutine FEM_Zoo_init
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief star 3 permutation of input
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine FEM_Zoo_permutationStar3(point,qPt)
|
||||
pure function FEM_Zoo_permutationStar3(point) result(qPt)
|
||||
|
||||
implicit none
|
||||
real(pReal) :: point(1), qPt(2,1), temp(3,1)
|
||||
real(pReal), dimension(2) :: qPt
|
||||
real(pReal), dimension(1), intent(in) :: point
|
||||
|
||||
real(pReal), dimension(3,1) :: temp
|
||||
|
||||
temp(:,1) = [point(1), point(1), point(1)]
|
||||
qPt = matmul(triangle, temp)
|
||||
temp(:,1) = [point(1), point(1), point(1)]
|
||||
|
||||
qPt = reshape(matmul(triangle, temp),[2])
|
||||
|
||||
end subroutine FEM_Zoo_permutationStar3
|
||||
end function FEM_Zoo_permutationStar3
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief star 21 permutation of input
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine FEM_Zoo_permutationStar21(point,qPt)
|
||||
pure function FEM_Zoo_permutationStar21(point) result(qPt)
|
||||
|
||||
implicit none
|
||||
real(pReal) :: point(1), qPt(2,3), temp(3,3)
|
||||
real(pReal), dimension(6) :: qPt
|
||||
real(pReal), dimension(1), intent(in) :: point
|
||||
|
||||
real(pReal), dimension(3,3) :: temp
|
||||
|
||||
temp(:,1) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1)]
|
||||
temp(:,2) = [point(1), 1.0_pReal - 2.0_pReal*point(1), point(1)]
|
||||
temp(:,3) = [1.0_pReal - 2.0_pReal*point(1), point(1), point(1)]
|
||||
qPt = matmul(triangle, temp)
|
||||
temp(:,1) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1)]
|
||||
temp(:,2) = [point(1), 1.0_pReal - 2.0_pReal*point(1), point(1)]
|
||||
temp(:,3) = [1.0_pReal - 2.0_pReal*point(1), point(1), point(1)]
|
||||
|
||||
qPt = reshape(matmul(triangle, temp),[6])
|
||||
|
||||
end subroutine FEM_Zoo_permutationStar21
|
||||
end function FEM_Zoo_permutationStar21
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief star 111 permutation of input
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine FEM_Zoo_permutationStar111(point,qPt)
|
||||
pure function FEM_Zoo_permutationStar111(point) result(qPt)
|
||||
|
||||
implicit none
|
||||
real(pReal) :: point(2), qPt(2,6), temp(3,6)
|
||||
real(pReal), dimension(12) :: qPt
|
||||
real(pReal), dimension(2), intent(in) :: point
|
||||
|
||||
real(pReal), dimension(3,6) :: temp
|
||||
|
||||
temp(:,1) = [point(1), point(2), 1.0_pReal - point(1) - point(2)]
|
||||
temp(:,2) = [point(1), 1.0_pReal - point(1) - point(2), point(2)]
|
||||
temp(:,4) = [point(2), 1.0_pReal - point(1) - point(2), point(1)]
|
||||
temp(:,5) = [1.0_pReal - point(1) - point(2), point(2), point(1)]
|
||||
temp(:,6) = [1.0_pReal - point(1) - point(2), point(1), point(2)]
|
||||
qPt = matmul(triangle, temp)
|
||||
temp(:,1) = [point(1), point(2), 1.0_pReal - point(1) - point(2)]
|
||||
temp(:,2) = [point(1), 1.0_pReal - point(1) - point(2), point(2)]
|
||||
temp(:,4) = [point(2), 1.0_pReal - point(1) - point(2), point(1)]
|
||||
temp(:,5) = [1.0_pReal - point(1) - point(2), point(2), point(1)]
|
||||
temp(:,6) = [1.0_pReal - point(1) - point(2), point(1), point(2)]
|
||||
|
||||
qPt = reshape(matmul(triangle, temp),[12])
|
||||
|
||||
end subroutine FEM_Zoo_permutationStar111
|
||||
end function FEM_Zoo_permutationStar111
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief star 4 permutation of input
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine FEM_Zoo_permutationStar4(point,qPt)
|
||||
pure function FEM_Zoo_permutationStar4(point) result(qPt)
|
||||
|
||||
implicit none
|
||||
real(pReal) :: point(1), qPt(3,1), temp(4,1)
|
||||
real(pReal), dimension(3) :: qPt
|
||||
real(pReal), dimension(1), intent(in) :: point
|
||||
|
||||
real(pReal), dimension(4,1) :: temp
|
||||
|
||||
temp(:,1) = [point(1), point(1), point(1), point(1)]
|
||||
qPt = matmul(tetrahedron, temp)
|
||||
temp(:,1) = [point(1), point(1), point(1), point(1)]
|
||||
|
||||
qPt = reshape(matmul(tetrahedron, temp),[3])
|
||||
|
||||
end subroutine FEM_Zoo_permutationStar4
|
||||
end function FEM_Zoo_permutationStar4
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief star 31 permutation of input
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine FEM_Zoo_permutationStar31(point,qPt)
|
||||
pure function FEM_Zoo_permutationStar31(point) result(qPt)
|
||||
|
||||
implicit none
|
||||
real(pReal) :: point(1), qPt(3,4), temp(4,4)
|
||||
real(pReal), dimension(12) :: qPt
|
||||
real(pReal), dimension(1), intent(in) :: point
|
||||
|
||||
real(pReal), dimension(4,4) :: temp
|
||||
|
||||
temp(:,1) = [point(1), point(1), point(1), 1.0_pReal - 3.0_pReal*point(1)]
|
||||
temp(:,2) = [point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), point(1)]
|
||||
temp(:,3) = [point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), point(1)]
|
||||
temp(:,4) = [1.0_pReal - 3.0_pReal*point(1), point(1), point(1), point(1)]
|
||||
qPt = matmul(tetrahedron, temp)
|
||||
temp(:,1) = [point(1), point(1), point(1), 1.0_pReal - 3.0_pReal*point(1)]
|
||||
temp(:,2) = [point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), point(1)]
|
||||
temp(:,3) = [point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), point(1)]
|
||||
temp(:,4) = [1.0_pReal - 3.0_pReal*point(1), point(1), point(1), point(1)]
|
||||
|
||||
end subroutine FEM_Zoo_permutationStar31
|
||||
qPt = reshape(matmul(tetrahedron, temp),[12])
|
||||
|
||||
end function FEM_Zoo_permutationStar31
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief star 22 permutation of input
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine FEM_Zoo_permutationStar22(point,qPt)
|
||||
pure function FEM_Zoo_permutationStar22(point) result(qPt)
|
||||
|
||||
implicit none
|
||||
real(pReal) :: point(1), qPt(3,6), temp(4,6)
|
||||
real(pReal), dimension(18) :: qPt
|
||||
real(pReal), dimension(1), intent(in) :: point
|
||||
|
||||
real(pReal), dimension(4,6) :: temp
|
||||
|
||||
temp(:,1) = [point(1), point(1), 0.5_pReal - point(1), 0.5_pReal - point(1)]
|
||||
temp(:,2) = [point(1), 0.5_pReal - point(1), point(1), 0.5_pReal - point(1)]
|
||||
temp(:,3) = [0.5_pReal - point(1), point(1), point(1), 0.5_pReal - point(1)]
|
||||
temp(:,4) = [0.5_pReal - point(1), point(1), 0.5_pReal - point(1), point(1)]
|
||||
temp(:,5) = [0.5_pReal - point(1), 0.5_pReal - point(1), point(1), point(1)]
|
||||
temp(:,6) = [point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), point(1)]
|
||||
qPt = matmul(tetrahedron, temp)
|
||||
temp(:,1) = [point(1), point(1), 0.5_pReal - point(1), 0.5_pReal - point(1)]
|
||||
temp(:,2) = [point(1), 0.5_pReal - point(1), point(1), 0.5_pReal - point(1)]
|
||||
temp(:,3) = [0.5_pReal - point(1), point(1), point(1), 0.5_pReal - point(1)]
|
||||
temp(:,4) = [0.5_pReal - point(1), point(1), 0.5_pReal - point(1), point(1)]
|
||||
temp(:,5) = [0.5_pReal - point(1), 0.5_pReal - point(1), point(1), point(1)]
|
||||
temp(:,6) = [point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), point(1)]
|
||||
|
||||
qPt = reshape(matmul(tetrahedron, temp),[18])
|
||||
|
||||
end subroutine FEM_Zoo_permutationStar22
|
||||
end function FEM_Zoo_permutationStar22
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief star 211 permutation of input
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine FEM_Zoo_permutationStar211(point,qPt)
|
||||
pure function FEM_Zoo_permutationStar211(point) result(qPt)
|
||||
|
||||
implicit none
|
||||
real(pReal) :: point(2), qPt(3,12), temp(4,12)
|
||||
real(pReal), dimension(36) :: qPt
|
||||
real(pReal), dimension(2), intent(in) :: point
|
||||
|
||||
real(pReal), dimension(4,12) :: temp
|
||||
|
||||
temp(:,1 ) = [point(1), point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
|
||||
temp(:,2 ) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2)]
|
||||
temp(:,3 ) = [point(1), point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
|
||||
temp(:,4 ) = [point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)]
|
||||
temp(:,5 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2)]
|
||||
temp(:,6 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1)]
|
||||
temp(:,7 ) = [point(2), point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
|
||||
temp(:,8 ) = [point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)]
|
||||
temp(:,9 ) = [point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1)]
|
||||
temp(:,10) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), point(2)]
|
||||
temp(:,11) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), point(1)]
|
||||
temp(:,12) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), point(1)]
|
||||
qPt = matmul(tetrahedron, temp)
|
||||
temp(:,1 ) = [point(1), point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
|
||||
temp(:,2 ) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2)]
|
||||
temp(:,3 ) = [point(1), point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
|
||||
temp(:,4 ) = [point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)]
|
||||
temp(:,5 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2)]
|
||||
temp(:,6 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1)]
|
||||
temp(:,7 ) = [point(2), point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
|
||||
temp(:,8 ) = [point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)]
|
||||
temp(:,9 ) = [point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1)]
|
||||
temp(:,10) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), point(2)]
|
||||
temp(:,11) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), point(1)]
|
||||
temp(:,12) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), point(1)]
|
||||
|
||||
qPt = reshape(matmul(tetrahedron, temp),[36])
|
||||
|
||||
end subroutine FEM_Zoo_permutationStar211
|
||||
end function FEM_Zoo_permutationStar211
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief star 1111 permutation of input
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine FEM_Zoo_permutationStar1111(point,qPt)
|
||||
pure function FEM_Zoo_permutationStar1111(point) result(qPt)
|
||||
|
||||
implicit none
|
||||
real(pReal) :: point(3), qPt(3,24), temp(4,24)
|
||||
|
||||
temp(:,1 ) = [point(1), point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,2 ) = [point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3)]
|
||||
temp(:,3 ) = [point(1), point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,4 ) = [point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2)]
|
||||
temp(:,5 ) = [point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(3)]
|
||||
temp(:,6 ) = [point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(2)]
|
||||
temp(:,7 ) = [point(2), point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,8 ) = [point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3)]
|
||||
temp(:,9 ) = [point(2), point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,10) = [point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1)]
|
||||
temp(:,11) = [point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(3)]
|
||||
temp(:,12) = [point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(1)]
|
||||
temp(:,13) = [point(3), point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,14) = [point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2)]
|
||||
temp(:,15) = [point(3), point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,16) = [point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1)]
|
||||
temp(:,17) = [point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(2)]
|
||||
temp(:,18) = [point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(1)]
|
||||
temp(:,19) = [1.0_pReal - point(1) - point(2)- point(3), point(1), point(2), point(3)]
|
||||
temp(:,20) = [1.0_pReal - point(1) - point(2)- point(3), point(1), point(3), point(2)]
|
||||
temp(:,21) = [1.0_pReal - point(1) - point(2)- point(3), point(2), point(1), point(3)]
|
||||
temp(:,22) = [1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), point(1)]
|
||||
temp(:,23) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), point(2)]
|
||||
temp(:,24) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), point(1)]
|
||||
qPt = matmul(tetrahedron, temp)
|
||||
real(pReal), dimension(72) :: qPt
|
||||
real(pReal), dimension(3), intent(in) :: point
|
||||
|
||||
real(pReal), dimension(4,24) :: temp
|
||||
|
||||
end subroutine FEM_Zoo_permutationStar1111
|
||||
|
||||
temp(:,1 ) = [point(1), point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,2 ) = [point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3)]
|
||||
temp(:,3 ) = [point(1), point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,4 ) = [point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2)]
|
||||
temp(:,5 ) = [point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(3)]
|
||||
temp(:,6 ) = [point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(2)]
|
||||
temp(:,7 ) = [point(2), point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,8 ) = [point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3)]
|
||||
temp(:,9 ) = [point(2), point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,10) = [point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1)]
|
||||
temp(:,11) = [point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(3)]
|
||||
temp(:,12) = [point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(1)]
|
||||
temp(:,13) = [point(3), point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,14) = [point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2)]
|
||||
temp(:,15) = [point(3), point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3)]
|
||||
temp(:,16) = [point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1)]
|
||||
temp(:,17) = [point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(2)]
|
||||
temp(:,18) = [point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(1)]
|
||||
temp(:,19) = [1.0_pReal - point(1) - point(2)- point(3), point(1), point(2), point(3)]
|
||||
temp(:,20) = [1.0_pReal - point(1) - point(2)- point(3), point(1), point(3), point(2)]
|
||||
temp(:,21) = [1.0_pReal - point(1) - point(2)- point(3), point(2), point(1), point(3)]
|
||||
temp(:,22) = [1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), point(1)]
|
||||
temp(:,23) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), point(2)]
|
||||
temp(:,24) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), point(1)]
|
||||
|
||||
qPt = reshape(matmul(tetrahedron, temp),[72])
|
||||
|
||||
end function FEM_Zoo_permutationStar1111
|
||||
|
||||
end module FEM_Zoo
|
||||
|
|
|
|||
157
src/mesh_FEM.f90
157
src/mesh_FEM.f90
|
|
@ -3,37 +3,39 @@
|
|||
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @brief Driver controlling inner and outer load case looping of the FEM solver
|
||||
!> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing
|
||||
!> results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module mesh
|
||||
#include <petsc/finclude/petscdmplex.h>
|
||||
#include <petsc/finclude/petscis.h>
|
||||
#include <petsc/finclude/petscdmda.h>
|
||||
use prec, only: pReal, pInt
|
||||
use prec
|
||||
use mesh_base
|
||||
use PETScdmplex
|
||||
use PETScdmda
|
||||
use PETScis
|
||||
|
||||
use PETScdmplex
|
||||
use PETScdmda
|
||||
use PETScis
|
||||
use DAMASK_interface
|
||||
use IO
|
||||
use debug
|
||||
use discretization
|
||||
use numerics
|
||||
use FEsolving
|
||||
use FEM_Zoo
|
||||
|
||||
implicit none
|
||||
private
|
||||
integer(pInt), public, parameter :: &
|
||||
mesh_ElemType=1_pInt !< Element type of the mesh (only support homogeneous meshes)
|
||||
|
||||
integer(pInt), public, protected :: &
|
||||
|
||||
integer, public, protected :: &
|
||||
mesh_Nboundaries, &
|
||||
mesh_NcpElems, & !< total number of CP elements in mesh
|
||||
mesh_NcpElemsGlobal, &
|
||||
mesh_Nnodes, & !< total number of nodes in mesh
|
||||
mesh_maxNipNeighbors
|
||||
mesh_Nnodes !< total number of nodes in mesh
|
||||
|
||||
!!!! BEGIN DEPRECATED !!!!!
|
||||
integer(pInt), public, protected :: &
|
||||
integer, public, protected :: &
|
||||
mesh_maxNips !< max number of IPs in any CP element
|
||||
!!!! BEGIN DEPRECATED !!!!!
|
||||
|
||||
integer(pInt), dimension(:,:), allocatable, public, protected :: &
|
||||
integer, dimension(:,:), allocatable, public, protected :: &
|
||||
mesh_element !DEPRECATED
|
||||
|
||||
real(pReal), dimension(:,:), allocatable, public :: &
|
||||
|
|
@ -46,35 +48,12 @@ use PETScis
|
|||
real(pReal), dimension(:,:,:), allocatable, public :: &
|
||||
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!)
|
||||
|
||||
real(pReal), dimension(:,:,:), allocatable, public, protected :: &
|
||||
mesh_ipArea !< area of interface to neighboring IP (initially!)
|
||||
|
||||
real(pReal),dimension(:,:,:,:), allocatable, public, protected :: &
|
||||
mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!)
|
||||
|
||||
integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: &
|
||||
mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me]
|
||||
|
||||
logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes)
|
||||
|
||||
DM, public :: geomMesh
|
||||
|
||||
PetscInt, dimension(:), allocatable, public, protected :: &
|
||||
mesh_boundaries
|
||||
|
||||
|
||||
integer(pInt), dimension(1_pInt), parameter, public :: FE_geomtype = & !< geometry type of particular element type
|
||||
int([1],pInt)
|
||||
|
||||
integer(pInt), dimension(1_pInt), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type
|
||||
int([1],pInt)
|
||||
|
||||
integer(pInt), dimension(1_pInt), public :: FE_Nips = & !< number of IPs in a specific type of element
|
||||
int([0],pInt)
|
||||
|
||||
integer(pInt), dimension(1_pInt), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type
|
||||
int([6],pInt)
|
||||
|
||||
|
||||
type, public, extends(tMesh) :: tMesh_FEM
|
||||
|
||||
|
||||
|
|
@ -96,18 +75,17 @@ contains
|
|||
|
||||
subroutine tMesh_FEM_init(self,dimen,order,nodes)
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: dimen
|
||||
integer(pInt), intent(in) :: order
|
||||
real(pReal), intent(in), dimension(:,:) :: nodes
|
||||
integer, intent(in) :: dimen
|
||||
integer, intent(in) :: order
|
||||
real(pReal), intent(in), dimension(:,:) :: nodes
|
||||
class(tMesh_FEM) :: self
|
||||
|
||||
if (dimen == 2_pInt) then
|
||||
if (order == 1_pInt) call self%tMesh%init('mesh',1_pInt,nodes)
|
||||
if (order == 2_pInt) call self%tMesh%init('mesh',2_pInt,nodes)
|
||||
elseif(dimen == 3_pInt) then
|
||||
if (order == 1_pInt) call self%tMesh%init('mesh',6_pInt,nodes)
|
||||
if (order == 2_pInt) call self%tMesh%init('mesh',8_pInt,nodes)
|
||||
if (dimen == 2) then
|
||||
if (order == 1) call self%tMesh%init('mesh',1,nodes)
|
||||
if (order == 2) call self%tMesh%init('mesh',2,nodes)
|
||||
elseif(dimen == 3) then
|
||||
if (order == 1) call self%tMesh%init('mesh',6,nodes)
|
||||
if (order == 2) call self%tMesh%init('mesh',8,nodes)
|
||||
endif
|
||||
|
||||
end subroutine tMesh_FEM_init
|
||||
|
|
@ -118,35 +96,19 @@ subroutine tMesh_FEM_init(self,dimen,order,nodes)
|
|||
!> @brief initializes the mesh by calling all necessary private routines the mesh module
|
||||
!! Order and routines strongly depend on type of solver
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine mesh_init()
|
||||
use DAMASK_interface
|
||||
use IO, only: &
|
||||
IO_error, &
|
||||
IO_open_file, &
|
||||
IO_stringPos, &
|
||||
IO_intValue, &
|
||||
IO_EOF, &
|
||||
IO_isBlank
|
||||
use debug, only: &
|
||||
debug_e, &
|
||||
debug_i
|
||||
use numerics, only: &
|
||||
usePingPong, &
|
||||
integrationOrder, &
|
||||
worldrank, &
|
||||
worldsize
|
||||
use FEsolving, only: &
|
||||
FEsolving_execElem, &
|
||||
FEsolving_execIP
|
||||
use FEM_Zoo, only: &
|
||||
FEM_Zoo_nQuadrature, &
|
||||
FEM_Zoo_QuadraturePoints
|
||||
subroutine mesh_init
|
||||
|
||||
integer, dimension(1), parameter:: FE_geomtype = [1] !< geometry type of particular element type
|
||||
|
||||
integer, dimension(1) :: FE_Nips !< number of IPs in a specific type of element
|
||||
|
||||
|
||||
implicit none
|
||||
integer(pInt), parameter :: FILEUNIT = 222_pInt
|
||||
integer(pInt) :: j
|
||||
integer(pInt), allocatable, dimension(:) :: chunkPos
|
||||
integer, parameter :: FILEUNIT = 222
|
||||
integer :: j
|
||||
integer, allocatable, dimension(:) :: chunkPos
|
||||
integer :: dimPlex
|
||||
integer, parameter :: &
|
||||
mesh_ElemType=1 !< Element type of the mesh (only support homogeneous meshes)
|
||||
character(len=512) :: &
|
||||
line
|
||||
logical :: flag
|
||||
|
|
@ -177,7 +139,7 @@ subroutine mesh_init()
|
|||
call MPI_Bcast(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
|
||||
call MPI_Bcast(dimPlex,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
|
||||
|
||||
allocate(mesh_boundaries(mesh_Nboundaries), source = 0_pInt)
|
||||
allocate(mesh_boundaries(mesh_Nboundaries), source = 0)
|
||||
call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr)
|
||||
CHKERRQ(ierr)
|
||||
call DMGetLabelIdIS(globalMesh,'Face Sets',faceSetIS,ierr)
|
||||
|
|
@ -230,31 +192,31 @@ subroutine mesh_init()
|
|||
call DMGetStratumSize(geomMesh,'depth',0,mesh_Nnodes,ierr)
|
||||
CHKERRQ(ierr)
|
||||
|
||||
FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder)
|
||||
mesh_maxNips = FE_Nips(1_pInt)
|
||||
FE_Nips(FE_geomtype(1)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder)
|
||||
mesh_maxNips = FE_Nips(1)
|
||||
|
||||
write(6,*) 'mesh_maxNips',mesh_maxNips
|
||||
call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p)
|
||||
call mesh_FEM_build_ipVolumes(dimPlex)
|
||||
|
||||
allocate (mesh_element (4_pInt,mesh_NcpElems)); mesh_element = 0_pInt
|
||||
allocate (mesh_element (4,mesh_NcpElems)); mesh_element = 0
|
||||
do j = 1, mesh_NcpElems
|
||||
mesh_element( 1,j) = -1_pInt ! DEPRECATED
|
||||
mesh_element( 1,j) = -1 ! DEPRECATED
|
||||
mesh_element( 2,j) = mesh_elemType ! elem type
|
||||
mesh_element( 3,j) = 1_pInt ! homogenization
|
||||
mesh_element( 3,j) = 1 ! homogenization
|
||||
call DMGetLabelValue(geomMesh,'material',j-1,mesh_element(4,j),ierr)
|
||||
CHKERRQ(ierr)
|
||||
end do
|
||||
|
||||
if (debug_e < 1 .or. debug_e > mesh_NcpElems) &
|
||||
call IO_error(602_pInt,ext_msg='element') ! selected element does not exist
|
||||
if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) &
|
||||
call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP
|
||||
call IO_error(602,ext_msg='element') ! selected element does not exist
|
||||
if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2,debug_e)))) &
|
||||
call IO_error(602,ext_msg='IP') ! selected element does not have requested IP
|
||||
|
||||
FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements
|
||||
FEsolving_execElem = [ 1,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements
|
||||
if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP)
|
||||
allocate(FEsolving_execIP(2_pInt,mesh_NcpElems)); FEsolving_execIP = 1_pInt ! parallel loop bounds set to comprise from first IP...
|
||||
forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element
|
||||
allocate(FEsolving_execIP(2,mesh_NcpElems)); FEsolving_execIP = 1 ! parallel loop bounds set to comprise from first IP...
|
||||
forall (j = 1:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element
|
||||
|
||||
allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal)
|
||||
call theMesh%init(dimplex,integrationOrder,mesh_node0)
|
||||
|
|
@ -263,6 +225,10 @@ subroutine mesh_init()
|
|||
theMesh%homogenizationAt = mesh_element(3,:)
|
||||
theMesh%microstructureAt = mesh_element(4,:)
|
||||
|
||||
call discretization_init(mesh_element(3,:),mesh_element(4,:),&
|
||||
reshape(mesh_ipCoordinates,[3,mesh_maxNips*mesh_NcpElems]), &
|
||||
mesh_node0)
|
||||
|
||||
end subroutine mesh_init
|
||||
|
||||
|
||||
|
|
@ -271,12 +237,11 @@ end subroutine mesh_init
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
pure function mesh_cellCenterCoordinates(ip,el)
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: el, & !< element number
|
||||
ip !< integration point number
|
||||
integer, intent(in) :: el, & !< element number
|
||||
ip !< integration point number
|
||||
real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell
|
||||
|
||||
end function mesh_cellCenterCoordinates
|
||||
end function mesh_cellCenterCoordinates
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
@ -289,11 +254,7 @@ pure function mesh_cellCenterCoordinates(ip,el)
|
|||
!> and one corner at the central ip.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine mesh_FEM_build_ipVolumes(dimPlex)
|
||||
use math, only: &
|
||||
math_I3, &
|
||||
math_det33
|
||||
|
||||
implicit none
|
||||
PetscInt :: dimPlex
|
||||
PetscReal :: vol
|
||||
PetscReal, target :: cent(dimPlex), norm(dimPlex)
|
||||
|
|
@ -332,9 +293,9 @@ end subroutine mesh_FEM_build_ipVolumes
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints)
|
||||
|
||||
implicit none
|
||||
PetscInt, intent(in) :: dimPlex
|
||||
PetscReal, intent(in) :: qPoints(mesh_maxNips*dimPlex)
|
||||
|
||||
PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), invcellJ(dimPlex*dimPlex)
|
||||
PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:)
|
||||
PetscReal :: detJ
|
||||
|
|
|
|||
|
|
@ -8,9 +8,12 @@
|
|||
module mesh
|
||||
use prec
|
||||
use mesh_base
|
||||
use geometry_plastic_nonlocal
|
||||
use discretization
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
integer, public, protected :: &
|
||||
mesh_NcpElems, & !< total number of CP elements in local mesh
|
||||
mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes)
|
||||
|
|
@ -518,6 +521,14 @@ subroutine mesh_init(ip,el)
|
|||
theMesh%homogenizationAt = mesh_element(3,:)
|
||||
theMesh%microstructureAt = mesh_element(4,:)
|
||||
|
||||
call discretization_init(mesh_element(3,:),mesh_element(4,:),&
|
||||
reshape(mesh_ipCoordinates,[3,theMesh%elem%nIPs*theMesh%nElems]),&
|
||||
mesh_node0)
|
||||
call geometry_plastic_nonlocal_setIPvolume(mesh_ipVolume)
|
||||
call geometry_plastic_nonlocal_setIPneighborhood(mesh_ipNeighborhood)
|
||||
call geometry_plastic_nonlocal_setIParea(mesh_IParea)
|
||||
call geometry_plastic_nonlocal_setIPareaNormal(mesh_IPareaNormal)
|
||||
|
||||
contains
|
||||
|
||||
|
||||
|
|
@ -1909,6 +1920,8 @@ subroutine mesh_build_ipNeighborhood
|
|||
enddo
|
||||
enddo
|
||||
|
||||
call geometry_plastic_nonlocal_set_IPneighborhood(mesh_ipNeighborhood)
|
||||
|
||||
contains
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief find face-matching element of same type
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ module mesh_base
|
|||
elem
|
||||
real(pReal), dimension(:,:), allocatable, public :: &
|
||||
ipVolume, & !< volume associated with each IP (initially!)
|
||||
node0, & !< node x,y,z coordinates (initially)
|
||||
node_0, & !< node x,y,z coordinates (initially)
|
||||
node !< node x,y,z coordinates (deformed)
|
||||
integer(pInt), dimension(:,:), allocatable, public :: &
|
||||
cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID
|
||||
|
|
@ -62,7 +62,7 @@ subroutine tMesh_base_init(self,meshType,elemType,nodes)
|
|||
|
||||
self%type = meshType
|
||||
call self%elem%init(elemType)
|
||||
self%node0 = nodes
|
||||
self%node_0 = nodes
|
||||
self%nNodes = size(nodes,2)
|
||||
|
||||
end subroutine tMesh_base_init
|
||||
|
|
|
|||
|
|
@ -1,215 +1,117 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver
|
||||
!> @brief Parse geometry file to set up discretization and geometry for nonlocal model
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module mesh
|
||||
use, intrinsic :: iso_c_binding
|
||||
use prec
|
||||
use geometry_plastic_nonlocal
|
||||
use mesh_base
|
||||
#include <petsc/finclude/petscsys.h>
|
||||
use PETScsys
|
||||
|
||||
implicit none
|
||||
private
|
||||
integer(pInt), public, protected :: &
|
||||
mesh_Nnodes
|
||||
|
||||
integer(pInt), dimension(:), allocatable, private :: &
|
||||
microGlobal
|
||||
integer(pInt), dimension(:), allocatable, private :: &
|
||||
mesh_homogenizationAt
|
||||
|
||||
integer(pInt), dimension(:,:), allocatable, public, protected :: &
|
||||
mesh_element !< entryCount and list of elements containing node
|
||||
|
||||
integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: &
|
||||
mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me]
|
||||
|
||||
real(pReal), public, protected :: &
|
||||
mesh_unitlength !< physical length of one unit in mesh
|
||||
|
||||
real(pReal), dimension(:,:), allocatable, private :: &
|
||||
mesh_node !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!)
|
||||
|
||||
|
||||
real(pReal), dimension(:,:), allocatable, public, protected :: &
|
||||
mesh_ipVolume, & !< volume associated with IP (initially!)
|
||||
mesh_node0 !< node x,y,z coordinates (initially!)
|
||||
|
||||
real(pReal), dimension(:,:,:), allocatable, public, protected :: &
|
||||
mesh_ipArea !< area of interface to neighboring IP (initially!)
|
||||
|
||||
real(pReal), dimension(:,:,:), allocatable, public :: &
|
||||
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!)
|
||||
|
||||
real(pReal),dimension(:,:,:,:), allocatable, public, protected :: &
|
||||
mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!)
|
||||
|
||||
logical, dimension(3), public, parameter :: mesh_periodicSurface = .true. !< flag indicating periodic outer surfaces (used for fluxes)
|
||||
|
||||
|
||||
! grid specific
|
||||
integer(pInt), dimension(3), public, protected :: &
|
||||
grid !< (global) grid
|
||||
integer(pInt), public, protected :: &
|
||||
mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh
|
||||
grid3, & !< (local) grid in 3rd direction
|
||||
grid3Offset !< (local) grid offset in 3rd direction
|
||||
real(pReal), dimension(3), public, protected :: &
|
||||
geomSize
|
||||
real(pReal), public, protected :: &
|
||||
size3, & !< (local) size in 3rd direction
|
||||
size3offset !< (local) size offset in 3rd direction
|
||||
|
||||
public :: &
|
||||
mesh_init
|
||||
|
||||
private :: &
|
||||
mesh_build_ipAreas, &
|
||||
mesh_build_ipNormals, &
|
||||
mesh_spectral_build_nodes, &
|
||||
mesh_spectral_build_elements, &
|
||||
mesh_spectral_build_ipNeighborhood, &
|
||||
mesh_build_ipCoordinates
|
||||
|
||||
type, public, extends(tMesh) :: tMesh_grid
|
||||
use prec
|
||||
use system_routines
|
||||
use DAMASK_interface
|
||||
use IO
|
||||
use debug
|
||||
use numerics
|
||||
use discretization
|
||||
use geometry_plastic_nonlocal
|
||||
use FEsolving
|
||||
|
||||
integer(pInt), dimension(3), public :: &
|
||||
grid !< (global) grid
|
||||
integer(pInt), public :: &
|
||||
mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh
|
||||
grid3, & !< (local) grid in 3rd direction
|
||||
grid3Offset !< (local) grid offset in 3rd direction
|
||||
real(pReal), dimension(3), public :: &
|
||||
geomSize
|
||||
real(pReal), public :: &
|
||||
size3, & !< (local) size in 3rd direction
|
||||
size3offset
|
||||
|
||||
contains
|
||||
procedure, pass(self) :: tMesh_grid_init
|
||||
generic, public :: init => tMesh_grid_init
|
||||
end type tMesh_grid
|
||||
implicit none
|
||||
private
|
||||
|
||||
type(tMesh_grid), public, protected :: theMesh
|
||||
real(pReal), dimension(:,:,:), allocatable, public :: &
|
||||
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!)
|
||||
|
||||
integer, dimension(3), public, protected :: &
|
||||
grid !< (global) grid
|
||||
integer, public, protected :: &
|
||||
grid3, & !< (local) grid in 3rd direction
|
||||
grid3Offset !< (local) grid offset in 3rd direction
|
||||
|
||||
real(pReal), dimension(3), public, protected :: &
|
||||
geomSize
|
||||
real(pReal), public, protected :: &
|
||||
size3, & !< (local) size in 3rd direction
|
||||
size3offset !< (local) size offset in 3rd direction
|
||||
|
||||
public :: &
|
||||
mesh_init
|
||||
|
||||
contains
|
||||
|
||||
subroutine tMesh_grid_init(self,nodes)
|
||||
|
||||
implicit none
|
||||
class(tMesh_grid) :: self
|
||||
real(pReal), dimension(:,:), intent(in) :: nodes
|
||||
|
||||
call self%tMesh%init('grid',10_pInt,nodes)
|
||||
|
||||
end subroutine tMesh_grid_init
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief initializes the mesh by calling all necessary private routines the mesh module
|
||||
!! Order and routines strongly depend on type of solver
|
||||
!> @brief reads the geometry file to obtain information on discretization
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine mesh_init(ip,el)
|
||||
|
||||
#include <petsc/finclude/petscsys.h>
|
||||
use PETScsys
|
||||
integer, intent(in), optional :: el, ip ! for compatibility reasons
|
||||
|
||||
include 'fftw3-mpi.f03'
|
||||
real(pReal), dimension(3) :: &
|
||||
mySize !< domain size of this process
|
||||
integer, dimension(3) :: &
|
||||
myGrid !< domain grid of this process
|
||||
|
||||
use DAMASK_interface
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use debug, only: &
|
||||
debug_e, &
|
||||
debug_i, &
|
||||
debug_level, &
|
||||
debug_mesh, &
|
||||
debug_levelBasic
|
||||
use numerics, only: &
|
||||
numerics_unitlength
|
||||
use FEsolving, only: &
|
||||
FEsolving_execElem, &
|
||||
FEsolving_execIP
|
||||
integer, dimension(:), allocatable :: &
|
||||
microstructureAt, &
|
||||
homogenizationAt
|
||||
|
||||
implicit none
|
||||
include 'fftw3-mpi.f03'
|
||||
integer(C_INTPTR_T) :: devNull, local_K, local_K_offset
|
||||
integer :: ierr, worldsize, j
|
||||
integer(pInt), intent(in), optional :: el, ip
|
||||
logical :: myDebug
|
||||
integer :: j
|
||||
integer(C_INTPTR_T) :: &
|
||||
devNull, z, z_offset
|
||||
|
||||
write(6,'(/,a)') ' <<<+- mesh init -+>>>'
|
||||
write(6,'(/,a)') ' <<<+- mesh init -+>>>'
|
||||
|
||||
mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh
|
||||
call readGeom(grid,geomSize,microstructureAt,homogenizationAt)
|
||||
|
||||
myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt)
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! grid solver specific quantities
|
||||
if(worldsize>grid(3)) call IO_error(894, ext_msg='number of processes exceeds grid(3)')
|
||||
|
||||
call fftw_mpi_init()
|
||||
call mesh_spectral_read_grid()
|
||||
call fftw_mpi_init
|
||||
devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), &
|
||||
int(grid(2),C_INTPTR_T), &
|
||||
int(grid(1),C_INTPTR_T)/2+1, &
|
||||
PETSC_COMM_WORLD, &
|
||||
z, & ! domain grid size along z
|
||||
z_offset) ! domain grid offset along z
|
||||
grid3 = int(z)
|
||||
grid3Offset = int(z_offset)
|
||||
size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal)
|
||||
size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal)
|
||||
myGrid = [grid(1:2),grid3]
|
||||
mySize = [geomSize(1:2),size3]
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! general discretization
|
||||
microstructureAt = microstructureAt(product(grid(1:2))*grid3Offset+1: &
|
||||
product(grid(1:2))*(grid3Offset+grid3)) ! reallocate/shrink in case of MPI
|
||||
homogenizationAt = homogenizationAt(product(grid(1:2))*grid3Offset+1: &
|
||||
product(grid(1:2))*(grid3Offset+grid3)) ! reallocate/shrink in case of MPI
|
||||
|
||||
call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr)
|
||||
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size')
|
||||
if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)')
|
||||
mesh_ipCoordinates = IPcoordinates(myGrid,mySize,grid3Offset)
|
||||
call discretization_init(homogenizationAt,microstructureAt, &
|
||||
reshape(mesh_ipCoordinates,[3,product(myGrid)]), &
|
||||
Nodes(myGrid,mySize,grid3Offset))
|
||||
|
||||
FEsolving_execElem = [1,product(myGrid)] ! parallel loop bounds set to comprise all elements
|
||||
allocate(FEsolving_execIP(2,product(myGrid)),source=1) ! parallel loop bounds set to comprise the only IP
|
||||
|
||||
devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), &
|
||||
int(grid(2),C_INTPTR_T), &
|
||||
int(grid(1),C_INTPTR_T)/2+1, &
|
||||
PETSC_COMM_WORLD, &
|
||||
local_K, & ! domain grid size along z
|
||||
local_K_offset) ! domain grid offset along z
|
||||
grid3 = int(local_K,pInt)
|
||||
grid3Offset = int(local_K_offset,pInt)
|
||||
size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal)
|
||||
size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal)
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! geometry information required by the nonlocal CP model
|
||||
call geometry_plastic_nonlocal_setIPvolume(reshape([(product(mySize/real(myGrid,pReal)),j=1,product(myGrid))], &
|
||||
[1,product(myGrid)]))
|
||||
call geometry_plastic_nonlocal_setIParea (cellEdgeArea(mySize,myGrid))
|
||||
call geometry_plastic_nonlocal_setIPareaNormal (cellEdgeNormal(product(myGrid)))
|
||||
call geometry_plastic_nonlocal_setIPneighborhood(IPneighborhood(myGrid))
|
||||
|
||||
mesh_NcpElemsGlobal = product(grid)
|
||||
|
||||
mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt)
|
||||
|
||||
mesh_node0 = mesh_spectral_build_nodes()
|
||||
mesh_node = mesh_node0
|
||||
if (myDebug) write(6,'(a)') ' Built nodes'; flush(6)
|
||||
|
||||
call theMesh%init(mesh_node)
|
||||
call theMesh%setNelems(product(grid(1:2))*grid3)
|
||||
call mesh_spectral_build_elements()
|
||||
mesh_homogenizationAt = mesh_homogenizationAt(product(grid(1:2))*grid3Offset+1: &
|
||||
product(grid(1:2))*(grid3Offset+grid3)) ! reallocate/shrink in case of MPI
|
||||
|
||||
if (myDebug) write(6,'(a)') ' Built elements'; flush(6)
|
||||
|
||||
|
||||
|
||||
if (myDebug) write(6,'(a)') ' Built cell nodes'; flush(6)
|
||||
mesh_ipCoordinates = mesh_build_ipCoordinates()
|
||||
if (myDebug) write(6,'(a)') ' Built IP coordinates'; flush(6)
|
||||
allocate(mesh_ipVolume(1,theMesh%nElems),source=product([geomSize(1:2),size3]/real([grid(1:2),grid3])))
|
||||
if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6)
|
||||
mesh_ipArea = mesh_build_ipAreas()
|
||||
mesh_ipAreaNormal = mesh_build_ipNormals()
|
||||
if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6)
|
||||
|
||||
call mesh_spectral_build_ipNeighborhood
|
||||
call geometry_plastic_nonlocal_set_IPneighborhood(mesh_ipNeighborhood)
|
||||
|
||||
if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6)
|
||||
|
||||
if (debug_e < 1 .or. debug_e > theMesh%nElems) &
|
||||
call IO_error(602_pInt,ext_msg='element') ! selected element does not exist
|
||||
if (debug_i < 1 .or. debug_i > theMesh%elem%nIPs) &
|
||||
call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP
|
||||
|
||||
FEsolving_execElem = [ 1_pInt,theMesh%nElems ] ! parallel loop bounds set to comprise all DAMASK elements
|
||||
allocate(FEsolving_execIP(2_pInt,theMesh%nElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP...
|
||||
forall (j = 1_pInt:theMesh%nElems) FEsolving_execIP(2,j) = theMesh%elem%nIPs ! ...up to own IP count for each element
|
||||
|
||||
|
||||
!!!! COMPATIBILITY HACK !!!!
|
||||
theMesh%homogenizationAt = mesh_element(3,:)
|
||||
theMesh%microstructureAt = mesh_element(4,:)
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 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
|
||||
|
||||
end subroutine mesh_init
|
||||
|
||||
|
|
@ -219,24 +121,20 @@ end subroutine mesh_init
|
|||
!> @details important variables have an implicit "save" attribute. Therefore, this function is
|
||||
! supposed to be called only once!
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine mesh_spectral_read_grid()
|
||||
use IO, only: &
|
||||
IO_stringPos, &
|
||||
IO_lc, &
|
||||
IO_stringValue, &
|
||||
IO_intValue, &
|
||||
IO_floatValue, &
|
||||
IO_error
|
||||
use DAMASK_interface, only: &
|
||||
geometryFile
|
||||
subroutine readGeom(grid,geomSize,microstructure,homogenization)
|
||||
|
||||
implicit none
|
||||
character(len=:), allocatable :: rawData
|
||||
character(len=65536) :: line
|
||||
integer(pInt), allocatable, dimension(:) :: chunkPos
|
||||
integer(pInt) :: h =- 1_pInt
|
||||
integer(pInt) :: &
|
||||
headerLength = -1_pInt, & !< length of header (in lines)
|
||||
integer, dimension(3), intent(out) :: grid ! grid (for all processes!)
|
||||
real(pReal), dimension(3), intent(out) :: geomSize ! size (for all processes!)
|
||||
integer, dimension(:), intent(out), allocatable :: &
|
||||
microstructure, &
|
||||
homogenization
|
||||
|
||||
character(len=:), allocatable :: rawData
|
||||
character(len=65536) :: line
|
||||
integer, allocatable, dimension(:) :: chunkPos
|
||||
integer :: &
|
||||
h =- 1, &
|
||||
headerLength = -1, & !< length of header (in lines)
|
||||
fileLength, & !< length of the geom file (in characters)
|
||||
fileUnit, &
|
||||
startPos, endPos, &
|
||||
|
|
@ -247,15 +145,15 @@ subroutine mesh_spectral_read_grid()
|
|||
e, & !< "element", i.e. spectral collocation point
|
||||
i, j
|
||||
|
||||
grid = -1_pInt
|
||||
grid = -1
|
||||
geomSize = -1.0_pReal
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! read data as stream
|
||||
! read raw data as stream
|
||||
inquire(file = trim(geometryFile), size=fileLength)
|
||||
open(newunit=fileUnit, file=trim(geometryFile), access='stream',&
|
||||
status='old', position='rewind', action='read',iostat=myStat)
|
||||
if(myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=trim(geometryFile))
|
||||
if(myStat /= 0) call IO_error(100,ext_msg=trim(geometryFile))
|
||||
allocate(character(len=fileLength)::rawData)
|
||||
read(fileUnit) rawData
|
||||
close(fileUnit)
|
||||
|
|
@ -265,355 +163,318 @@ subroutine mesh_spectral_read_grid()
|
|||
endPos = index(rawData,new_line(''))
|
||||
if(endPos <= index(rawData,'head')) then
|
||||
startPos = len(rawData)
|
||||
call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid')
|
||||
call IO_error(error_ID=841, ext_msg='readGeom')
|
||||
else
|
||||
chunkPos = IO_stringPos(rawData(1:endPos))
|
||||
if (chunkPos(1) < 2_pInt) call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid')
|
||||
headerLength = IO_intValue(rawData(1:endPos),chunkPos,1_pInt)
|
||||
startPos = endPos + 1_pInt
|
||||
if (chunkPos(1) < 2) call IO_error(error_ID=841, ext_msg='readGeom')
|
||||
headerLength = IO_intValue(rawData(1:endPos),chunkPos,1)
|
||||
startPos = endPos + 1
|
||||
endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! read and interprete header
|
||||
l = 0
|
||||
do while (l < headerLength .and. startPos < len(rawData))
|
||||
endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt
|
||||
endPos = startPos + index(rawData(startPos:),new_line('')) - 1
|
||||
if (endPos < startPos) endPos = len(rawData) ! end of file without new line
|
||||
line = rawData(startPos:endPos)
|
||||
startPos = endPos + 1_pInt
|
||||
l = l + 1_pInt
|
||||
startPos = endPos + 1
|
||||
l = l + 1
|
||||
|
||||
chunkPos = IO_stringPos(trim(line))
|
||||
if (chunkPos(1) < 2) cycle ! need at least one keyword value pair
|
||||
|
||||
select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1_pInt,.true.)) )
|
||||
select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1,.true.)) )
|
||||
case ('grid')
|
||||
if (chunkPos(1) > 6) then
|
||||
do j = 2_pInt,6_pInt,2_pInt
|
||||
do j = 2,6,2
|
||||
select case (IO_lc(IO_stringValue(line,chunkPos,j)))
|
||||
case('a')
|
||||
grid(1) = IO_intValue(line,chunkPos,j+1_pInt)
|
||||
grid(1) = IO_intValue(line,chunkPos,j+1)
|
||||
case('b')
|
||||
grid(2) = IO_intValue(line,chunkPos,j+1_pInt)
|
||||
grid(2) = IO_intValue(line,chunkPos,j+1)
|
||||
case('c')
|
||||
grid(3) = IO_intValue(line,chunkPos,j+1_pInt)
|
||||
grid(3) = IO_intValue(line,chunkPos,j+1)
|
||||
end select
|
||||
enddo
|
||||
endif
|
||||
|
||||
case ('size')
|
||||
if (chunkPos(1) > 6) then
|
||||
do j = 2_pInt,6_pInt,2_pInt
|
||||
do j = 2,6,2
|
||||
select case (IO_lc(IO_stringValue(line,chunkPos,j)))
|
||||
case('x')
|
||||
geomSize(1) = IO_floatValue(line,chunkPos,j+1_pInt)
|
||||
geomSize(1) = IO_floatValue(line,chunkPos,j+1)
|
||||
case('y')
|
||||
geomSize(2) = IO_floatValue(line,chunkPos,j+1_pInt)
|
||||
geomSize(2) = IO_floatValue(line,chunkPos,j+1)
|
||||
case('z')
|
||||
geomSize(3) = IO_floatValue(line,chunkPos,j+1_pInt)
|
||||
geomSize(3) = IO_floatValue(line,chunkPos,j+1)
|
||||
end select
|
||||
enddo
|
||||
endif
|
||||
|
||||
case ('homogenization')
|
||||
if (chunkPos(1) > 1) h = IO_intValue(line,chunkPos,2_pInt)
|
||||
if (chunkPos(1) > 1) h = IO_intValue(line,chunkPos,2)
|
||||
end select
|
||||
|
||||
enddo
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! sanity checks
|
||||
if(h < 1_pInt) &
|
||||
call IO_error(error_ID = 842_pInt, ext_msg='homogenization (mesh_spectral_read_grid)')
|
||||
if(any(grid < 1_pInt)) &
|
||||
call IO_error(error_ID = 842_pInt, ext_msg='grid (mesh_spectral_read_grid)')
|
||||
if(h < 1) &
|
||||
call IO_error(error_ID = 842, ext_msg='homogenization (readGeom)')
|
||||
if(any(grid < 1)) &
|
||||
call IO_error(error_ID = 842, ext_msg='grid (readGeom)')
|
||||
if(any(geomSize < 0.0_pReal)) &
|
||||
call IO_error(error_ID = 842_pInt, ext_msg='size (mesh_spectral_read_grid)')
|
||||
call IO_error(error_ID = 842, ext_msg='size (readGeom)')
|
||||
|
||||
allocate(microGlobal(product(grid)), source = -1_pInt)
|
||||
allocate(mesh_homogenizationAt(product(grid)), source = h) ! too large in case of MPI (shrink later, not very elegant)
|
||||
allocate(microstructure(product(grid)), source = -1) ! too large in case of MPI (shrink later, not very elegant)
|
||||
allocate(homogenization(product(grid)), source = h) ! too large in case of MPI (shrink later, not very elegant)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! read and interpret content
|
||||
e = 1_pInt
|
||||
e = 1
|
||||
do while (startPos < len(rawData))
|
||||
endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt
|
||||
endPos = startPos + index(rawData(startPos:),new_line('')) - 1
|
||||
if (endPos < startPos) endPos = len(rawData) ! end of file without new line
|
||||
line = rawData(startPos:endPos)
|
||||
startPos = endPos + 1_pInt
|
||||
l = l + 1_pInt
|
||||
startPos = endPos + 1
|
||||
l = l + 1
|
||||
chunkPos = IO_stringPos(trim(line))
|
||||
|
||||
noCompression: if (chunkPos(1) /= 3) then
|
||||
c = chunkPos(1)
|
||||
microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)]
|
||||
microstructure(e:e+c-1) = [(IO_intValue(line,chunkPos,i+1), i=0, c-1)]
|
||||
else noCompression
|
||||
compression: if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then
|
||||
c = IO_intValue(line,chunkPos,1)
|
||||
microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,3),i = 1_pInt,IO_intValue(line,chunkPos,1))]
|
||||
microstructure(e:e+c-1) = [(IO_intValue(line,chunkPos,3),i = 1,IO_intValue(line,chunkPos,1))]
|
||||
else if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to') then compression
|
||||
c = abs(IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1)) + 1_pInt
|
||||
o = merge(+1_pInt, -1_pInt, IO_intValue(line,chunkPos,3) > IO_intValue(line,chunkPos,1))
|
||||
microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3),o)]
|
||||
c = abs(IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1)) + 1
|
||||
o = merge(+1, -1, IO_intValue(line,chunkPos,3) > IO_intValue(line,chunkPos,1))
|
||||
microstructure(e:e+c-1) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3),o)]
|
||||
else compression
|
||||
c = chunkPos(1)
|
||||
microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)]
|
||||
microstructure(e:e+c-1) = [(IO_intValue(line,chunkPos,i+1), i=0, c-1)]
|
||||
endif compression
|
||||
endif noCompression
|
||||
|
||||
e = e+c
|
||||
end do
|
||||
|
||||
if (e-1 /= product(grid)) call IO_error(error_ID = 843_pInt, el=e)
|
||||
if (e-1 /= product(grid)) call IO_error(error_ID = 843, el=e)
|
||||
|
||||
end subroutine mesh_spectral_read_grid
|
||||
end subroutine readGeom
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> @brief Calculates position of nodes (pretend to be an element)
|
||||
!> @brief Calculate position of IPs/cell centres (pretend to be an element)
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
pure function mesh_spectral_build_nodes()
|
||||
function IPcoordinates(grid,geomSize,grid3Offset)
|
||||
|
||||
real(pReal), dimension(3,mesh_Nnodes) :: mesh_spectral_build_nodes
|
||||
integer :: n,a,b,c
|
||||
integer, dimension(3), intent(in) :: grid ! grid (for this process!)
|
||||
real(pReal), dimension(3), intent(in) :: geomSize ! size (for this process!)
|
||||
integer, intent(in) :: grid3Offset ! grid(3) offset
|
||||
|
||||
n = 0
|
||||
do c = 0, grid3
|
||||
do b = 0, grid(2)
|
||||
do a = 0, grid(1)
|
||||
n = n + 1
|
||||
mesh_spectral_build_nodes(1:3,n) = geomSize/real(grid,pReal) * real([a,b,grid3Offset+c],pReal)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
real(pReal), dimension(3,1,product(grid)) :: ipCoordinates
|
||||
|
||||
end function mesh_spectral_build_nodes
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> @brief Calculates position of IPs/cell centres (pretend to be an element)
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
function mesh_build_ipCoordinates()
|
||||
|
||||
real(pReal), dimension(3,1,theMesh%nElems) :: mesh_build_ipCoordinates
|
||||
integer :: n,a,b,c
|
||||
integer :: &
|
||||
a,b,c, &
|
||||
i
|
||||
|
||||
i = 0
|
||||
do c = 1, grid(3); do b = 1, grid(2); do a = 1, grid(1)
|
||||
i = i + 1
|
||||
IPcoordinates(1:3,1,i) = geomSize/real(grid,pReal) * (real([a,b,grid3Offset+c],pReal) -0.5_pReal)
|
||||
enddo; enddo; enddo
|
||||
|
||||
end function IPcoordinates
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> @brief Calculate position of nodes (pretend to be an element)
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
pure function nodes(grid,geomSize,grid3Offset)
|
||||
|
||||
integer, dimension(3), intent(in) :: grid ! grid (for this process!)
|
||||
real(pReal), dimension(3), intent(in) :: geomSize ! size (for this process!)
|
||||
integer, intent(in) :: grid3Offset ! grid(3) offset
|
||||
|
||||
real(pReal), dimension(3,product(grid+1)) :: nodes
|
||||
|
||||
integer :: &
|
||||
a,b,c, &
|
||||
n
|
||||
|
||||
n = 0
|
||||
do c = 1, grid3
|
||||
do b = 1, grid(2)
|
||||
do a = 1, grid(1)
|
||||
n = n + 1
|
||||
mesh_build_ipCoordinates(1:3,1,n) = geomSize/real(grid,pReal) * (real([a,b,grid3Offset+c],pReal) -0.5_pReal)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
do c = 0, grid3; do b = 0, grid(2); do a = 0, grid(1)
|
||||
n = n + 1
|
||||
nodes(1:3,n) = geomSize/real(grid,pReal) * real([a,b,grid3Offset+c],pReal)
|
||||
enddo; enddo; enddo
|
||||
|
||||
end function mesh_build_ipCoordinates
|
||||
end function nodes
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Store FEid, type, material, texture, and node list per element.
|
||||
!! Allocates global array 'mesh_element'
|
||||
!> @brief Calculate IP interface areas
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine mesh_spectral_build_elements()
|
||||
integer(pInt) :: &
|
||||
e, &
|
||||
elemOffset
|
||||
|
||||
|
||||
allocate(mesh_element (4_pInt+8_pInt,theMesh%nElems), source = 0_pInt)
|
||||
|
||||
elemOffset = product(grid(1:2))*grid3Offset
|
||||
do e=1, theMesh%nElems
|
||||
mesh_element( 1,e) = -1_pInt ! DEPRECATED
|
||||
mesh_element( 2,e) = -1_pInt ! DEPRECATED
|
||||
mesh_element( 3,e) = mesh_homogenizationAt(e)
|
||||
mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure
|
||||
mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + &
|
||||
((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node
|
||||
mesh_element( 6,e) = mesh_element(5,e) + 1_pInt
|
||||
mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt
|
||||
mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt
|
||||
mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node
|
||||
mesh_element(10,e) = mesh_element(9,e) + 1_pInt
|
||||
mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt
|
||||
mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt
|
||||
enddo
|
||||
|
||||
end subroutine mesh_spectral_build_elements
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief build neighborhood relations for spectral
|
||||
!> @details assign globals: mesh_ipNeighborhood
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine mesh_spectral_build_ipNeighborhood
|
||||
|
||||
implicit none
|
||||
integer(pInt) :: &
|
||||
x,y,z, &
|
||||
e
|
||||
allocate(mesh_ipNeighborhood(3,6,1,theMesh%nElems),source=0_pInt)
|
||||
|
||||
e = 0_pInt
|
||||
do z = 0_pInt,grid3-1_pInt
|
||||
do y = 0_pInt,grid(2)-1_pInt
|
||||
do x = 0_pInt,grid(1)-1_pInt
|
||||
e = e + 1_pInt
|
||||
mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) &
|
||||
+ y * grid(1) &
|
||||
+ modulo(x+1_pInt,grid(1)) &
|
||||
+ 1_pInt
|
||||
mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) &
|
||||
+ y * grid(1) &
|
||||
+ modulo(x-1_pInt,grid(1)) &
|
||||
+ 1_pInt
|
||||
mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) &
|
||||
+ modulo(y+1_pInt,grid(2)) * grid(1) &
|
||||
+ x &
|
||||
+ 1_pInt
|
||||
mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) &
|
||||
+ modulo(y-1_pInt,grid(2)) * grid(1) &
|
||||
+ x &
|
||||
+ 1_pInt
|
||||
mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) &
|
||||
+ y * grid(1) &
|
||||
+ x &
|
||||
+ 1_pInt
|
||||
mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) &
|
||||
+ y * grid(1) &
|
||||
+ x &
|
||||
+ 1_pInt
|
||||
mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt
|
||||
mesh_ipNeighborhood(3,1,1,e) = 2_pInt
|
||||
mesh_ipNeighborhood(3,2,1,e) = 1_pInt
|
||||
mesh_ipNeighborhood(3,3,1,e) = 4_pInt
|
||||
mesh_ipNeighborhood(3,4,1,e) = 3_pInt
|
||||
mesh_ipNeighborhood(3,5,1,e) = 6_pInt
|
||||
mesh_ipNeighborhood(3,6,1,e) = 5_pInt
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine mesh_spectral_build_ipNeighborhood
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes)
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes)
|
||||
use debug, only: &
|
||||
debug_mesh, &
|
||||
debug_level, &
|
||||
debug_levelBasic
|
||||
|
||||
real(pReal), intent(in), dimension(:,:,:,:) :: &
|
||||
centres
|
||||
real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: &
|
||||
nodes
|
||||
real(pReal), intent(in), dimension(3) :: &
|
||||
gDim
|
||||
real(pReal), intent(in), dimension(3,3) :: &
|
||||
Favg
|
||||
real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: &
|
||||
wrappedCentres
|
||||
|
||||
integer(pInt) :: &
|
||||
i,j,k,n
|
||||
integer(pInt), dimension(3), parameter :: &
|
||||
diag = 1_pInt
|
||||
integer(pInt), dimension(3) :: &
|
||||
shift = 0_pInt, &
|
||||
lookup = 0_pInt, &
|
||||
me = 0_pInt, &
|
||||
iRes = 0_pInt
|
||||
integer(pInt), dimension(3,8) :: &
|
||||
neighbor = reshape([ &
|
||||
0_pInt, 0_pInt, 0_pInt, &
|
||||
1_pInt, 0_pInt, 0_pInt, &
|
||||
1_pInt, 1_pInt, 0_pInt, &
|
||||
0_pInt, 1_pInt, 0_pInt, &
|
||||
0_pInt, 0_pInt, 1_pInt, &
|
||||
1_pInt, 0_pInt, 1_pInt, &
|
||||
1_pInt, 1_pInt, 1_pInt, &
|
||||
0_pInt, 1_pInt, 1_pInt ], [3,8])
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! initializing variables
|
||||
iRes = [size(centres,2),size(centres,3),size(centres,4)]
|
||||
nodes = 0.0_pReal
|
||||
wrappedCentres = 0.0_pReal
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! report
|
||||
if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then
|
||||
write(6,'(a)') ' Meshing cubes around centroids'
|
||||
write(6,'(a,3(e12.5))') ' Dimension: ', gDim
|
||||
write(6,'(a,3(i5))') ' Resolution:', iRes
|
||||
endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! building wrappedCentres = centroids + ghosts
|
||||
wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres
|
||||
do k = 0_pInt,iRes(3)+1_pInt
|
||||
do j = 0_pInt,iRes(2)+1_pInt
|
||||
do i = 0_pInt,iRes(1)+1_pInt
|
||||
if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin
|
||||
j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin
|
||||
i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin
|
||||
me = [i,j,k] ! me on skin
|
||||
shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me)
|
||||
lookup = me-diag+shift*iRes
|
||||
wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = &
|
||||
centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) &
|
||||
- matmul(Favg, real(shift,pReal)*gDim)
|
||||
endif
|
||||
enddo; enddo; enddo
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! averaging
|
||||
do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1)
|
||||
do n = 1_pInt,8_pInt
|
||||
nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = &
|
||||
nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), &
|
||||
j+1_pInt+neighbor(2,n), &
|
||||
k+1_pInt+neighbor(3,n) )
|
||||
enddo
|
||||
enddo; enddo; enddo
|
||||
nodes = nodes/8.0_pReal
|
||||
|
||||
end function mesh_nodesAroundCentres
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal'
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
pure function mesh_build_ipAreas()
|
||||
|
||||
real(pReal), dimension(6,1,theMesh%nElems) :: mesh_build_ipAreas
|
||||
|
||||
mesh_build_ipAreas(1:2,1,:) = geomSize(2)/real(grid(2)) * geomSize(3)/real(grid(3))
|
||||
mesh_build_ipAreas(3:4,1,:) = geomSize(3)/real(grid(3)) * geomSize(1)/real(grid(1))
|
||||
mesh_build_ipAreas(5:6,1,:) = geomSize(1)/real(grid(1)) * geomSize(2)/real(grid(2))
|
||||
pure function cellEdgeArea(geomSize,grid)
|
||||
|
||||
end function mesh_build_ipAreas
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal'
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
pure function mesh_build_ipNormals()
|
||||
|
||||
real, dimension(3,6,1,theMesh%nElems) :: mesh_build_ipNormals
|
||||
|
||||
mesh_build_ipNormals(1:3,1,1,:) = spread([+1.0_pReal, 0.0_pReal, 0.0_pReal],2,theMesh%nElems)
|
||||
mesh_build_ipNormals(1:3,2,1,:) = spread([-1.0_pReal, 0.0_pReal, 0.0_pReal],2,theMesh%nElems)
|
||||
mesh_build_ipNormals(1:3,3,1,:) = spread([ 0.0_pReal,+1.0_pReal, 0.0_pReal],2,theMesh%nElems)
|
||||
mesh_build_ipNormals(1:3,4,1,:) = spread([ 0.0_pReal,-1.0_pReal, 0.0_pReal],2,theMesh%nElems)
|
||||
mesh_build_ipNormals(1:3,5,1,:) = spread([ 0.0_pReal, 0.0_pReal,+1.0_pReal],2,theMesh%nElems)
|
||||
mesh_build_ipNormals(1:3,6,1,:) = spread([ 0.0_pReal, 0.0_pReal,-1.0_pReal],2,theMesh%nElems)
|
||||
real(pReal), dimension(3), intent(in) :: geomSize ! size (for this process!)
|
||||
integer, dimension(3), intent(in) :: grid ! grid (for this process!)
|
||||
|
||||
end function mesh_build_ipNormals
|
||||
real(pReal), dimension(6,1,product(grid)) :: cellEdgeArea
|
||||
|
||||
cellEdgeArea(1:2,1,:) = geomSize(2)/real(grid(2)) * geomSize(3)/real(grid(3))
|
||||
cellEdgeArea(3:4,1,:) = geomSize(3)/real(grid(3)) * geomSize(1)/real(grid(1))
|
||||
cellEdgeArea(5:6,1,:) = geomSize(1)/real(grid(1)) * geomSize(2)/real(grid(2))
|
||||
|
||||
end function cellEdgeArea
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Calculate IP interface areas normals
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
pure function cellEdgeNormal(nElems)
|
||||
|
||||
integer, intent(in) :: nElems
|
||||
|
||||
real, dimension(3,6,1,nElems) :: cellEdgeNormal
|
||||
|
||||
cellEdgeNormal(1:3,1,1,:) = spread([+1.0_pReal, 0.0_pReal, 0.0_pReal],2,nElems)
|
||||
cellEdgeNormal(1:3,2,1,:) = spread([-1.0_pReal, 0.0_pReal, 0.0_pReal],2,nElems)
|
||||
cellEdgeNormal(1:3,3,1,:) = spread([ 0.0_pReal,+1.0_pReal, 0.0_pReal],2,nElems)
|
||||
cellEdgeNormal(1:3,4,1,:) = spread([ 0.0_pReal,-1.0_pReal, 0.0_pReal],2,nElems)
|
||||
cellEdgeNormal(1:3,5,1,:) = spread([ 0.0_pReal, 0.0_pReal,+1.0_pReal],2,nElems)
|
||||
cellEdgeNormal(1:3,6,1,:) = spread([ 0.0_pReal, 0.0_pReal,-1.0_pReal],2,nElems)
|
||||
|
||||
end function cellEdgeNormal
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Build IP neighborhood relations
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
pure function IPneighborhood(grid)
|
||||
|
||||
integer, dimension(3), intent(in) :: grid ! grid (for this process!)
|
||||
|
||||
integer, dimension(3,6,1,product(grid)) :: IPneighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me]
|
||||
|
||||
integer :: &
|
||||
x,y,z, &
|
||||
e
|
||||
|
||||
e = 0
|
||||
do z = 0,grid(3)-1; do y = 0,grid(2)-1; do x = 0,grid(1)-1
|
||||
e = e + 1
|
||||
IPneighborhood(1,1,1,e) = z * grid(1) * grid(2) &
|
||||
+ y * grid(1) &
|
||||
+ modulo(x+1,grid(1)) &
|
||||
+ 1
|
||||
IPneighborhood(1,2,1,e) = z * grid(1) * grid(2) &
|
||||
+ y * grid(1) &
|
||||
+ modulo(x-1,grid(1)) &
|
||||
+ 1
|
||||
IPneighborhood(1,3,1,e) = z * grid(1) * grid(2) &
|
||||
+ modulo(y+1,grid(2)) * grid(1) &
|
||||
+ x &
|
||||
+ 1
|
||||
IPneighborhood(1,4,1,e) = z * grid(1) * grid(2) &
|
||||
+ modulo(y-1,grid(2)) * grid(1) &
|
||||
+ x &
|
||||
+ 1
|
||||
IPneighborhood(1,5,1,e) = modulo(z+1,grid(3)) * grid(1) * grid(2) &
|
||||
+ y * grid(1) &
|
||||
+ x &
|
||||
+ 1
|
||||
IPneighborhood(1,6,1,e) = modulo(z-1,grid(3)) * grid(1) * grid(2) &
|
||||
+ y * grid(1) &
|
||||
+ x &
|
||||
+ 1
|
||||
IPneighborhood(2,1:6,1,e) = 1
|
||||
IPneighborhood(3,1,1,e) = 2
|
||||
IPneighborhood(3,2,1,e) = 1
|
||||
IPneighborhood(3,3,1,e) = 4
|
||||
IPneighborhood(3,4,1,e) = 3
|
||||
IPneighborhood(3,5,1,e) = 6
|
||||
IPneighborhood(3,6,1,e) = 5
|
||||
enddo; enddo; enddo
|
||||
|
||||
end function IPneighborhood
|
||||
|
||||
|
||||
!!--------------------------------------------------------------------------------------------------
|
||||
!!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes)
|
||||
!!--------------------------------------------------------------------------------------------------
|
||||
!function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes)
|
||||
!
|
||||
! real(pReal), intent(in), dimension(:,:,:,:) :: &
|
||||
! centres
|
||||
! real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: &
|
||||
! nodes
|
||||
! real(pReal), intent(in), dimension(3) :: &
|
||||
! gDim
|
||||
! real(pReal), intent(in), dimension(3,3) :: &
|
||||
! Favg
|
||||
! real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: &
|
||||
! wrappedCentres
|
||||
!
|
||||
! integer :: &
|
||||
! i,j,k,n
|
||||
! integer, dimension(3), parameter :: &
|
||||
! diag = 1
|
||||
! integer, dimension(3) :: &
|
||||
! shift = 0, &
|
||||
! lookup = 0, &
|
||||
! me = 0, &
|
||||
! iRes = 0
|
||||
! integer, dimension(3,8) :: &
|
||||
! neighbor = reshape([ &
|
||||
! 0, 0, 0, &
|
||||
! 1, 0, 0, &
|
||||
! 1, 1, 0, &
|
||||
! 0, 1, 0, &
|
||||
! 0, 0, 1, &
|
||||
! 1, 0, 1, &
|
||||
! 1, 1, 1, &
|
||||
! 0, 1, 1 ], [3,8])
|
||||
!
|
||||
!!--------------------------------------------------------------------------------------------------
|
||||
!! initializing variables
|
||||
! iRes = [size(centres,2),size(centres,3),size(centres,4)]
|
||||
! nodes = 0.0_pReal
|
||||
! wrappedCentres = 0.0_pReal
|
||||
!
|
||||
!!--------------------------------------------------------------------------------------------------
|
||||
!! building wrappedCentres = centroids + ghosts
|
||||
! wrappedCentres(1:3,2:iRes(1)+1,2:iRes(2)+1,2:iRes(3)+1) = centres
|
||||
! do k = 0,iRes(3)+1
|
||||
! do j = 0,iRes(2)+1
|
||||
! do i = 0,iRes(1)+1
|
||||
! if (k==0 .or. k==iRes(3)+1 .or. & ! z skin
|
||||
! j==0 .or. j==iRes(2)+1 .or. & ! y skin
|
||||
! i==0 .or. i==iRes(1)+1 ) then ! x skin
|
||||
! me = [i,j,k] ! me on skin
|
||||
! shift = sign(abs(iRes+diag-2*me)/(iRes+diag),iRes+diag-2*me)
|
||||
! lookup = me-diag+shift*iRes
|
||||
! wrappedCentres(1:3,i+1, j+1, k+1) = &
|
||||
! centres(1:3,lookup(1)+1,lookup(2)+1,lookup(3)+1) &
|
||||
! - matmul(Favg, real(shift,pReal)*gDim)
|
||||
! endif
|
||||
! enddo; enddo; enddo
|
||||
!
|
||||
!!--------------------------------------------------------------------------------------------------
|
||||
!! averaging
|
||||
! do k = 0,iRes(3); do j = 0,iRes(2); do i = 0,iRes(1)
|
||||
! do n = 1,8
|
||||
! nodes(1:3,i+1,j+1,k+1) = &
|
||||
! nodes(1:3,i+1,j+1,k+1) + wrappedCentres(1:3,i+1+neighbor(1,n), &
|
||||
! j+1+neighbor(2,n), &
|
||||
! k+1+neighbor(3,n) )
|
||||
! enddo
|
||||
! enddo; enddo; enddo
|
||||
! nodes = nodes/8.0_pReal
|
||||
!
|
||||
!end function mesh_nodesAroundCentres
|
||||
|
||||
end module mesh
|
||||
|
|
|
|||
2123
src/mesh_marc.f90
2123
src/mesh_marc.f90
File diff suppressed because it is too large
Load Diff
238
src/numerics.f90
238
src/numerics.f90
|
|
@ -5,17 +5,24 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
module numerics
|
||||
use prec
|
||||
use IO
|
||||
|
||||
#ifdef PETSc
|
||||
#include <petsc/finclude/petscsys.h>
|
||||
use petscsys
|
||||
#endif
|
||||
!$ use OMP_LIB
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
integer(pInt), protected, public :: &
|
||||
iJacoStiffness = 1_pInt, & !< frequency of stiffness update
|
||||
nMPstate = 10_pInt, & !< materialpoint state loop limit
|
||||
randomSeed = 0_pInt, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed
|
||||
worldrank = 0_pInt, & !< MPI worldrank (/=0 for MPI simulations only)
|
||||
worldsize = 1_pInt, & !< MPI worldsize (/=1 for MPI simulations only)
|
||||
numerics_integrator = 1_pInt !< method used for state integration Default 1: fix-point iteration
|
||||
integer, protected, public :: &
|
||||
iJacoStiffness = 1, & !< frequency of stiffness update
|
||||
nMPstate = 10, & !< materialpoint state loop limit
|
||||
randomSeed = 0, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed
|
||||
worldrank = 0, & !< MPI worldrank (/=0 for MPI simulations only)
|
||||
worldsize = 1, & !< MPI worldsize (/=1 for MPI simulations only)
|
||||
numerics_integrator = 1 !< method used for state integration Default 1: fix-point iteration
|
||||
integer(4), protected, public :: &
|
||||
DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive
|
||||
real(pReal), protected, public :: &
|
||||
|
|
@ -51,11 +58,11 @@ module numerics
|
|||
err_thermal_tolRel = 1.0e-6_pReal, & !< relative tolerance for thermal equilibrium
|
||||
err_damage_tolAbs = 1.0e-2_pReal, & !< absolute tolerance for damage evolution
|
||||
err_damage_tolRel = 1.0e-6_pReal !< relative tolerance for damage evolution
|
||||
integer(pInt), protected, public :: &
|
||||
itmax = 250_pInt, & !< maximum number of iterations
|
||||
itmin = 1_pInt, & !< minimum number of iterations
|
||||
stagItMax = 10_pInt, & !< max number of field level staggered iterations
|
||||
maxCutBack = 3_pInt !< max number of cut backs
|
||||
integer, protected, public :: &
|
||||
itmax = 250, & !< maximum number of iterations
|
||||
itmin = 1, & !< minimum number of iterations
|
||||
stagItMax = 10, & !< max number of field level staggered iterations
|
||||
maxCutBack = 3 !< max number of cut backs
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! spectral parameters:
|
||||
|
|
@ -83,9 +90,9 @@ module numerics
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! FEM parameters:
|
||||
#ifdef FEM
|
||||
integer(pInt), protected, public :: &
|
||||
integrationOrder = 2_pInt, & !< order of quadrature rule required
|
||||
structOrder = 2_pInt !< order of displacement shape functions
|
||||
integer, protected, public :: &
|
||||
integrationOrder = 2, & !< order of quadrature rule required
|
||||
structOrder = 2 !< order of displacement shape functions
|
||||
logical, protected, public :: &
|
||||
BBarStabilisation = .false.
|
||||
character(len=4096), protected, public :: &
|
||||
|
|
@ -113,24 +120,9 @@ contains
|
|||
! a sanity check
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine numerics_init
|
||||
use IO, only: &
|
||||
IO_read_ASCII, &
|
||||
IO_error, &
|
||||
IO_isBlank, &
|
||||
IO_stringPos, &
|
||||
IO_stringValue, &
|
||||
IO_lc, &
|
||||
IO_floatValue, &
|
||||
IO_intValue, &
|
||||
IO_warning
|
||||
#ifdef PETSc
|
||||
#include <petsc/finclude/petscsys.h>
|
||||
use petscsys
|
||||
#endif
|
||||
!$ use OMP_LIB, only: omp_set_num_threads
|
||||
!$ integer :: gotDAMASK_NUM_THREADS = 1
|
||||
integer :: i,j, ierr ! no pInt
|
||||
integer(pInt), allocatable, dimension(:) :: chunkPos
|
||||
integer :: i,j, ierr
|
||||
integer, allocatable, dimension(:) :: chunkPos
|
||||
character(len=pStringLen), dimension(:), allocatable :: fileContent
|
||||
character(len=pStringLen) :: &
|
||||
tag ,&
|
||||
|
|
@ -146,7 +138,7 @@ subroutine numerics_init
|
|||
|
||||
!$ call GET_ENVIRONMENT_VARIABLE(NAME='DAMASK_NUM_THREADS',VALUE=DAMASK_NumThreadsString,STATUS=gotDAMASK_NUM_THREADS) ! get environment variable DAMASK_NUM_THREADS...
|
||||
!$ if(gotDAMASK_NUM_THREADS /= 0) then ! could not get number of threads, set it to 1
|
||||
!$ call IO_warning(35_pInt,ext_msg='BEGIN:'//DAMASK_NumThreadsString//':END')
|
||||
!$ call IO_warning(35,ext_msg='BEGIN:'//DAMASK_NumThreadsString//':END')
|
||||
!$ DAMASK_NumThreadsInt = 1_4
|
||||
!$ else
|
||||
!$ read(DAMASK_NumThreadsString,'(i6)') DAMASK_NumThreadsInt ! read as integer
|
||||
|
|
@ -170,128 +162,128 @@ subroutine numerics_init
|
|||
enddo
|
||||
if (IO_isBlank(line)) cycle ! skip empty lines
|
||||
chunkPos = IO_stringPos(line)
|
||||
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
|
||||
tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key
|
||||
|
||||
select case(tag)
|
||||
case ('defgradtolerance')
|
||||
defgradTolerance = IO_floatValue(line,chunkPos,2_pInt)
|
||||
defgradTolerance = IO_floatValue(line,chunkPos,2)
|
||||
case ('ijacostiffness')
|
||||
iJacoStiffness = IO_intValue(line,chunkPos,2_pInt)
|
||||
iJacoStiffness = IO_intValue(line,chunkPos,2)
|
||||
case ('nmpstate')
|
||||
nMPstate = IO_intValue(line,chunkPos,2_pInt)
|
||||
nMPstate = IO_intValue(line,chunkPos,2)
|
||||
case ('substepminhomog')
|
||||
subStepMinHomog = IO_floatValue(line,chunkPos,2_pInt)
|
||||
subStepMinHomog = IO_floatValue(line,chunkPos,2)
|
||||
case ('substepsizehomog')
|
||||
subStepSizeHomog = IO_floatValue(line,chunkPos,2_pInt)
|
||||
subStepSizeHomog = IO_floatValue(line,chunkPos,2)
|
||||
case ('stepincreasehomog')
|
||||
stepIncreaseHomog = IO_floatValue(line,chunkPos,2_pInt)
|
||||
stepIncreaseHomog = IO_floatValue(line,chunkPos,2)
|
||||
case ('integrator')
|
||||
numerics_integrator = IO_intValue(line,chunkPos,2_pInt)
|
||||
numerics_integrator = IO_intValue(line,chunkPos,2)
|
||||
case ('usepingpong')
|
||||
usepingpong = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
|
||||
usepingpong = IO_intValue(line,chunkPos,2) > 0
|
||||
case ('unitlength')
|
||||
numerics_unitlength = IO_floatValue(line,chunkPos,2_pInt)
|
||||
numerics_unitlength = IO_floatValue(line,chunkPos,2)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! RGC parameters
|
||||
case ('atol_rgc')
|
||||
absTol_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
absTol_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('rtol_rgc')
|
||||
relTol_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
relTol_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('amax_rgc')
|
||||
absMax_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
absMax_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('rmax_rgc')
|
||||
relMax_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
relMax_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('perturbpenalty_rgc')
|
||||
pPert_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
pPert_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('relevantmismatch_rgc')
|
||||
xSmoo_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
xSmoo_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('viscositypower_rgc')
|
||||
viscPower_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
viscPower_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('viscositymodulus_rgc')
|
||||
viscModus_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
viscModus_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('refrelaxationrate_rgc')
|
||||
refRelaxRate_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
refRelaxRate_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('maxrelaxation_rgc')
|
||||
maxdRelax_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
maxdRelax_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('maxvoldiscrepancy_rgc')
|
||||
maxVolDiscr_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
maxVolDiscr_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('voldiscrepancymod_rgc')
|
||||
volDiscrMod_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
volDiscrMod_RGC = IO_floatValue(line,chunkPos,2)
|
||||
case ('discrepancypower_rgc')
|
||||
volDiscrPow_RGC = IO_floatValue(line,chunkPos,2_pInt)
|
||||
volDiscrPow_RGC = IO_floatValue(line,chunkPos,2)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! random seeding parameter
|
||||
case ('random_seed','fixed_seed')
|
||||
randomSeed = IO_intValue(line,chunkPos,2_pInt)
|
||||
randomSeed = IO_intValue(line,chunkPos,2)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! gradient parameter
|
||||
case ('charlength')
|
||||
charLength = IO_floatValue(line,chunkPos,2_pInt)
|
||||
charLength = IO_floatValue(line,chunkPos,2)
|
||||
case ('residualstiffness')
|
||||
residualStiffness = IO_floatValue(line,chunkPos,2_pInt)
|
||||
residualStiffness = IO_floatValue(line,chunkPos,2)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! field parameters
|
||||
case ('err_struct_tolabs')
|
||||
err_struct_tolAbs = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_struct_tolAbs = IO_floatValue(line,chunkPos,2)
|
||||
case ('err_struct_tolrel')
|
||||
err_struct_tolRel = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_struct_tolRel = IO_floatValue(line,chunkPos,2)
|
||||
case ('err_thermal_tolabs')
|
||||
err_thermal_tolabs = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_thermal_tolabs = IO_floatValue(line,chunkPos,2)
|
||||
case ('err_thermal_tolrel')
|
||||
err_thermal_tolrel = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_thermal_tolrel = IO_floatValue(line,chunkPos,2)
|
||||
case ('err_damage_tolabs')
|
||||
err_damage_tolabs = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_damage_tolabs = IO_floatValue(line,chunkPos,2)
|
||||
case ('err_damage_tolrel')
|
||||
err_damage_tolrel = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_damage_tolrel = IO_floatValue(line,chunkPos,2)
|
||||
case ('itmax')
|
||||
itmax = IO_intValue(line,chunkPos,2_pInt)
|
||||
itmax = IO_intValue(line,chunkPos,2)
|
||||
case ('itmin')
|
||||
itmin = IO_intValue(line,chunkPos,2_pInt)
|
||||
itmin = IO_intValue(line,chunkPos,2)
|
||||
case ('maxcutback')
|
||||
maxCutBack = IO_intValue(line,chunkPos,2_pInt)
|
||||
maxCutBack = IO_intValue(line,chunkPos,2)
|
||||
case ('maxstaggerediter')
|
||||
stagItMax = IO_intValue(line,chunkPos,2_pInt)
|
||||
stagItMax = IO_intValue(line,chunkPos,2)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! spectral parameters
|
||||
#ifdef Grid
|
||||
case ('err_div_tolabs')
|
||||
err_div_tolAbs = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_div_tolAbs = IO_floatValue(line,chunkPos,2)
|
||||
case ('err_div_tolrel')
|
||||
err_div_tolRel = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_div_tolRel = IO_floatValue(line,chunkPos,2)
|
||||
case ('err_stress_tolrel')
|
||||
err_stress_tolrel = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_stress_tolrel = IO_floatValue(line,chunkPos,2)
|
||||
case ('err_stress_tolabs')
|
||||
err_stress_tolabs = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_stress_tolabs = IO_floatValue(line,chunkPos,2)
|
||||
case ('continuecalculation')
|
||||
continueCalculation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
|
||||
continueCalculation = IO_intValue(line,chunkPos,2) > 0
|
||||
case ('petsc_options')
|
||||
petsc_options = trim(line(chunkPos(4):))
|
||||
case ('err_curl_tolabs')
|
||||
err_curl_tolAbs = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_curl_tolAbs = IO_floatValue(line,chunkPos,2)
|
||||
case ('err_curl_tolrel')
|
||||
err_curl_tolRel = IO_floatValue(line,chunkPos,2_pInt)
|
||||
err_curl_tolRel = IO_floatValue(line,chunkPos,2)
|
||||
case ('polaralpha')
|
||||
polarAlpha = IO_floatValue(line,chunkPos,2_pInt)
|
||||
polarAlpha = IO_floatValue(line,chunkPos,2)
|
||||
case ('polarbeta')
|
||||
polarBeta = IO_floatValue(line,chunkPos,2_pInt)
|
||||
polarBeta = IO_floatValue(line,chunkPos,2)
|
||||
#endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! FEM parameters
|
||||
#ifdef FEM
|
||||
case ('integrationorder')
|
||||
integrationorder = IO_intValue(line,chunkPos,2_pInt)
|
||||
integrationorder = IO_intValue(line,chunkPos,2)
|
||||
case ('structorder')
|
||||
structorder = IO_intValue(line,chunkPos,2_pInt)
|
||||
structorder = IO_intValue(line,chunkPos,2)
|
||||
case ('petsc_options')
|
||||
petsc_options = trim(line(chunkPos(4):))
|
||||
case ('bbarstabilisation')
|
||||
BBarStabilisation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
|
||||
BBarStabilisation = IO_intValue(line,chunkPos,2) > 0
|
||||
#endif
|
||||
end select
|
||||
enddo
|
||||
|
|
@ -334,7 +326,7 @@ subroutine numerics_init
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! Random seeding parameter
|
||||
write(6,'(a16,1x,i16,/)') ' random_seed: ',randomSeed
|
||||
if (randomSeed <= 0_pInt) &
|
||||
if (randomSeed <= 0) &
|
||||
write(6,'(a,/)') ' random seed will be generated!'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
@ -386,50 +378,50 @@ subroutine numerics_init
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! sanity checks
|
||||
if (defgradTolerance <= 0.0_pReal) call IO_error(301_pInt,ext_msg='defgradTolerance')
|
||||
if (iJacoStiffness < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoStiffness')
|
||||
if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate')
|
||||
if (subStepMinHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinHomog')
|
||||
if (subStepSizeHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeHomog')
|
||||
if (stepIncreaseHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseHomog')
|
||||
if (numerics_integrator <= 0_pInt .or. numerics_integrator >= 6_pInt) &
|
||||
call IO_error(301_pInt,ext_msg='integrator')
|
||||
if (numerics_unitlength <= 0.0_pReal) call IO_error(301_pInt,ext_msg='unitlength')
|
||||
if (absTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absTol_RGC')
|
||||
if (relTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relTol_RGC')
|
||||
if (absMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absMax_RGC')
|
||||
if (relMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relMax_RGC')
|
||||
if (pPert_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pPert_RGC')
|
||||
if (xSmoo_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='xSmoo_RGC')
|
||||
if (viscPower_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='viscPower_RGC')
|
||||
if (viscModus_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='viscModus_RGC')
|
||||
if (refRelaxRate_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='refRelaxRate_RGC')
|
||||
if (maxdRelax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxdRelax_RGC')
|
||||
if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxVolDiscr_RGC')
|
||||
if (volDiscrMod_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrMod_RGC')
|
||||
if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrPw_RGC')
|
||||
if (residualStiffness < 0.0_pReal) call IO_error(301_pInt,ext_msg='residualStiffness')
|
||||
if (itmax <= 1_pInt) call IO_error(301_pInt,ext_msg='itmax')
|
||||
if (itmin > itmax .or. itmin < 1_pInt) call IO_error(301_pInt,ext_msg='itmin')
|
||||
if (maxCutBack < 0_pInt) call IO_error(301_pInt,ext_msg='maxCutBack')
|
||||
if (stagItMax < 0_pInt) call IO_error(301_pInt,ext_msg='maxStaggeredIter')
|
||||
if (err_struct_tolRel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_struct_tolRel')
|
||||
if (err_struct_tolAbs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_struct_tolAbs')
|
||||
if (err_thermal_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_thermal_tolabs')
|
||||
if (err_thermal_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_thermal_tolrel')
|
||||
if (err_damage_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_damage_tolabs')
|
||||
if (err_damage_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_damage_tolrel')
|
||||
if (defgradTolerance <= 0.0_pReal) call IO_error(301,ext_msg='defgradTolerance')
|
||||
if (iJacoStiffness < 1) call IO_error(301,ext_msg='iJacoStiffness')
|
||||
if (nMPstate < 1) call IO_error(301,ext_msg='nMPstate')
|
||||
if (subStepMinHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinHomog')
|
||||
if (subStepSizeHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeHomog')
|
||||
if (stepIncreaseHomog <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseHomog')
|
||||
if (numerics_integrator <= 0 .or. numerics_integrator >= 6) &
|
||||
call IO_error(301,ext_msg='integrator')
|
||||
if (numerics_unitlength <= 0.0_pReal) call IO_error(301,ext_msg='unitlength')
|
||||
if (absTol_RGC <= 0.0_pReal) call IO_error(301,ext_msg='absTol_RGC')
|
||||
if (relTol_RGC <= 0.0_pReal) call IO_error(301,ext_msg='relTol_RGC')
|
||||
if (absMax_RGC <= 0.0_pReal) call IO_error(301,ext_msg='absMax_RGC')
|
||||
if (relMax_RGC <= 0.0_pReal) call IO_error(301,ext_msg='relMax_RGC')
|
||||
if (pPert_RGC <= 0.0_pReal) call IO_error(301,ext_msg='pPert_RGC')
|
||||
if (xSmoo_RGC <= 0.0_pReal) call IO_error(301,ext_msg='xSmoo_RGC')
|
||||
if (viscPower_RGC < 0.0_pReal) call IO_error(301,ext_msg='viscPower_RGC')
|
||||
if (viscModus_RGC < 0.0_pReal) call IO_error(301,ext_msg='viscModus_RGC')
|
||||
if (refRelaxRate_RGC <= 0.0_pReal) call IO_error(301,ext_msg='refRelaxRate_RGC')
|
||||
if (maxdRelax_RGC <= 0.0_pReal) call IO_error(301,ext_msg='maxdRelax_RGC')
|
||||
if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(301,ext_msg='maxVolDiscr_RGC')
|
||||
if (volDiscrMod_RGC < 0.0_pReal) call IO_error(301,ext_msg='volDiscrMod_RGC')
|
||||
if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301,ext_msg='volDiscrPw_RGC')
|
||||
if (residualStiffness < 0.0_pReal) call IO_error(301,ext_msg='residualStiffness')
|
||||
if (itmax <= 1) call IO_error(301,ext_msg='itmax')
|
||||
if (itmin > itmax .or. itmin < 1) call IO_error(301,ext_msg='itmin')
|
||||
if (maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack')
|
||||
if (stagItMax < 0) call IO_error(301,ext_msg='maxStaggeredIter')
|
||||
if (err_struct_tolRel <= 0.0_pReal) call IO_error(301,ext_msg='err_struct_tolRel')
|
||||
if (err_struct_tolAbs <= 0.0_pReal) call IO_error(301,ext_msg='err_struct_tolAbs')
|
||||
if (err_thermal_tolabs <= 0.0_pReal) call IO_error(301,ext_msg='err_thermal_tolabs')
|
||||
if (err_thermal_tolrel <= 0.0_pReal) call IO_error(301,ext_msg='err_thermal_tolrel')
|
||||
if (err_damage_tolabs <= 0.0_pReal) call IO_error(301,ext_msg='err_damage_tolabs')
|
||||
if (err_damage_tolrel <= 0.0_pReal) call IO_error(301,ext_msg='err_damage_tolrel')
|
||||
#ifdef Grid
|
||||
if (err_stress_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_stress_tolRel')
|
||||
if (err_stress_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_stress_tolAbs')
|
||||
if (err_div_tolRel < 0.0_pReal) call IO_error(301_pInt,ext_msg='err_div_tolRel')
|
||||
if (err_div_tolAbs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_div_tolAbs')
|
||||
if (err_curl_tolRel < 0.0_pReal) call IO_error(301_pInt,ext_msg='err_curl_tolRel')
|
||||
if (err_curl_tolAbs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_curl_tolAbs')
|
||||
if (err_stress_tolrel <= 0.0_pReal) call IO_error(301,ext_msg='err_stress_tolRel')
|
||||
if (err_stress_tolabs <= 0.0_pReal) call IO_error(301,ext_msg='err_stress_tolAbs')
|
||||
if (err_div_tolRel < 0.0_pReal) call IO_error(301,ext_msg='err_div_tolRel')
|
||||
if (err_div_tolAbs <= 0.0_pReal) call IO_error(301,ext_msg='err_div_tolAbs')
|
||||
if (err_curl_tolRel < 0.0_pReal) call IO_error(301,ext_msg='err_curl_tolRel')
|
||||
if (err_curl_tolAbs <= 0.0_pReal) call IO_error(301,ext_msg='err_curl_tolAbs')
|
||||
if (polarAlpha <= 0.0_pReal .or. &
|
||||
polarAlpha > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarAlpha')
|
||||
polarAlpha > 2.0_pReal) call IO_error(301,ext_msg='polarAlpha')
|
||||
if (polarBeta < 0.0_pReal .or. &
|
||||
polarBeta > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarBeta')
|
||||
polarBeta > 2.0_pReal) call IO_error(301,ext_msg='polarBeta')
|
||||
#endif
|
||||
|
||||
end subroutine numerics_init
|
||||
|
|
|
|||
|
|
@ -6,11 +6,18 @@
|
|||
!> @brief crystal plasticity model for bcc metals, especially Tungsten
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module plastic_disloUCLA
|
||||
use prec, only: &
|
||||
pReal
|
||||
use prec
|
||||
use debug
|
||||
use math
|
||||
use IO
|
||||
use material
|
||||
use config
|
||||
use lattice
|
||||
use results
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
integer, dimension(:,:), allocatable, target, public :: &
|
||||
plastic_disloUCLA_sizePostResult !< size of each post result output
|
||||
character(len=64), dimension(:,:), allocatable, target, public :: &
|
||||
|
|
@ -111,20 +118,6 @@ contains
|
|||
!> @details reads in material parameters, allocates arrays, and does sanity checks
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_disloUCLA_init()
|
||||
use prec, only: &
|
||||
pStringLen
|
||||
use debug, only: &
|
||||
debug_level,&
|
||||
debug_constitutive,&
|
||||
debug_levelBasic
|
||||
use math, only: &
|
||||
math_expand
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use material
|
||||
use config, only: &
|
||||
config_phase
|
||||
use lattice
|
||||
|
||||
integer :: &
|
||||
Ninstance, &
|
||||
|
|
@ -394,12 +387,6 @@ end subroutine plastic_disloUCLA_LpAndItsTangent
|
|||
!> @brief calculates the rate of change of microstructure
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_disloUCLA_dotState(Mp,T,instance,of)
|
||||
use prec, only: &
|
||||
tol_math_check, &
|
||||
dEq0
|
||||
use math, only: &
|
||||
PI, &
|
||||
math_clip
|
||||
|
||||
real(pReal), dimension(3,3), intent(in) :: &
|
||||
Mp !< Mandel stress
|
||||
|
|
@ -489,11 +476,6 @@ end subroutine plastic_disloUCLA_dependentState
|
|||
!> @brief return array of constitutive results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function plastic_disloUCLA_postResults(Mp,T,instance,of) result(postResults)
|
||||
use prec, only: &
|
||||
dEq, dNeq0
|
||||
use math, only: &
|
||||
PI, &
|
||||
math_mul33xx33
|
||||
|
||||
real(pReal), dimension(3,3), intent(in) :: &
|
||||
Mp !< Mandel stress
|
||||
|
|
@ -548,8 +530,6 @@ end function plastic_disloUCLA_postResults
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_disloUCLA_results(instance,group)
|
||||
#if defined(PETSc) || defined(DAMASK_HDF5)
|
||||
use results, only: &
|
||||
results_writeDataset
|
||||
|
||||
integer, intent(in) :: instance
|
||||
character(len=*), intent(in) :: group
|
||||
|
|
@ -595,12 +575,6 @@ end subroutine plastic_disloUCLA_results
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
pure subroutine kinetics(Mp,T,instance,of, &
|
||||
dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg,tau_pos_out,tau_neg_out)
|
||||
use prec, only: &
|
||||
tol_math_check, &
|
||||
dEq, dNeq0
|
||||
use math, only: &
|
||||
PI, &
|
||||
math_mul33xx33
|
||||
|
||||
real(pReal), dimension(3,3), intent(in) :: &
|
||||
Mp !< Mandel stress
|
||||
|
|
|
|||
|
|
@ -7,12 +7,22 @@
|
|||
module plastic_nonlocal
|
||||
use prec
|
||||
use future
|
||||
use IO
|
||||
use math
|
||||
use debug
|
||||
use mesh
|
||||
use material
|
||||
use lattice
|
||||
use rotations
|
||||
use config
|
||||
use lattice
|
||||
use discretization
|
||||
use geometry_plastic_nonlocal, only: &
|
||||
periodicSurface => geometry_plastic_nonlocal_periodicSurface, &
|
||||
nIPneighbors => geometry_plastic_nonlocal_nIPneighbors, &
|
||||
IPneighborhood => geometry_plastic_nonlocal_IPneighborhood, &
|
||||
IPvolume => geometry_plastic_nonlocal_IPvolume, &
|
||||
IParea => geometry_plastic_nonlocal_IParea, &
|
||||
IPareaNormal => geometry_plastic_nonlocal_IPareaNormal
|
||||
IPvolume => geometry_plastic_nonlocal_IPvolume0, &
|
||||
IParea => geometry_plastic_nonlocal_IParea0, &
|
||||
IPareaNormal => geometry_plastic_nonlocal_IPareaNormal0
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
|
@ -241,21 +251,6 @@ contains
|
|||
!> @details reads in material parameters, allocates arrays, and does sanity checks
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_nonlocal_init
|
||||
use prec, only: &
|
||||
dEq0, dNeq0, dEq
|
||||
use math, only: &
|
||||
math_expand, math_cross
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_constitutive, &
|
||||
debug_levelBasic
|
||||
use mesh, only: &
|
||||
theMesh
|
||||
use material
|
||||
use config
|
||||
use lattice
|
||||
|
||||
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
|
||||
integer, dimension(0), parameter :: emptyIntArray = [integer::]
|
||||
|
|
@ -291,7 +286,6 @@ subroutine plastic_nonlocal_init
|
|||
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
|
||||
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances
|
||||
|
||||
|
||||
allocate(param(maxNinstances))
|
||||
allocate(state(maxNinstances))
|
||||
allocate(dotState(maxNinstances))
|
||||
|
|
@ -672,8 +666,8 @@ subroutine plastic_nonlocal_init
|
|||
|
||||
enddo
|
||||
|
||||
allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), &
|
||||
source=0.0_pReal)
|
||||
allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),nIPneighbors,&
|
||||
discretization_nIP,discretization_nElem), source=0.0_pReal)
|
||||
|
||||
! BEGIN DEPRECATED----------------------------------------------------------------------------------
|
||||
allocate(iRhoU(maxval(totalNslip),4,maxNinstances), source=0)
|
||||
|
|
@ -738,15 +732,6 @@ subroutine plastic_nonlocal_init
|
|||
!> @brief populates the initial dislocation density
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine stateInit(phase,NofMyPhase)
|
||||
use math, only: &
|
||||
math_sampleGaussVar
|
||||
use mesh, only: &
|
||||
theMesh, &
|
||||
mesh_ipVolume
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
phase_plasticityInstance, &
|
||||
phasememberAt
|
||||
|
||||
integer,intent(in) ::&
|
||||
phase, &
|
||||
|
|
@ -779,9 +764,9 @@ subroutine plastic_nonlocal_init
|
|||
if (prm%rhoSglRandom > 0.0_pReal) then
|
||||
|
||||
! get the total volume of the instance
|
||||
do e = 1,theMesh%nElems
|
||||
do i = 1,theMesh%elem%nIPs
|
||||
if (material_phase(1,i,e) == phase) volume(phasememberAt(1,i,e)) = mesh_ipVolume(i,e)
|
||||
do e = 1,discretization_nElem
|
||||
do i = 1,discretization_nIP
|
||||
if (material_phase(1,i,e) == phase) volume(phasememberAt(1,i,e)) = IPvolume(i,e)
|
||||
enddo
|
||||
enddo
|
||||
totalVolume = sum(volume)
|
||||
|
|
@ -828,39 +813,6 @@ end subroutine plastic_nonlocal_init
|
|||
!> @brief calculates quantities characterizing the microstructure
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
|
||||
use prec, only: &
|
||||
dEq0
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use math, only: &
|
||||
PI, &
|
||||
math_inner, &
|
||||
math_inv33
|
||||
#ifdef DEBUG
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_constitutive, &
|
||||
debug_levelExtensive, &
|
||||
debug_levelSelective, &
|
||||
debug_i, &
|
||||
debug_e
|
||||
#endif
|
||||
use mesh, only: &
|
||||
theMesh, &
|
||||
mesh_ipNeighborhood, &
|
||||
mesh_ipCoordinates, &
|
||||
mesh_ipVolume, &
|
||||
mesh_ipAreaNormal, &
|
||||
mesh_ipArea
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
phase_localPlasticity, &
|
||||
phaseAt, phasememberAt, &
|
||||
phase_plasticityInstance
|
||||
use lattice, only: &
|
||||
LATTICE_bcc_ID, &
|
||||
LATTICE_fcc_ID, &
|
||||
lattice_structure
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, &
|
||||
|
|
@ -900,7 +852,7 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
|
|||
invFp, & !< inverse of plastic deformation gradient
|
||||
connections, &
|
||||
invConnections
|
||||
real(pReal), dimension(3,theMesh%elem%nIPneighbors) :: &
|
||||
real(pReal), dimension(3,nIPneighbors) :: &
|
||||
connection_latticeConf
|
||||
real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: &
|
||||
rhoExcess
|
||||
|
|
@ -914,10 +866,10 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
|
|||
totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: &
|
||||
myInteractionMatrix ! corrected slip interaction matrix
|
||||
|
||||
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),theMesh%elem%nIPneighbors) :: &
|
||||
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),nIPneighbors) :: &
|
||||
rho_edg_delta_neighbor, &
|
||||
rho_scr_delta_neighbor
|
||||
real(pReal), dimension(2,maxval(totalNslip),theMesh%elem%nIPneighbors) :: &
|
||||
real(pReal), dimension(2,maxval(totalNslip),nIPneighbors) :: &
|
||||
neighbor_rhoExcess, & ! excess density at neighboring material point
|
||||
neighbor_rhoTotal ! total density at neighboring material point
|
||||
real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,ip,el))),2) :: &
|
||||
|
|
@ -974,15 +926,15 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
|
|||
rhoExcess(1,1:ns) = rho_edg_delta
|
||||
rhoExcess(2,1:ns) = rho_scr_delta
|
||||
|
||||
FVsize = mesh_ipVolume(ip,el) ** (1.0_pReal/3.0_pReal)
|
||||
FVsize = IPvolume(ip,el) ** (1.0_pReal/3.0_pReal)
|
||||
|
||||
!* loop through my neighborhood and get the connection vectors (in lattice frame) and the excess densities
|
||||
|
||||
nRealNeighbors = 0.0_pReal
|
||||
neighbor_rhoTotal = 0.0_pReal
|
||||
do n = 1,theMesh%elem%nIPneighbors
|
||||
neighbor_el = mesh_ipNeighborhood(1,n,ip,el)
|
||||
neighbor_ip = mesh_ipNeighborhood(2,n,ip,el)
|
||||
do n = 1,nIPneighbors
|
||||
neighbor_el = IPneighborhood(1,n,ip,el)
|
||||
neighbor_ip = IPneighborhood(2,n,ip,el)
|
||||
no = phasememberAt(1,neighbor_ip,neighbor_el)
|
||||
if (neighbor_el > 0 .and. neighbor_ip > 0) then
|
||||
neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el))
|
||||
|
|
@ -1000,9 +952,9 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
|
|||
connection_latticeConf(1:3,n) = &
|
||||
matmul(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) &
|
||||
- mesh_ipCoordinates(1:3,ip,el))
|
||||
normal_latticeConf = matmul(transpose(invFp), mesh_ipAreaNormal(1:3,n,ip,el))
|
||||
normal_latticeConf = matmul(transpose(invFp), IPareaNormal(1:3,n,ip,el))
|
||||
if (math_inner(normal_latticeConf,connection_latticeConf(1:3,n)) < 0.0_pReal) & ! neighboring connection points in opposite direction to face normal: must be periodic image
|
||||
connection_latticeConf(1:3,n) = normal_latticeConf * mesh_ipVolume(ip,el)/mesh_ipArea(n,ip,el) ! instead take the surface normal scaled with the diameter of the cell
|
||||
connection_latticeConf(1:3,n) = normal_latticeConf * IPvolume(ip,el)/IParea(n,ip,el) ! instead take the surface normal scaled with the diameter of the cell
|
||||
else
|
||||
! local neighbor or different lattice structure or different constitution instance -> use central values instead
|
||||
connection_latticeConf(1:3,n) = 0.0_pReal
|
||||
|
|
@ -1224,13 +1176,6 @@ end subroutine plastic_nonlocal_kinetics
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, &
|
||||
Mp, Temperature, volume, ip, el)
|
||||
use math, only: &
|
||||
math_mul33xx33
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
plasticState, &
|
||||
phaseAt, phasememberAt, &
|
||||
phase_plasticityInstance
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, & !< current integration point
|
||||
|
|
@ -1363,26 +1308,6 @@ end subroutine plastic_nonlocal_LpAndItsTangent
|
|||
!> @brief (instantaneous) incremental change of microstructure
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_nonlocal_deltaState(Mp,ip,el)
|
||||
use prec, only: &
|
||||
dNeq0
|
||||
#ifdef DEBUG
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_constitutive, &
|
||||
debug_levelBasic, &
|
||||
debug_levelExtensive, &
|
||||
debug_levelSelective, &
|
||||
debug_i, &
|
||||
debug_e
|
||||
#endif
|
||||
use math, only: &
|
||||
PI, &
|
||||
math_mul33xx33
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
plasticState, &
|
||||
phaseAt, phasememberAt, &
|
||||
phase_plasticityInstance
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, &
|
||||
|
|
@ -1500,49 +1425,6 @@ end subroutine plastic_nonlocal_deltaState
|
|||
!---------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
||||
timestep,ip,el)
|
||||
use, intrinsic :: &
|
||||
IEEE_arithmetic
|
||||
use prec, only: &
|
||||
dNeq0, &
|
||||
dNeq, &
|
||||
dEq0
|
||||
use IO, only: &
|
||||
IO_error
|
||||
#ifdef DEBUG
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_constitutive, &
|
||||
debug_levelBasic, &
|
||||
debug_levelExtensive, &
|
||||
debug_levelSelective, &
|
||||
debug_i, &
|
||||
debug_e
|
||||
#endif
|
||||
use math, only: &
|
||||
math_inner, &
|
||||
math_mul33xx33, &
|
||||
math_inv33, &
|
||||
math_det33, &
|
||||
PI
|
||||
use mesh, only: &
|
||||
theMesh, &
|
||||
mesh_ipNeighborhood, &
|
||||
mesh_ipVolume, &
|
||||
mesh_ipArea, &
|
||||
mesh_ipAreaNormal
|
||||
use material, only: &
|
||||
homogenization_maxNgrains, &
|
||||
material_phase, &
|
||||
phase_plasticityInstance, &
|
||||
phase_localPlasticity, &
|
||||
plasticState, &
|
||||
phaseAt, phasememberAt, &
|
||||
phase_plasticity ,&
|
||||
PLASTICITY_NONLOCAL_ID
|
||||
use lattice, only: &
|
||||
lattice_structure, &
|
||||
LATTICE_bcc_ID, &
|
||||
LATTICE_fcc_ID
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, & !< current integration point
|
||||
|
|
@ -1552,7 +1434,7 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
|||
timestep !< substepped crystallite time increment
|
||||
real(pReal), dimension(3,3), intent(in) ::&
|
||||
Mp !< MandelStress
|
||||
real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: &
|
||||
real(pReal), dimension(3,3,homogenization_maxNgrains,discretization_nIP,discretization_nElem), intent(in) :: &
|
||||
Fe, & !< elastic deformation gradient
|
||||
Fp !< plastic deformation gradient
|
||||
|
||||
|
|
@ -1715,14 +1597,14 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
|||
!*** check CFL (Courant-Friedrichs-Lewy) condition for flux
|
||||
if (any( abs(gdot) > 0.0_pReal & ! any active slip system ...
|
||||
.and. prm%CFLfactor * abs(v) * timestep &
|
||||
> mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here)
|
||||
> IPvolume(ip,el) / maxval(IParea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here)
|
||||
#ifdef DEBUG
|
||||
if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) 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(v), abs(gdot) > 0.0_pReal &
|
||||
.and. prm%CFLfactor * abs(v) * timestep &
|
||||
> mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el))), &
|
||||
> IPvolume(ip,el) / maxval(IParea(:,ip,el))), &
|
||||
' at a timestep of ',timestep
|
||||
write(6,'(a)') '<< CONST >> enforcing cutback !!!'
|
||||
endif
|
||||
|
|
@ -1743,18 +1625,18 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
|||
my_Fe = Fe(1:3,1:3,1,ip,el)
|
||||
my_F = matmul(my_Fe, Fp(1:3,1:3,1,ip,el))
|
||||
|
||||
neighbors: do n = 1,theMesh%elem%nIPneighbors
|
||||
neighbors: do n = 1,nIPneighbors
|
||||
|
||||
neighbor_el = mesh_ipNeighborhood(1,n,ip,el)
|
||||
neighbor_ip = mesh_ipNeighborhood(2,n,ip,el)
|
||||
neighbor_n = mesh_ipNeighborhood(3,n,ip,el)
|
||||
neighbor_el = IPneighborhood(1,n,ip,el)
|
||||
neighbor_ip = IPneighborhood(2,n,ip,el)
|
||||
neighbor_n = IPneighborhood(3,n,ip,el)
|
||||
np = phaseAt(1,neighbor_ip,neighbor_el)
|
||||
no = phasememberAt(1,neighbor_ip,neighbor_el)
|
||||
|
||||
opposite_neighbor = n + mod(n,2) - mod(n+1,2)
|
||||
opposite_el = mesh_ipNeighborhood(1,opposite_neighbor,ip,el)
|
||||
opposite_ip = mesh_ipNeighborhood(2,opposite_neighbor,ip,el)
|
||||
opposite_n = mesh_ipNeighborhood(3,opposite_neighbor,ip,el)
|
||||
opposite_el = IPneighborhood(1,opposite_neighbor,ip,el)
|
||||
opposite_ip = IPneighborhood(2,opposite_neighbor,ip,el)
|
||||
opposite_n = IPneighborhood(3,opposite_neighbor,ip,el)
|
||||
|
||||
if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient
|
||||
neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el))
|
||||
|
|
@ -1791,30 +1673,30 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
|||
0.0_pReal)
|
||||
endforall
|
||||
|
||||
where (neighbor_rhoSgl * mesh_ipVolume(neighbor_ip,neighbor_el) ** 0.667_pReal < prm%significantN &
|
||||
where (neighbor_rhoSgl * IPvolume(neighbor_ip,neighbor_el) ** 0.667_pReal < prm%significantN &
|
||||
.or. neighbor_rhoSgl < prm%significantRho) &
|
||||
neighbor_rhoSgl = 0.0_pReal
|
||||
normal_neighbor2me_defConf = math_det33(Favg) * matmul(math_inv33(transpose(Favg)), &
|
||||
mesh_ipAreaNormal(1:3,neighbor_n,neighbor_ip,neighbor_el)) ! calculate the normal of the interface in (average) deformed configuration (now pointing from my neighbor to me!!!)
|
||||
IPareaNormal(1:3,neighbor_n,neighbor_ip,neighbor_el)) ! calculate the normal of the interface in (average) deformed configuration (now pointing from my neighbor to me!!!)
|
||||
normal_neighbor2me = matmul(transpose(neighbor_Fe), normal_neighbor2me_defConf) &
|
||||
/ math_det33(neighbor_Fe) ! interface normal in the lattice configuration of my neighbor
|
||||
area = mesh_ipArea(neighbor_n,neighbor_ip,neighbor_el) * norm2(normal_neighbor2me)
|
||||
area = IParea(neighbor_n,neighbor_ip,neighbor_el) * norm2(normal_neighbor2me)
|
||||
normal_neighbor2me = normal_neighbor2me / norm2(normal_neighbor2me) ! normalize the surface normal to unit length
|
||||
do s = 1,ns
|
||||
do t = 1,4
|
||||
c = (t + 1) / 2
|
||||
topp = t + mod(t,2) - mod(t+1,2)
|
||||
if (neighbor_v(s,t) * math_inner(m(1:3,s,t), normal_neighbor2me) > 0.0_pReal & ! flux from my neighbor to me == entering flux for me
|
||||
if (neighbor_v(s,t) * math_inner(m(1:3,s,t), normal_neighbor2me) > 0.0_pReal & ! flux from my neighbor to me == entering flux for me
|
||||
.and. v(s,t) * neighbor_v(s,t) >= 0.0_pReal ) then ! ... only if no sign change in flux density
|
||||
lineLength = neighbor_rhoSgl(s,t) * neighbor_v(s,t) &
|
||||
* math_inner(m(1:3,s,t), normal_neighbor2me) * area ! positive line length that wants to enter through this interface
|
||||
* math_inner(m(1:3,s,t), normal_neighbor2me) * area ! positive line length that wants to enter through this interface
|
||||
where (compatibility(c,1:ns,s,n,ip,el) > 0.0_pReal) & ! positive compatibility...
|
||||
rhoDotFlux(1:ns,t) = rhoDotFlux(1:ns,t) &
|
||||
+ lineLength / mesh_ipVolume(ip,el) & ! ... transferring to equally signed mobile dislocation type
|
||||
+ lineLength / IPvolume(ip,el) & ! ... transferring to equally signed mobile dislocation type
|
||||
* compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal
|
||||
where (compatibility(c,1:ns,s,n,ip,el) < 0.0_pReal) & ! ..negative compatibility...
|
||||
rhoDotFlux(1:ns,topp) = rhoDotFlux(1:ns,topp) &
|
||||
+ lineLength / mesh_ipVolume(ip,el) & ! ... transferring to opposite signed mobile dislocation type
|
||||
+ lineLength / IPvolume(ip,el) & ! ... transferring to opposite signed mobile dislocation type
|
||||
* compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal
|
||||
endif
|
||||
enddo
|
||||
|
|
@ -1842,15 +1724,15 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
|||
|
||||
normal_me2neighbor_defConf = math_det33(Favg) &
|
||||
* matmul(math_inv33(transpose(Favg)), &
|
||||
mesh_ipAreaNormal(1:3,n,ip,el)) ! calculate the normal of the interface in (average) deformed configuration (pointing from me to my neighbor!!!)
|
||||
IPareaNormal(1:3,n,ip,el)) ! calculate the normal of the interface in (average) deformed configuration (pointing from me to my neighbor!!!)
|
||||
normal_me2neighbor = matmul(transpose(my_Fe), normal_me2neighbor_defConf) &
|
||||
/ math_det33(my_Fe) ! interface normal in my lattice configuration
|
||||
area = mesh_ipArea(n,ip,el) * norm2(normal_me2neighbor)
|
||||
area = IParea(n,ip,el) * norm2(normal_me2neighbor)
|
||||
normal_me2neighbor = normal_me2neighbor / norm2(normal_me2neighbor) ! normalize the surface normal to unit length
|
||||
do s = 1,ns
|
||||
do t = 1,4
|
||||
c = (t + 1) / 2
|
||||
if (my_v(s,t) * math_inner(m(1:3,s,t), normal_me2neighbor) > 0.0_pReal ) then ! flux from me to my neighbor == leaving flux for me (might also be a pure flux from my mobile density to dead density if interface not at all transmissive)
|
||||
if (my_v(s,t) * math_inner(m(1:3,s,t), normal_me2neighbor) > 0.0_pReal ) then ! flux from me to my neighbor == leaving flux for me (might also be a pure flux from my mobile density to dead density if interface not at all transmissive)
|
||||
if (my_v(s,t) * neighbor_v(s,t) >= 0.0_pReal) then ! no sign change in flux density
|
||||
transmissivity = sum(compatibility(c,1:ns,s,n,ip,el)**2.0_pReal) ! overall transmissivity from this slip system to my neighbor
|
||||
else ! sign change in flux density means sign change in stress which does not allow for dislocations to arive at the neighbor
|
||||
|
|
@ -1858,9 +1740,9 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
|||
endif
|
||||
lineLength = my_rhoSgl(s,t) * my_v(s,t) &
|
||||
* math_inner(m(1:3,s,t), normal_me2neighbor) * area ! positive line length of mobiles that wants to leave through this interface
|
||||
rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / mesh_ipVolume(ip,el) ! subtract dislocation flux from current type
|
||||
rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / IPvolume(ip,el) ! subtract dislocation flux from current type
|
||||
rhoDotFlux(s,t+4) = rhoDotFlux(s,t+4) &
|
||||
+ lineLength / mesh_ipVolume(ip,el) * (1.0_pReal - transmissivity) &
|
||||
+ lineLength / IPvolume(ip,el) * (1.0_pReal - transmissivity) &
|
||||
* sign(1.0_pReal, my_v(s,t)) ! dislocation flux that is not able to leave through interface (because of low transmissivity) will remain as immobile single density at the material point
|
||||
endif
|
||||
enddo
|
||||
|
|
@ -1938,12 +1820,12 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
|
|||
+ rhoDotAthermalAnnihilation &
|
||||
+ rhoDotThermalAnnihilation
|
||||
|
||||
results(instance)%rhoDotFlux(1:ns,1:8,o) = rhoDotFlux(1:ns,1:8)
|
||||
results(instance)%rhoDotMultiplication(1:ns,1:2,o) = rhoDotMultiplication(1:ns,[1,3])
|
||||
results(instance)%rhoDotSingle2DipoleGlide(1:ns,1:2,o) = rhoDotSingle2DipoleGlide(1:ns,9:10)
|
||||
results(instance)%rhoDotFlux(1:ns,1:8,o) = rhoDotFlux(1:ns,1:8)
|
||||
results(instance)%rhoDotMultiplication(1:ns,1:2,o) = rhoDotMultiplication(1:ns,[1,3])
|
||||
results(instance)%rhoDotSingle2DipoleGlide(1:ns,1:2,o) = rhoDotSingle2DipoleGlide(1:ns,9:10)
|
||||
results(instance)%rhoDotAthermalAnnihilation(1:ns,1:2,o) = rhoDotAthermalAnnihilation(1:ns,9:10)
|
||||
results(instance)%rhoDotThermalAnnihilation(1:ns,1:2,o) = rhoDotThermalAnnihilation(1:ns,9:10)
|
||||
results(instance)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1)
|
||||
results(instance)%rhoDotThermalAnnihilation(1:ns,1:2,o) = rhoDotThermalAnnihilation(1:ns,9:10)
|
||||
results(instance)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1)
|
||||
|
||||
|
||||
#ifdef DEBUG
|
||||
|
|
@ -2001,26 +1883,11 @@ end subroutine plastic_nonlocal_dotState
|
|||
! that sum up to a total of 1 are considered, all others are set to zero.
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
|
||||
use math, only: &
|
||||
math_inner, &
|
||||
math_qRot
|
||||
use rotations, only: &
|
||||
rotation
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
material_texture, &
|
||||
phase_localPlasticity, &
|
||||
phase_plasticityInstance
|
||||
use mesh, only: &
|
||||
mesh_ipNeighborhood, &
|
||||
theMesh
|
||||
use lattice, only: &
|
||||
lattice_qDisorientation
|
||||
|
||||
integer, intent(in) :: &
|
||||
i, &
|
||||
e
|
||||
type(rotation), dimension(1,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: &
|
||||
type(rotation), dimension(1,discretization_nIP,discretization_nElem), intent(in) :: &
|
||||
orientation ! crystal orientation in quaternions
|
||||
|
||||
integer :: &
|
||||
|
|
@ -2040,7 +1907,7 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
|
|||
absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor
|
||||
real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),&
|
||||
totalNslip(phase_plasticityInstance(material_phase(1,i,e))),&
|
||||
theMesh%elem%nIPneighbors) :: &
|
||||
nIPneighbors) :: &
|
||||
my_compatibility ! my_compatibility for current element and ip
|
||||
real(pReal) :: &
|
||||
my_compatibilitySum, &
|
||||
|
|
@ -2050,7 +1917,7 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
|
|||
belowThreshold
|
||||
type(rotation) :: rot
|
||||
|
||||
Nneighbors = theMesh%elem%nIPneighbors
|
||||
Nneighbors = nIPneighbors
|
||||
ph = material_phase(1,i,e)
|
||||
textureID = material_texture(1,i,e)
|
||||
instance = phase_plasticityInstance(ph)
|
||||
|
|
@ -2065,8 +1932,8 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
|
|||
!*** Loop thrugh neighbors and check whether there is any compatibility.
|
||||
|
||||
neighbors: do n = 1,Nneighbors
|
||||
neighbor_e = mesh_ipNeighborhood(1,n,i,e)
|
||||
neighbor_i = mesh_ipNeighborhood(2,n,i,e)
|
||||
neighbor_e = IPneighborhood(1,n,i,e)
|
||||
neighbor_i = IPneighborhood(2,n,i,e)
|
||||
|
||||
|
||||
!* FREE SURFACE
|
||||
|
|
@ -2159,10 +2026,6 @@ end subroutine plastic_nonlocal_updateCompatibility
|
|||
!> @brief return array of constitutive results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function plastic_nonlocal_postResults(ph,instance,of) result(postResults)
|
||||
use prec, only: &
|
||||
dNeq0
|
||||
use material, only: &
|
||||
plasticState
|
||||
|
||||
integer, intent(in) :: &
|
||||
ph, &
|
||||
|
|
@ -2364,7 +2227,6 @@ end function plastic_nonlocal_postResults
|
|||
!> @details raw values is rectified
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function getRho(instance,of,ip,el)
|
||||
use mesh
|
||||
|
||||
integer, intent(in) :: instance, of,ip,el
|
||||
real(pReal), dimension(param(instance)%totalNslip,10) :: getRho
|
||||
|
|
@ -2377,7 +2239,7 @@ function getRho(instance,of,ip,el)
|
|||
getRho(:,mob) = max(getRho(:,mob),0.0_pReal)
|
||||
getRho(:,dip) = max(getRho(:,dip),0.0_pReal)
|
||||
|
||||
where(abs(getRho) < max(prm%significantN/mesh_ipVolume(ip,el)**(2.0_pReal/3.0_pReal),prm%significantRho)) &
|
||||
where(abs(getRho) < max(prm%significantN/IPvolume(ip,el)**(2.0_pReal/3.0_pReal),prm%significantRho)) &
|
||||
getRho = 0.0_pReal
|
||||
|
||||
end associate
|
||||
|
|
|
|||
|
|
@ -15,6 +15,8 @@ module results
|
|||
|
||||
implicit none
|
||||
private
|
||||
|
||||
#if defined(PETSc) || defined(DAMASK_HDF5)
|
||||
integer(HID_T), public, protected :: tempCoordinates, tempResults
|
||||
integer(HID_T), private :: resultsFile, currentIncID, plist_id
|
||||
|
||||
|
|
@ -105,7 +107,7 @@ end subroutine results_closeJobFile
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine results_addIncrement(inc,time)
|
||||
|
||||
integer(pInt), intent(in) :: inc
|
||||
integer, intent(in) :: inc
|
||||
real(pReal), intent(in) :: time
|
||||
character(len=pStringLen) :: incChar
|
||||
|
||||
|
|
@ -951,5 +953,5 @@ end subroutine results_mapping_materialpoint
|
|||
|
||||
!end subroutine HDF5_mappingCells
|
||||
|
||||
|
||||
#endif
|
||||
end module results
|
||||
|
|
|
|||
|
|
@ -65,6 +65,7 @@ module rotations
|
|||
procedure, public :: asRotationMatrix
|
||||
!------------------------------------------
|
||||
procedure, public :: fromRotationMatrix
|
||||
procedure, public :: fromEulerAngles
|
||||
!------------------------------------------
|
||||
procedure, public :: rotVector
|
||||
procedure, public :: rotTensor
|
||||
|
|
@ -143,7 +144,16 @@ subroutine fromRotationMatrix(self,om)
|
|||
self%q = om2qu(om)
|
||||
|
||||
end subroutine
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
subroutine fromEulerAngles(self,eu)
|
||||
|
||||
class(rotation), intent(out) :: self
|
||||
real(pReal), dimension(3), intent(in) :: eu
|
||||
|
||||
self%q = eu2qu(eu)
|
||||
|
||||
end subroutine
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> @author Marc De Graef, Carnegie Mellon University
|
||||
|
|
|
|||
|
|
@ -6,9 +6,15 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
module source_damage_anisoDuctile
|
||||
use prec
|
||||
use debug
|
||||
use IO
|
||||
use math
|
||||
use material
|
||||
use config
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
integer, dimension(:), allocatable, public, protected :: &
|
||||
source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism?
|
||||
source_damage_anisoDuctile_instance !< instance of damage source mechanism
|
||||
|
|
@ -57,26 +63,6 @@ contains
|
|||
!> @details reads in material parameters, allocates arrays, and does sanity checks
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine source_damage_anisoDuctile_init
|
||||
use debug, only: &
|
||||
debug_level,&
|
||||
debug_constitutive,&
|
||||
debug_levelBasic
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use math, only: &
|
||||
math_expand
|
||||
use material, only: &
|
||||
material_allocateSourceState, &
|
||||
phase_source, &
|
||||
phase_Nsources, &
|
||||
phase_Noutput, &
|
||||
SOURCE_damage_anisoDuctile_label, &
|
||||
SOURCE_damage_anisoDuctile_ID, &
|
||||
material_phase, &
|
||||
sourceState
|
||||
use config, only: &
|
||||
config_phase
|
||||
|
||||
|
||||
integer :: Ninstance,phase,instance,source,sourceOffset
|
||||
integer :: NofMyPhase,p ,i
|
||||
|
|
@ -181,13 +167,6 @@ end subroutine source_damage_anisoDuctile_init
|
|||
!> @brief calculates derived quantities from state
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine source_damage_anisoDuctile_dotState(ipc, ip, el)
|
||||
use material, only: &
|
||||
phaseAt, phasememberAt, &
|
||||
plasticState, &
|
||||
sourceState, &
|
||||
material_homogenizationAt, &
|
||||
damage, &
|
||||
damageMapping
|
||||
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
|
|
@ -222,8 +201,6 @@ end subroutine source_damage_anisoDuctile_dotState
|
|||
!> @brief returns local part of nonlocal damage driving force
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
|
||||
use material, only: &
|
||||
sourceState
|
||||
|
||||
integer, intent(in) :: &
|
||||
phase, &
|
||||
|
|
@ -249,8 +226,6 @@ end subroutine source_damage_anisoDuctile_getRateAndItsTangent
|
|||
!> @brief return array of local damage results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function source_damage_anisoDuctile_postResults(phase, constituent)
|
||||
use material, only: &
|
||||
sourceState
|
||||
|
||||
integer, intent(in) :: &
|
||||
phase, &
|
||||
|
|
|
|||
|
|
@ -5,43 +5,47 @@
|
|||
!> @details to be done
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module source_damage_isoBrittle
|
||||
use prec
|
||||
use prec
|
||||
use debug
|
||||
use IO
|
||||
use math
|
||||
use material
|
||||
use config
|
||||
|
||||
implicit none
|
||||
private
|
||||
integer, dimension(:), allocatable, public, protected :: &
|
||||
source_damage_isoBrittle_offset, & !< which source is my current damage mechanism?
|
||||
source_damage_isoBrittle_instance !< instance of damage source mechanism
|
||||
implicit none
|
||||
private
|
||||
integer, dimension(:), allocatable, public, protected :: &
|
||||
source_damage_isoBrittle_offset, &
|
||||
source_damage_isoBrittle_instance
|
||||
integer, dimension(:,:), allocatable, target, public :: &
|
||||
source_damage_isoBrittle_sizePostResult
|
||||
character(len=64), dimension(:,:), allocatable, target, public :: &
|
||||
source_damage_isoBrittle_output
|
||||
|
||||
integer, dimension(:,:), allocatable, target, public :: &
|
||||
source_damage_isoBrittle_sizePostResult !< size of each post result output
|
||||
|
||||
character(len=64), dimension(:,:), allocatable, target, public :: &
|
||||
source_damage_isoBrittle_output !< name of each post result output
|
||||
|
||||
enum, bind(c)
|
||||
enumerator :: undefined_ID, &
|
||||
damage_drivingforce_ID
|
||||
end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo
|
||||
enum, bind(c)
|
||||
enumerator :: &
|
||||
undefined_ID, &
|
||||
damage_drivingforce_ID
|
||||
end enum
|
||||
|
||||
|
||||
type, private :: tParameters !< container type for internal constitutive parameters
|
||||
real(pReal) :: &
|
||||
critStrainEnergy, &
|
||||
N, &
|
||||
aTol
|
||||
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
|
||||
outputID
|
||||
end type tParameters
|
||||
type, private :: tParameters !< container type for internal constitutive parameters
|
||||
real(pReal) :: &
|
||||
critStrainEnergy, &
|
||||
N, &
|
||||
aTol
|
||||
integer(kind(undefined_ID)), allocatable, dimension(:) :: &
|
||||
outputID
|
||||
end type tParameters
|
||||
|
||||
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
|
||||
type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance)
|
||||
|
||||
|
||||
public :: &
|
||||
source_damage_isoBrittle_init, &
|
||||
source_damage_isoBrittle_deltaState, &
|
||||
source_damage_isoBrittle_getRateAndItsTangent, &
|
||||
source_damage_isoBrittle_postResults
|
||||
public :: &
|
||||
source_damage_isoBrittle_init, &
|
||||
source_damage_isoBrittle_deltaState, &
|
||||
source_damage_isoBrittle_getRateAndItsTangent, &
|
||||
source_damage_isoBrittle_postResults
|
||||
|
||||
contains
|
||||
|
||||
|
|
@ -51,112 +55,93 @@ contains
|
|||
!> @details reads in material parameters, allocates arrays, and does sanity checks
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine source_damage_isoBrittle_init
|
||||
use debug, only: &
|
||||
debug_level,&
|
||||
debug_constitutive,&
|
||||
debug_levelBasic
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use material, only: &
|
||||
material_allocateSourceState, &
|
||||
phase_source, &
|
||||
phase_Nsources, &
|
||||
phase_Noutput, &
|
||||
SOURCE_damage_isoBrittle_label, &
|
||||
SOURCE_damage_isoBrittle_ID, &
|
||||
material_phase, &
|
||||
sourceState
|
||||
use config, only: &
|
||||
config_phase, &
|
||||
material_Nphase
|
||||
|
||||
|
||||
integer :: Ninstance,phase,instance,source,sourceOffset
|
||||
integer :: NofMyPhase,p,i
|
||||
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
|
||||
integer(kind(undefined_ID)) :: &
|
||||
outputID
|
||||
|
||||
character(len=pStringLen) :: &
|
||||
extmsg = ''
|
||||
character(len=65536), dimension(:), allocatable :: &
|
||||
outputs
|
||||
integer :: Ninstance,phase,instance,source,sourceOffset
|
||||
integer :: NofMyPhase,p,i
|
||||
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
|
||||
integer(kind(undefined_ID)) :: &
|
||||
outputID
|
||||
|
||||
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>'
|
||||
|
||||
Ninstance = count(phase_source == SOURCE_damage_isoBrittle_ID)
|
||||
if (Ninstance == 0) return
|
||||
character(len=pStringLen) :: &
|
||||
extmsg = ''
|
||||
character(len=65536), dimension(:), allocatable :: &
|
||||
outputs
|
||||
|
||||
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>'
|
||||
|
||||
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
|
||||
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
|
||||
Ninstance = count(phase_source == SOURCE_damage_isoBrittle_ID)
|
||||
if (Ninstance == 0) return
|
||||
|
||||
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
|
||||
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
|
||||
|
||||
allocate(source_damage_isoBrittle_offset(material_Nphase), source=0)
|
||||
allocate(source_damage_isoBrittle_instance(material_Nphase), source=0)
|
||||
do phase = 1, material_Nphase
|
||||
source_damage_isoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoBrittle_ID)
|
||||
do source = 1, phase_Nsources(phase)
|
||||
if (phase_source(source,phase) == source_damage_isoBrittle_ID) &
|
||||
source_damage_isoBrittle_offset(phase) = source
|
||||
enddo
|
||||
enddo
|
||||
|
||||
allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0)
|
||||
allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance))
|
||||
source_damage_isoBrittle_output = ''
|
||||
|
||||
allocate(source_damage_isoBrittle_offset(material_Nphase), source=0)
|
||||
allocate(source_damage_isoBrittle_instance(material_Nphase), source=0)
|
||||
do phase = 1, material_Nphase
|
||||
source_damage_isoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoBrittle_ID)
|
||||
do source = 1, phase_Nsources(phase)
|
||||
if (phase_source(source,phase) == source_damage_isoBrittle_ID) &
|
||||
source_damage_isoBrittle_offset(phase) = source
|
||||
enddo
|
||||
enddo
|
||||
|
||||
allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0)
|
||||
allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance))
|
||||
source_damage_isoBrittle_output = ''
|
||||
|
||||
allocate(param(Ninstance))
|
||||
|
||||
do p=1, size(config_phase)
|
||||
if (all(phase_source(:,p) /= SOURCE_DAMAGE_ISOBRITTLE_ID)) cycle
|
||||
associate(prm => param(source_damage_isoBrittle_instance(p)), &
|
||||
config => config_phase(p))
|
||||
|
||||
prm%aTol = config%getFloat('isobrittle_atol',defaultVal = 1.0e-3_pReal)
|
||||
|
||||
prm%N = config%getFloat('isobrittle_n')
|
||||
prm%critStrainEnergy = config%getFloat('isobrittle_criticalstrainenergy')
|
||||
|
||||
! sanity checks
|
||||
if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_atol'
|
||||
|
||||
if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_n'
|
||||
if (prm%critStrainEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_criticalstrainenergy'
|
||||
allocate(param(Ninstance))
|
||||
|
||||
do p=1, size(config_phase)
|
||||
if (all(phase_source(:,p) /= SOURCE_DAMAGE_ISOBRITTLE_ID)) cycle
|
||||
associate(prm => param(source_damage_isoBrittle_instance(p)), &
|
||||
config => config_phase(p))
|
||||
|
||||
prm%aTol = config%getFloat('isobrittle_atol',defaultVal = 1.0e-3_pReal)
|
||||
|
||||
prm%N = config%getFloat('isobrittle_n')
|
||||
prm%critStrainEnergy = config%getFloat('isobrittle_criticalstrainenergy')
|
||||
|
||||
! sanity checks
|
||||
if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_atol'
|
||||
|
||||
if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_n'
|
||||
if (prm%critStrainEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_criticalstrainenergy'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! exit if any parameter is out of range
|
||||
if (extmsg /= '') &
|
||||
call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')')
|
||||
if (extmsg /= '') &
|
||||
call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')')
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! output pararameters
|
||||
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
|
||||
allocate(prm%outputID(0))
|
||||
do i=1, size(outputs)
|
||||
outputID = undefined_ID
|
||||
select case(outputs(i))
|
||||
|
||||
case ('isobrittle_drivingforce')
|
||||
source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1
|
||||
source_damage_isoBrittle_output(i,source_damage_isoBrittle_instance(p)) = outputs(i)
|
||||
prm%outputID = [prm%outputID, damage_drivingforce_ID]
|
||||
|
||||
end select
|
||||
outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
|
||||
allocate(prm%outputID(0))
|
||||
do i=1, size(outputs)
|
||||
outputID = undefined_ID
|
||||
select case(outputs(i))
|
||||
|
||||
case ('isobrittle_drivingforce')
|
||||
source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1
|
||||
source_damage_isoBrittle_output(i,source_damage_isoBrittle_instance(p)) = outputs(i)
|
||||
prm%outputID = [prm%outputID, damage_drivingforce_ID]
|
||||
|
||||
end select
|
||||
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end associate
|
||||
end associate
|
||||
|
||||
phase = p
|
||||
|
||||
phase = p
|
||||
NofMyPhase=count(material_phase==phase)
|
||||
instance = source_damage_isoBrittle_instance(phase)
|
||||
sourceOffset = source_damage_isoBrittle_offset(phase)
|
||||
|
||||
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,1)
|
||||
sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoBrittle_sizePostResult(:,instance))
|
||||
sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
|
||||
|
||||
NofMyPhase=count(material_phase==phase)
|
||||
instance = source_damage_isoBrittle_instance(phase)
|
||||
sourceOffset = source_damage_isoBrittle_offset(phase)
|
||||
|
||||
call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,1)
|
||||
sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoBrittle_sizePostResult(:,instance))
|
||||
sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
|
||||
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine source_damage_isoBrittle_init
|
||||
|
||||
|
|
@ -164,47 +149,41 @@ end subroutine source_damage_isoBrittle_init
|
|||
!> @brief calculates derived quantities from state
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
|
||||
use material, only: &
|
||||
phaseAt, phasememberAt, &
|
||||
sourceState
|
||||
use math, only : &
|
||||
math_sym33to6, &
|
||||
math_I3
|
||||
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
ip, & !< integration point
|
||||
el !< element
|
||||
real(pReal), intent(in), dimension(3,3) :: &
|
||||
Fe
|
||||
real(pReal), intent(in), dimension(6,6) :: &
|
||||
C
|
||||
integer :: &
|
||||
phase, constituent, instance, sourceOffset
|
||||
real(pReal) :: &
|
||||
strain(6), &
|
||||
strainenergy
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
ip, & !< integration point
|
||||
el !< element
|
||||
real(pReal), intent(in), dimension(3,3) :: &
|
||||
Fe
|
||||
real(pReal), intent(in), dimension(6,6) :: &
|
||||
C
|
||||
integer :: &
|
||||
phase, constituent, instance, sourceOffset
|
||||
real(pReal) :: &
|
||||
strain(6), &
|
||||
strainenergy
|
||||
|
||||
phase = phaseAt(ipc,ip,el) !< phase ID at ipc,ip,el
|
||||
constituent = phasememberAt(ipc,ip,el) !< state array offset for phase ID at ipc,ip,el
|
||||
! ToDo: capability for multiple instances of SAME source within given phase. Needs Ninstance loop from here on!
|
||||
instance = source_damage_isoBrittle_instance(phase) !< instance of damage_isoBrittle source
|
||||
sourceOffset = source_damage_isoBrittle_offset(phase)
|
||||
phase = phaseAt(ipc,ip,el) !< phase ID at ipc,ip,el
|
||||
constituent = phasememberAt(ipc,ip,el) !< state array offset for phase ID at ipc,ip,el
|
||||
! ToDo: capability for multiple instances of SAME source within given phase. Needs Ninstance loop from here on!
|
||||
instance = source_damage_isoBrittle_instance(phase) !< instance of damage_isoBrittle source
|
||||
sourceOffset = source_damage_isoBrittle_offset(phase)
|
||||
|
||||
|
||||
strain = 0.5_pReal*math_sym33to6(matmul(transpose(Fe),Fe)-math_I3)
|
||||
|
||||
strain = 0.5_pReal*math_sym33to6(matmul(transpose(Fe),Fe)-math_I3)
|
||||
|
||||
strainenergy = 2.0_pReal*sum(strain*matmul(C,strain))/param(instance)%critStrainEnergy
|
||||
! ToDo: check strainenergy = 2.0_pReal*dot_product(strain,matmul(C,strain))/param(instance)%critStrainEnergy
|
||||
|
||||
if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then
|
||||
sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
|
||||
strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent)
|
||||
else
|
||||
sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
|
||||
sourceState(phase)%p(sourceOffset)%subState0(1,constituent) - &
|
||||
sourceState(phase)%p(sourceOffset)%state(1,constituent)
|
||||
endif
|
||||
strainenergy = 2.0_pReal*sum(strain*matmul(C,strain))/param(instance)%critStrainEnergy
|
||||
! ToDo: check strainenergy = 2.0_pReal*dot_product(strain,matmul(C,strain))/param(instance)%critStrainEnergy
|
||||
|
||||
if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then
|
||||
sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
|
||||
strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent)
|
||||
else
|
||||
sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
|
||||
sourceState(phase)%p(sourceOffset)%subState0(1,constituent) - &
|
||||
sourceState(phase)%p(sourceOffset)%state(1,constituent)
|
||||
endif
|
||||
|
||||
end subroutine source_damage_isoBrittle_deltaState
|
||||
|
||||
|
|
@ -212,61 +191,57 @@ end subroutine source_damage_isoBrittle_deltaState
|
|||
!> @brief returns local part of nonlocal damage driving force
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
|
||||
use material, only: &
|
||||
sourceState
|
||||
|
||||
integer, intent(in) :: &
|
||||
phase, &
|
||||
constituent
|
||||
real(pReal), intent(in) :: &
|
||||
phi
|
||||
real(pReal), intent(out) :: &
|
||||
localphiDot, &
|
||||
dLocalphiDot_dPhi
|
||||
integer :: &
|
||||
instance, sourceOffset
|
||||
integer, intent(in) :: &
|
||||
phase, &
|
||||
constituent
|
||||
real(pReal), intent(in) :: &
|
||||
phi
|
||||
real(pReal), intent(out) :: &
|
||||
localphiDot, &
|
||||
dLocalphiDot_dPhi
|
||||
integer :: &
|
||||
instance, sourceOffset
|
||||
|
||||
instance = source_damage_isoBrittle_instance(phase)
|
||||
sourceOffset = source_damage_isoBrittle_offset(phase)
|
||||
|
||||
localphiDot = (1.0_pReal - phi)**(param(instance)%N - 1.0_pReal) - &
|
||||
phi*sourceState(phase)%p(sourceOffset)%state(1,constituent)
|
||||
dLocalphiDot_dPhi = - (param(instance)%N - 1.0_pReal)* &
|
||||
(1.0_pReal - phi)**max(0.0_pReal,param(instance)%N - 2.0_pReal) &
|
||||
- sourceState(phase)%p(sourceOffset)%state(1,constituent)
|
||||
|
||||
instance = source_damage_isoBrittle_instance(phase)
|
||||
sourceOffset = source_damage_isoBrittle_offset(phase)
|
||||
|
||||
localphiDot = (1.0_pReal - phi)**(param(instance)%N - 1.0_pReal) - &
|
||||
phi*sourceState(phase)%p(sourceOffset)%state(1,constituent)
|
||||
dLocalphiDot_dPhi = - (param(instance)%N - 1.0_pReal)* &
|
||||
(1.0_pReal - phi)**max(0.0_pReal,param(instance)%N - 2.0_pReal) &
|
||||
- sourceState(phase)%p(sourceOffset)%state(1,constituent)
|
||||
|
||||
end subroutine source_damage_isoBrittle_getRateAndItsTangent
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief return array of local damage results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function source_damage_isoBrittle_postResults(phase, constituent)
|
||||
use material, only: &
|
||||
sourceState
|
||||
|
||||
integer, intent(in) :: &
|
||||
phase, &
|
||||
constituent
|
||||
real(pReal), dimension(sum(source_damage_isoBrittle_sizePostResult(:, &
|
||||
source_damage_isoBrittle_instance(phase)))) :: &
|
||||
source_damage_isoBrittle_postResults
|
||||
integer, intent(in) :: &
|
||||
phase, &
|
||||
constituent
|
||||
real(pReal), dimension(sum(source_damage_isoBrittle_sizePostResult(:, &
|
||||
source_damage_isoBrittle_instance(phase)))) :: &
|
||||
source_damage_isoBrittle_postResults
|
||||
|
||||
integer :: &
|
||||
instance, sourceOffset, o, c
|
||||
|
||||
instance = source_damage_isoBrittle_instance(phase)
|
||||
sourceOffset = source_damage_isoBrittle_offset(phase)
|
||||
integer :: &
|
||||
instance, sourceOffset, o, c
|
||||
|
||||
instance = source_damage_isoBrittle_instance(phase)
|
||||
sourceOffset = source_damage_isoBrittle_offset(phase)
|
||||
|
||||
c = 0
|
||||
c = 0
|
||||
|
||||
do o = 1,size(param(instance)%outputID)
|
||||
select case(param(instance)%outputID(o))
|
||||
case (damage_drivingforce_ID)
|
||||
source_damage_isoBrittle_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
|
||||
c = c + 1
|
||||
do o = 1,size(param(instance)%outputID)
|
||||
select case(param(instance)%outputID(o))
|
||||
case (damage_drivingforce_ID)
|
||||
source_damage_isoBrittle_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
|
||||
c = c + 1
|
||||
|
||||
end select
|
||||
enddo
|
||||
end select
|
||||
enddo
|
||||
end function source_damage_isoBrittle_postResults
|
||||
|
||||
end module source_damage_isoBrittle
|
||||
|
|
|
|||
|
|
@ -6,6 +6,10 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
module source_damage_isoDuctile
|
||||
use prec
|
||||
use debug
|
||||
use IO
|
||||
use material
|
||||
use config
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
|
@ -51,25 +55,6 @@ contains
|
|||
!> @details reads in material parameters, allocates arrays, and does sanity checks
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine source_damage_isoDuctile_init
|
||||
use debug, only: &
|
||||
debug_level,&
|
||||
debug_constitutive,&
|
||||
debug_levelBasic
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use material, only: &
|
||||
material_allocateSourceState, &
|
||||
phase_source, &
|
||||
phase_Nsources, &
|
||||
phase_Noutput, &
|
||||
SOURCE_damage_isoDuctile_label, &
|
||||
SOURCE_damage_isoDuctile_ID, &
|
||||
material_phase, &
|
||||
sourceState
|
||||
use config, only: &
|
||||
config_phase, &
|
||||
material_Nphase
|
||||
|
||||
|
||||
integer :: Ninstance,phase,instance,source,sourceOffset
|
||||
integer :: NofMyPhase,p,i
|
||||
|
|
@ -164,13 +149,6 @@ end subroutine source_damage_isoDuctile_init
|
|||
!> @brief calculates derived quantities from state
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine source_damage_isoDuctile_dotState(ipc, ip, el)
|
||||
use material, only: &
|
||||
phaseAt, phasememberAt, &
|
||||
plasticState, &
|
||||
sourceState, &
|
||||
material_homogenizationAt, &
|
||||
damage, &
|
||||
damageMapping
|
||||
|
||||
integer, intent(in) :: &
|
||||
ipc, & !< component-ID of integration point
|
||||
|
|
@ -197,8 +175,6 @@ end subroutine source_damage_isoDuctile_dotState
|
|||
!> @brief returns local part of nonlocal damage driving force
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
|
||||
use material, only: &
|
||||
sourceState
|
||||
|
||||
integer, intent(in) :: &
|
||||
phase, &
|
||||
|
|
@ -224,8 +200,6 @@ end subroutine source_damage_isoDuctile_getRateAndItsTangent
|
|||
!> @brief return array of local damage results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function source_damage_isoDuctile_postResults(phase, constituent)
|
||||
use material, only: &
|
||||
sourceState
|
||||
|
||||
integer, intent(in) :: &
|
||||
phase, &
|
||||
|
|
|
|||
|
|
@ -11,7 +11,6 @@ module thermal_adiabatic
|
|||
use source_thermal_externalheat
|
||||
use crystallite
|
||||
use lattice
|
||||
use mesh
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
|
@ -214,13 +213,13 @@ function thermal_adiabatic_getSpecificHeat(ip,el)
|
|||
thermal_adiabatic_getSpecificHeat = 0.0_pReal
|
||||
|
||||
|
||||
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
|
||||
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
|
||||
thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat + &
|
||||
lattice_specificHeat(material_phase(grain,ip,el))
|
||||
enddo
|
||||
|
||||
thermal_adiabatic_getSpecificHeat = &
|
||||
thermal_adiabatic_getSpecificHeat/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
thermal_adiabatic_getSpecificHeat/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
|
||||
|
||||
end function thermal_adiabatic_getSpecificHeat
|
||||
|
||||
|
|
@ -241,13 +240,13 @@ function thermal_adiabatic_getMassDensity(ip,el)
|
|||
thermal_adiabatic_getMassDensity = 0.0_pReal
|
||||
|
||||
|
||||
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
|
||||
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
|
||||
thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity + &
|
||||
lattice_massDensity(material_phase(grain,ip,el))
|
||||
enddo
|
||||
|
||||
thermal_adiabatic_getMassDensity = &
|
||||
thermal_adiabatic_getMassDensity/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
thermal_adiabatic_getMassDensity/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
|
||||
|
||||
end function thermal_adiabatic_getMassDensity
|
||||
|
||||
|
|
|
|||
|
|
@ -3,8 +3,13 @@
|
|||
!> @brief material subroutine for temperature evolution from heat conduction
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module thermal_conduction
|
||||
use prec, only: &
|
||||
pReal
|
||||
use prec
|
||||
use material
|
||||
use config
|
||||
use lattice
|
||||
use crystallite
|
||||
use source_thermal_dissipation
|
||||
use source_thermal_externalheat
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
|
@ -42,22 +47,8 @@ contains
|
|||
!> @details reads in material parameters, allocates arrays, and does sanity checks
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine thermal_conduction_init
|
||||
use material, only: &
|
||||
thermal_type, &
|
||||
thermal_typeInstance, &
|
||||
homogenization_Noutput, &
|
||||
THERMAL_conduction_label, &
|
||||
THERMAL_conduction_ID, &
|
||||
material_homogenizationAt, &
|
||||
mappingHomogenization, &
|
||||
thermalState, &
|
||||
thermalMapping, &
|
||||
thermal_initialT, &
|
||||
temperature, &
|
||||
temperatureRate
|
||||
use config, only: &
|
||||
config_homogenization
|
||||
|
||||
|
||||
|
||||
integer :: maxNinstance,section,instance,i
|
||||
integer :: sizeState
|
||||
integer :: NofMyHomog
|
||||
|
|
@ -115,24 +106,6 @@ end subroutine thermal_conduction_init
|
|||
!> @brief returns heat generation rate
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
|
||||
use material, only: &
|
||||
material_homogenizationAt, &
|
||||
homogenization_Ngrains, &
|
||||
mappingHomogenization, &
|
||||
phaseAt, &
|
||||
phasememberAt, &
|
||||
thermal_typeInstance, &
|
||||
phase_Nsources, &
|
||||
phase_source, &
|
||||
SOURCE_thermal_dissipation_ID, &
|
||||
SOURCE_thermal_externalheat_ID
|
||||
use source_thermal_dissipation, only: &
|
||||
source_thermal_dissipation_getRateAndItsTangent
|
||||
use source_thermal_externalheat, only: &
|
||||
source_thermal_externalheat_getRateAndItsTangent
|
||||
use crystallite, only: &
|
||||
crystallite_S, &
|
||||
crystallite_Lp
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, & !< integration point number
|
||||
|
|
@ -193,16 +166,7 @@ end subroutine thermal_conduction_getSourceAndItsTangent
|
|||
!> @brief returns homogenized thermal conductivity in reference configuration
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function thermal_conduction_getConductivity33(ip,el)
|
||||
use lattice, only: &
|
||||
lattice_thermalConductivity33
|
||||
use material, only: &
|
||||
homogenization_Ngrains, &
|
||||
material_phase
|
||||
use mesh, only: &
|
||||
mesh_element
|
||||
use crystallite, only: &
|
||||
crystallite_push33ToRef
|
||||
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
|
|
@ -213,13 +177,13 @@ function thermal_conduction_getConductivity33(ip,el)
|
|||
|
||||
|
||||
thermal_conduction_getConductivity33 = 0.0_pReal
|
||||
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
|
||||
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
|
||||
thermal_conduction_getConductivity33 = thermal_conduction_getConductivity33 + &
|
||||
crystallite_push33ToRef(grain,ip,el,lattice_thermalConductivity33(:,:,material_phase(grain,ip,el)))
|
||||
enddo
|
||||
|
||||
thermal_conduction_getConductivity33 = &
|
||||
thermal_conduction_getConductivity33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
thermal_conduction_getConductivity33/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
|
||||
|
||||
end function thermal_conduction_getConductivity33
|
||||
|
||||
|
|
@ -228,14 +192,7 @@ end function thermal_conduction_getConductivity33
|
|||
!> @brief returns homogenized specific heat capacity
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function thermal_conduction_getSpecificHeat(ip,el)
|
||||
use lattice, only: &
|
||||
lattice_specificHeat
|
||||
use material, only: &
|
||||
homogenization_Ngrains, &
|
||||
material_phase
|
||||
use mesh, only: &
|
||||
mesh_element
|
||||
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
|
|
@ -247,13 +204,13 @@ function thermal_conduction_getSpecificHeat(ip,el)
|
|||
thermal_conduction_getSpecificHeat = 0.0_pReal
|
||||
|
||||
|
||||
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
|
||||
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
|
||||
thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat + &
|
||||
lattice_specificHeat(material_phase(grain,ip,el))
|
||||
enddo
|
||||
|
||||
thermal_conduction_getSpecificHeat = &
|
||||
thermal_conduction_getSpecificHeat/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
thermal_conduction_getSpecificHeat/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
|
||||
|
||||
end function thermal_conduction_getSpecificHeat
|
||||
|
||||
|
|
@ -261,14 +218,7 @@ end function thermal_conduction_getSpecificHeat
|
|||
!> @brief returns homogenized mass density
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function thermal_conduction_getMassDensity(ip,el)
|
||||
use lattice, only: &
|
||||
lattice_massDensity
|
||||
use material, only: &
|
||||
homogenization_Ngrains, &
|
||||
material_phase
|
||||
use mesh, only: &
|
||||
mesh_element
|
||||
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
|
|
@ -280,13 +230,13 @@ function thermal_conduction_getMassDensity(ip,el)
|
|||
thermal_conduction_getMassDensity = 0.0_pReal
|
||||
|
||||
|
||||
do grain = 1, homogenization_Ngrains(mesh_element(3,el))
|
||||
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
|
||||
thermal_conduction_getMassDensity = thermal_conduction_getMassDensity &
|
||||
+ lattice_massDensity(material_phase(grain,ip,el))
|
||||
enddo
|
||||
|
||||
thermal_conduction_getMassDensity = &
|
||||
thermal_conduction_getMassDensity/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
thermal_conduction_getMassDensity/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
|
||||
|
||||
end function thermal_conduction_getMassDensity
|
||||
|
||||
|
|
@ -295,11 +245,6 @@ end function thermal_conduction_getMassDensity
|
|||
!> @brief updates thermal state with solution from heat conduction PDE
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el)
|
||||
use material, only: &
|
||||
material_homogenizationAt, &
|
||||
temperature, &
|
||||
temperatureRate, &
|
||||
thermalMapping
|
||||
|
||||
integer, intent(in) :: &
|
||||
ip, & !< integration point number
|
||||
|
|
@ -323,8 +268,6 @@ end subroutine thermal_conduction_putTemperatureAndItsRate
|
|||
!> @brief return array of thermal results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function thermal_conduction_postResults(homog,instance,of) result(postResults)
|
||||
use material, only: &
|
||||
temperature
|
||||
|
||||
integer, intent(in) :: &
|
||||
homog, &
|
||||
|
|
|
|||
|
|
@ -3,48 +3,45 @@
|
|||
!> @brief material subroutine for isothermal temperature field
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module thermal_isothermal
|
||||
use prec
|
||||
use config
|
||||
use material
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
||||
public :: &
|
||||
thermal_isothermal_init
|
||||
implicit none
|
||||
private
|
||||
|
||||
public :: &
|
||||
thermal_isothermal_init
|
||||
|
||||
contains
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief allocates all neccessary fields, reads information from material configuration file
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine thermal_isothermal_init()
|
||||
use prec, only: &
|
||||
pReal
|
||||
use config, only: &
|
||||
material_Nhomogenization
|
||||
use material
|
||||
subroutine thermal_isothermal_init
|
||||
|
||||
integer :: &
|
||||
homog, &
|
||||
NofMyHomog
|
||||
integer :: &
|
||||
homog, &
|
||||
NofMyHomog
|
||||
|
||||
write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_isothermal_label//' init -+>>>'
|
||||
write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_isothermal_label//' init -+>>>'
|
||||
|
||||
initializeInstances: do homog = 1, material_Nhomogenization
|
||||
|
||||
if (thermal_type(homog) /= THERMAL_isothermal_ID) cycle
|
||||
NofMyHomog = count(material_homogenizationAt == homog)
|
||||
thermalState(homog)%sizeState = 0
|
||||
thermalState(homog)%sizePostResults = 0
|
||||
allocate(thermalState(homog)%state0 (0,NofMyHomog), source=0.0_pReal)
|
||||
allocate(thermalState(homog)%subState0(0,NofMyHomog), source=0.0_pReal)
|
||||
allocate(thermalState(homog)%state (0,NofMyHomog), source=0.0_pReal)
|
||||
|
||||
deallocate(temperature (homog)%p)
|
||||
allocate (temperature (homog)%p(1), source=thermal_initialT(homog))
|
||||
deallocate(temperatureRate(homog)%p)
|
||||
allocate (temperatureRate(homog)%p(1), source=0.0_pReal)
|
||||
|
||||
enddo initializeInstances
|
||||
initializeInstances: do homog = 1, material_Nhomogenization
|
||||
|
||||
if (thermal_type(homog) /= THERMAL_isothermal_ID) cycle
|
||||
NofMyHomog = count(material_homogenizationAt == homog)
|
||||
thermalState(homog)%sizeState = 0
|
||||
thermalState(homog)%sizePostResults = 0
|
||||
allocate(thermalState(homog)%state0 (0,NofMyHomog), source=0.0_pReal)
|
||||
allocate(thermalState(homog)%subState0(0,NofMyHomog), source=0.0_pReal)
|
||||
allocate(thermalState(homog)%state (0,NofMyHomog), source=0.0_pReal)
|
||||
|
||||
deallocate(temperature (homog)%p)
|
||||
allocate (temperature (homog)%p(1), source=thermal_initialT(homog))
|
||||
deallocate(temperatureRate(homog)%p)
|
||||
allocate (temperatureRate(homog)%p(1), source=0.0_pReal)
|
||||
|
||||
enddo initializeInstances
|
||||
|
||||
end subroutine thermal_isothermal_init
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue