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

Merge branch 'development' into even-more-HDF5-postprocessing

This commit is contained in:
Martin Diehl 2019-06-14 10:28:22 +02:00
parent 1186bd16f5 1bd4757258
commit b6830b3ac1
54 changed files with 4063 additions and 6071 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
PRIVATE

@ -1 +1 @@
Subproject commit 64cda1c010d500f662cd9a298c7b7ad10ab91c3c Subproject commit 1d3cf8180a20bcba6958ce82eb97befec077d7d2

2
VERSION
View File

@ -1 +1 @@
v2.0.3-369-g951134d1 v2.0.3-559-g589f5343

2
python/damask/test/test.py
View File

@ -267,7 +267,7 @@ class Test():
logging.critical('Current2Current: Unable to copy file "{}"'.format(f)) logging.critical('Current2Current: Unable to copy file "{}"'.format(f))
raise raise
def execute_inCurrentDir(self,cmd,streamIn=None): def execute_inCurrentDir(self,cmd,streamIn=None,env=None):
logging.info(cmd) logging.info(cmd)
out,error = damask.util.execute(cmd,streamIn,self.dirCurrent()) out,error = damask.util.execute(cmd,streamIn,self.dirCurrent())

7
python/damask/util.py
View File

@ -100,14 +100,17 @@ def strikeout(what):
# ----------------------------- # -----------------------------
def execute(cmd, def execute(cmd,
streamIn = None, streamIn = None,
wd = './'): wd = './',
env = None):
"""Executes a command in given directory and returns stdout and stderr for optional stdin""" """Executes a command in given directory and returns stdout and stderr for optional stdin"""
initialPath = os.getcwd() initialPath = os.getcwd()
os.chdir(wd) os.chdir(wd)
myEnv = os.environ if env is None else env
process = subprocess.Popen(shlex.split(cmd), process = subprocess.Popen(shlex.split(cmd),
stdout = subprocess.PIPE, stdout = subprocess.PIPE,
stderr = 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 out,error = [i for i in (process.communicate() if streamIn is None
else process.communicate(streamIn.read().encode('utf-8')))] else process.communicate(streamIn.read().encode('utf-8')))]
out = out.decode('utf-8').replace('\x08','') out = out.decode('utf-8').replace('\x08','')

203
src/CPFEM.f90
View File

@ -5,9 +5,27 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module CPFEM module CPFEM
use prec 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 implicit none
private private
real(pReal), parameter, private :: & real(pReal), parameter, private :: &
CPFEM_odd_stress = 1e15_pReal, & !< return value for stress in case of ping pong dummy cycle 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 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 !> @brief call (thread safe) all module initializations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine CPFEM_initAll(el,ip) 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 integer(pInt), intent(in) :: el, & !< FE el number
ip !< FE integration point number ip !< FE integration point number
@ -100,12 +86,12 @@ subroutine CPFEM_initAll(el,ip)
call config_init call config_init
call math_init call math_init
call FE_init call FE_init
call mesh_init(ip, el)
call lattice_init
#ifdef DAMASK_HDF5 #ifdef DAMASK_HDF5
call HDF5_utilities_init call HDF5_utilities_init
call results_init call results_init
#endif #endif
call mesh_init(ip, el)
call lattice_init
call material_init call material_init
call constitutive_init call constitutive_init
call crystallite_init call crystallite_init
@ -122,42 +108,15 @@ end subroutine CPFEM_initAll
!> @brief allocate the arrays defined in module CPFEM and initialize them !> @brief allocate the arrays defined in module CPFEM and initialize them
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine CPFEM_init 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 integer :: k,l,m,ph,homog
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
flush(6) flush(6)
allocate(CPFEM_cs( 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,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) allocate(CPFEM_dcsdE( 6,6,discretization_nIP,discretization_nElem), source= 0.0_pReal)
allocate(CPFEM_dcsdE_knownGood(6,6,theMesh%elem%nIPs,theMesh%Nelems), 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 ! *** restore the last converged values of each essential variable from the binary file
!if (restartRead) then !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 !> @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) 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 integer(pInt), intent(in) :: elFE, & !< FE element number
ip !< integration point number ip !< integration point number
@ -380,7 +259,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
enddo; enddo enddo; enddo
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
write(6,'(a)') '<< CPFEM >> aging states' 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)),/)') & 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, & '<< 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)) 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 no parallel execution is required, there is no need to collect FEM input
if (.not. parallelExecution) then 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 case (THERMAL_conduction_ID) chosenThermal1
temperature(material_homogenizationAt(elCP))%p(thermalMapping(material_homogenizationAt(elCP))%p(ip,elCP)) = & temperature(material_homogenizationAt(elCP))%p(thermalMapping(material_homogenizationAt(elCP))%p(ip,elCP)) = &
temperature_inp 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 if (rnd < 0.5_pReal) rnd = rnd - 1.0_pReal
CPFEM_cs(1:6,ip,elCP) = rnd * CPFEM_odd_stress CPFEM_cs(1:6,ip,elCP) = rnd * CPFEM_odd_stress
CPFEM_dcsde(1:6,1:6,ip,elCP) = CPFEM_odd_jacobian * math_identity2nd(6) 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 case (THERMAL_conduction_ID) chosenThermal2
temperature(material_homogenizationAt(elCP))%p(thermalMapping(material_homogenizationAt(elCP))%p(ip,elCP)) = & temperature(material_homogenizationAt(elCP))%p(thermalMapping(material_homogenizationAt(elCP))%p(ip,elCP)) = &
temperature_inp temperature_inp
@ -520,15 +399,12 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
if (.not. parallelExecution) then if (.not. parallelExecution) then
FEsolving_execElem(1) = elCP FEsolving_execElem(1) = elCP
FEsolving_execElem(2) = elCP FEsolving_execElem(2) = elCP
if (.not. microstructure_elemhomo(mesh_element(4,elCP)) .or. & ! calculate unless homogeneous FEsolving_execIP(1,elCP) = ip
(microstructure_elemhomo(mesh_element(4,elCP)) .and. ip == 1_pInt)) then ! and then only first ip FEsolving_execIP(2,elCP) = ip
FEsolving_execIP(1,elCP) = ip if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) &
FEsolving_execIP(2,elCP) = ip write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) & call materialpoint_stressAndItsTangent(updateJaco, dt) ! calculate stress and its tangent
write(6,'(a,i8,1x,i2)') '<< CPFEM >> calculation for elFE ip ',elFE,ip call materialpoint_postResults()
call materialpoint_stressAndItsTangent(updateJaco, dt) ! calculate stress and its tangent
call materialpoint_postResults()
endif
!* parallel computation and calulation not yet done !* parallel computation and calulation not yet done
@ -551,13 +427,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
else terminalIllness 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 ! translate from P to CS
Kirchhoff = matmul(materialpoint_P(1:3,1:3,ip,elCP), transpose(materialpoint_F(1:3,1:3,ip,elCP))) 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 !> @brief triggers writing of the results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine CPFEM_results(inc,time) 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 integer(pInt), intent(in) :: inc
real(pReal), intent(in) :: time real(pReal), intent(in) :: time

410
src/CPFEM2.f90
View File

@ -4,14 +4,35 @@
!> @brief needs a good name and description !> @brief needs a good name and description
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module CPFEM2 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 implicit none
private private
public :: & public :: &
CPFEM_age, & CPFEM_age, &
CPFEM_initAll, & CPFEM_initAll, &
CPFEM_results CPFEM_results
contains contains
@ -19,65 +40,29 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief call (thread safe) all module initializations !> @brief call (thread safe) all module initializations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine CPFEM_initAll() 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
call DAMASK_interface_init ! Spectral and FEM interface to commandline call DAMASK_interface_init ! Spectral and FEM interface to commandline
call prec_init call prec_init
call IO_init call IO_init
#ifdef FEM #ifdef FEM
call FEM_Zoo_init call FEM_Zoo_init
#endif #endif
call numerics_init call numerics_init
call debug_init call debug_init
call config_init call config_init
call math_init call math_init
call FE_init call FE_init
call mesh_init call mesh_init
call lattice_init call lattice_init
call HDF5_utilities_init call HDF5_utilities_init
call results_init call results_init
call material_init call material_init
call constitutive_init call constitutive_init
call crystallite_init call crystallite_init
call homogenization_init call homogenization_init
call materialpoint_postResults call materialpoint_postResults
call CPFEM_init call CPFEM_init
end subroutine CPFEM_initAll end subroutine CPFEM_initAll
@ -85,86 +70,51 @@ end subroutine CPFEM_initAll
!> @brief allocate the arrays defined in module CPFEM and initialize them !> @brief allocate the arrays defined in module CPFEM and initialize them
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine CPFEM_init 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 integer :: ph,homog
character(len=1024) :: rankStr, PlasticItem, HomogItem character(len=1024) :: rankStr, PlasticItem, HomogItem
integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
flush(6) flush(6)
! *** restore the last converged values of each essential variable from the binary file ! *** restore the last converged values of each essential variable from the binary file
if (restartRead) then if (restartRead) then
if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0) 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' write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from hdf5 file'
flush(6) flush(6)
endif endif
write(rankStr,'(a1,i0)')'_',worldrank write(rankStr,'(a1,i0)')'_',worldrank
fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5') 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')
groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases') call HDF5_read(fileHandle,material_phase, 'recordedPhase')
do ph = 1,size(phase_plasticity) call HDF5_read(fileHandle,crystallite_F0, 'convergedF')
write(PlasticItem,*) ph,'_' call HDF5_read(fileHandle,crystallite_Fp0, 'convergedFp')
call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst') call HDF5_read(fileHandle,crystallite_Fi0, 'convergedFi')
enddo call HDF5_read(fileHandle,crystallite_Lp0, 'convergedLp')
call HDF5_closeGroup(groupPlasticID) call HDF5_read(fileHandle,crystallite_Li0, 'convergedLi')
call HDF5_read(fileHandle,crystallite_S0, 'convergedS')
groupHomogID = HDF5_openGroup(fileHandle,'HomogStates')
do homog = 1, material_Nhomogenization groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases')
write(HomogItem,*) homog,'_' do ph = 1,size(phase_plasticity)
call HDF5_read(groupHomogID,homogState(homog)%state0, trim(HomogItem)//'convergedStateHomog') write(PlasticItem,*) ph,'_'
enddo call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
call HDF5_closeGroup(groupHomogID) 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) call HDF5_closeFile(fileHandle)
restartRead = .false. restartRead = .false.
endif endif
end subroutine CPFEM_init end subroutine CPFEM_init
@ -172,115 +122,70 @@ end subroutine CPFEM_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief forwards data after successful increment !> @brief forwards data after successful increment
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine CPFEM_age() 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
integer :: i, ph, homog, mySource integer :: i, ph, homog, mySource
character(len=32) :: rankStr, PlasticItem, HomogItem character(len=32) :: rankStr, PlasticItem, HomogItem
integer(HID_T) :: fileHandle, groupPlastic, groupHomog integer(HID_T) :: fileHandle, groupPlastic, groupHomog
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) & if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
write(6,'(a)') '<< CPFEM >> aging states' write(6,'(a)') '<< CPFEM >> aging states'
crystallite_F0 = crystallite_partionedF crystallite_F0 = crystallite_partionedF
crystallite_Fp0 = crystallite_Fp crystallite_Fp0 = crystallite_Fp
crystallite_Lp0 = crystallite_Lp crystallite_Lp0 = crystallite_Lp
crystallite_Fi0 = crystallite_Fi crystallite_Fi0 = crystallite_Fi
crystallite_Li0 = crystallite_Li crystallite_Li0 = crystallite_Li
crystallite_S0 = crystallite_S crystallite_S0 = crystallite_S
do i = 1, size(plasticState) do i = 1, size(plasticState)
plasticState(i)%state0 = plasticState(i)%state plasticState(i)%state0 = plasticState(i)%state
enddo enddo
do i = 1, size(sourceState) do i = 1, size(sourceState)
do mySource = 1,phase_Nsources(i) do mySource = 1,phase_Nsources(i)
sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state
enddo; enddo enddo; enddo
do homog = 1, material_Nhomogenization do homog = 1, material_Nhomogenization
homogState (homog)%state0 = homogState (homog)%state homogState (homog)%state0 = homogState (homog)%state
thermalState (homog)%state0 = thermalState (homog)%state thermalState (homog)%state0 = thermalState (homog)%state
damageState (homog)%state0 = damageState (homog)%state damageState (homog)%state0 = damageState (homog)%state
enddo enddo
if (restartWrite) then if (restartWrite) then
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) & if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file' write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file'
write(rankStr,'(a1,i0)')'_',worldrank write(rankStr,'(a1,i0)')'_',worldrank
fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','a') fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','a')
call HDF5_write(fileHandle,material_phase, 'recordedPhase') call HDF5_write(fileHandle,material_phase, 'recordedPhase')
call HDF5_write(fileHandle,crystallite_F0, 'convergedF') call HDF5_write(fileHandle,crystallite_F0, 'convergedF')
call HDF5_write(fileHandle,crystallite_Fp0, 'convergedFp') call HDF5_write(fileHandle,crystallite_Fp0, 'convergedFp')
call HDF5_write(fileHandle,crystallite_Fi0, 'convergedFi') call HDF5_write(fileHandle,crystallite_Fi0, 'convergedFi')
call HDF5_write(fileHandle,crystallite_Lp0, 'convergedLp') call HDF5_write(fileHandle,crystallite_Lp0, 'convergedLp')
call HDF5_write(fileHandle,crystallite_Li0, 'convergedLi') call HDF5_write(fileHandle,crystallite_Li0, 'convergedLi')
call HDF5_write(fileHandle,crystallite_S0, 'convergedS') call HDF5_write(fileHandle,crystallite_S0, 'convergedS')
groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases') groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases')
do ph = 1,size(phase_plasticity) do ph = 1,size(phase_plasticity)
write(PlasticItem,*) ph,'_' write(PlasticItem,*) ph,'_'
call HDF5_write(groupPlastic,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst') call HDF5_write(groupPlastic,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
enddo enddo
call HDF5_closeGroup(groupPlastic) call HDF5_closeGroup(groupPlastic)
groupHomog = HDF5_addGroup(fileHandle,'HomogStates') groupHomog = HDF5_addGroup(fileHandle,'HomogStates')
do homog = 1, material_Nhomogenization do homog = 1, material_Nhomogenization
write(HomogItem,*) homog,'_' write(HomogItem,*) homog,'_'
call HDF5_write(groupHomog,homogState(homog)%state0,trim(HomogItem)//'convergedStateHomog') call HDF5_write(groupHomog,homogState(homog)%state0,trim(HomogItem)//'convergedStateHomog')
enddo enddo
call HDF5_closeGroup(groupHomog) call HDF5_closeGroup(groupHomog)
call HDF5_closeFile(fileHandle) call HDF5_closeFile(fileHandle)
restartWrite = .false. restartWrite = .false.
endif endif
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) & if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
write(6,'(a)') '<< CPFEM >> done aging states' write(6,'(a)') '<< CPFEM >> done aging states'
end subroutine CPFEM_age end subroutine CPFEM_age
@ -289,25 +194,18 @@ end subroutine CPFEM_age
!> @brief triggers writing of the results !> @brief triggers writing of the results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine CPFEM_results(inc,time) 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 integer, intent(in) :: inc
real(pReal), intent(in) :: time real(pReal), intent(in) :: time
call results_openJobFile call results_openJobFile
call results_addIncrement(inc,time) call results_addIncrement(inc,time)
call constitutive_results call constitutive_results
call crystallite_results call crystallite_results
call homogenization_results call homogenization_results
call results_removeLink('current') ! ToDo: put this into closeJobFile call discretization_results
call results_closeJobFile call results_removeLink('current') ! ToDo: put this into closeJobFile
call results_closeJobFile
end subroutine CPFEM_results end subroutine CPFEM_results

6
src/DAMASK_interface.f90
View File

@ -40,12 +40,6 @@ module DAMASK_interface
setSIGTERM, & setSIGTERM, &
setSIGUSR1, & setSIGUSR1, &
setSIGUSR2 setSIGUSR2
private :: &
setWorkingDirectory, &
getGeometryFile, &
getLoadCaseFile, &
rectifyPath, &
makeRelativePath
contains contains

100
src/DAMASK_marc.f90
View File

@ -29,9 +29,18 @@
#include "prec.f90" #include "prec.f90"
module DAMASK_interface 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 implicit none
private private
character(len=4), parameter, public :: InputFileExtension = '.dat' character(len=4), parameter, public :: InputFileExtension = '.dat'
character(len=4), parameter, public :: LogFileExtension = '.log' character(len=4), parameter, public :: LogFileExtension = '.log'
@ -45,15 +54,7 @@ contains
!> @brief reports and sets working directory !> @brief reports and sets working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init 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) :: & integer, dimension(8) :: &
dateAndTime dateAndTime
integer :: ierr 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 !> @brief solver job name (no extension) as combination of geometry and load case name
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function getSolverJobName() function getSolverJobName()
use prec
implicit none
character(1024) :: getSolverJobName, inputName character(1024) :: getSolverJobName, inputName
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
integer :: extPos integer :: extPos
@ -115,8 +114,6 @@ end function getSolverJobName
end module DAMASK_interface end module DAMASK_interface
#include "commercialFEM_fileList.f90" #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, & strechn1,eigvn1,ncrd,itel,ndeg,ndm,nnode, &
jtype,lclass,ifr,ifu) jtype,lclass,ifr,ifu)
use prec use prec
use numerics, only: & use numerics
!$ DAMASK_NumThreadsInt, & use FEsolving
numerics_unitlength, & use debug
usePingPong use mesh
use FEsolving, only: & use CPFEM
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
implicit none implicit none
!$ include "omp_lib.h" ! the openMP function library !$ 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 call debug_reset() ! resets debugging
outdatedFFN1 = .false. outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1 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 call mesh_build_ipCoordinates() ! update ip coordinates
endif endif
if (outdatedByNewInc) then 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 computationMode = ior(computationMode,CPFEM_BACKUPJACOBIAN) ! collect and backup Jacobian after convergence
lastIncConverged = .false. ! reset flag lastIncConverged = .false. ! reset flag
endif endif
do node = 1,theMesh%elem%nNodes !do node = 1,theMesh%elem%nNodes
CPnodeID = mesh_element(4+node,cp_en) !CPnodeID = mesh_element(4+node,cp_en)
mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node) !mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node)
enddo !enddo
endif endif
else ! --- PLAIN MODE --- 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 call debug_reset() ! and resets debugging
outdatedFFN1 = .false. outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1 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 !call mesh_build_ipCoordinates() ! update ip coordinates
endif endif
if (outdatedByNewInc) then if (outdatedByNewInc) then
computationMode = ior(computationMode,CPFEM_AGERESULTS) computationMode = ior(computationMode,CPFEM_AGERESULTS)
@ -373,10 +334,8 @@ end subroutine hypela2
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine flux(f,ts,n,time) subroutine flux(f,ts,n,time)
use prec use prec
use thermal_conduction, only: & use thermal_conduction
thermal_conduction_getSourceAndItsTangent use mesh
use mesh, only: &
mesh_FEasCP
implicit none implicit none
real(pReal), dimension(6), intent(in) :: & real(pReal), dimension(6), intent(in) :: &
@ -399,8 +358,7 @@ subroutine flux(f,ts,n,time)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine uedinc(inc,incsub) subroutine uedinc(inc,incsub)
use prec use prec
use CPFEM, only: & use CPFEM
CPFEM_results
implicit none implicit none
integer, intent(in) :: inc, incsub 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) subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
use prec use prec
use mesh, only: & use mesh
mesh_FEasCP use IO
use IO, only: & use homogenization
IO_error
use homogenization, only: &
materialpoint_results,&
materialpoint_sizeResults
implicit none implicit none
integer, intent(in) :: & integer, intent(in) :: &

212
src/FEsolving.f90
View File

@ -5,32 +5,35 @@
!> @todo Descriptions for public variables needed !> @todo Descriptions for public variables needed
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module FEsolving module FEsolving
use prec use prec
use debug
implicit none use IO
private use DAMASK_interface
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
integer, dimension(2), public :: & implicit none
FEsolving_execElem !< for ping-pong scheme always whole range, otherwise one specific element private
integer, public :: &
character(len=1024), public :: & restartInc = 1 !< needs description
modelName !< needs description
logical, dimension(:,:), allocatable, public :: &
calcMode !< do calculation or simply collect when using ping pong scheme
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 contains
@ -41,108 +44,93 @@ contains
!> solver the information is provided by the interface module !> solver the information is provided by the interface module
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FE_init 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) #if defined(Marc4DAMASK) || defined(Abaqus)
integer, parameter :: & integer, parameter :: &
FILEUNIT = 222 FILEUNIT = 222
integer :: j integer :: j
character(len=65536) :: tag, line character(len=65536) :: tag, line
integer, allocatable, dimension(:) :: chunkPos integer, allocatable, dimension(:) :: chunkPos
#endif #endif
write(6,'(/,a)') ' <<<+- FEsolving init -+>>>' write(6,'(/,a)') ' <<<+- FEsolving init -+>>>'
modelName = getSolverJobName() modelName = getSolverJobName()
#if defined(Grid) || defined(FEM) #if defined(Grid) || defined(FEM)
restartInc = interface_RestartInc restartInc = interface_RestartInc
if(restartInc < 0) then if(restartInc < 0) then
call IO_warning(warning_ID=34) call IO_warning(warning_ID=34)
restartInc = 0 restartInc = 0
endif endif
restartRead = restartInc > 0 ! only read in if "true" restart requested restartRead = restartInc > 0 ! only read in if "true" restart requested
#else #else
call IO_open_inputFile(FILEUNIT,modelName) call IO_open_inputFile(FILEUNIT,modelName)
rewind(FILEUNIT) rewind(FILEUNIT)
do do
read (FILEUNIT,'(a1024)',END=100) line read (FILEUNIT,'(a1024)',END=100) line
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key tag = IO_lc(IO_stringValue(line,chunkPos,1)) ! extract key
select case(tag) select case(tag)
case ('solver') case ('solver')
read (FILEUNIT,'(a1024)',END=100) line ! next line read (FILEUNIT,'(a1024)',END=100) line ! next line
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
symmetricSolver = (IO_intValue(line,chunkPos,2) /= 1) symmetricSolver = (IO_intValue(line,chunkPos,2) /= 1)
case ('restart') case ('restart')
read (FILEUNIT,'(a1024)',END=100) line ! next line read (FILEUNIT,'(a1024)',END=100) line ! next line
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
restartWrite = iand(IO_intValue(line,chunkPos,1),1) > 0 restartWrite = iand(IO_intValue(line,chunkPos,1),1) > 0
restartRead = iand(IO_intValue(line,chunkPos,1),2) > 0 restartRead = iand(IO_intValue(line,chunkPos,1),2) > 0
case ('*restart') case ('*restart')
do j=2,chunkPos(1) do j=2,chunkPos(1)
restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'write') .or. restartWrite restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'write') .or. restartWrite
restartRead = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'read') .or. restartRead restartRead = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'read') .or. restartRead
enddo enddo
if(restartWrite) then if(restartWrite) then
do j=2,chunkPos(1) do j=2,chunkPos(1)
restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) /= 'frequency=0') .and. restartWrite restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) /= 'frequency=0') .and. restartWrite
enddo enddo
endif endif
end select end select
enddo enddo
100 close(FILEUNIT) 100 close(FILEUNIT)
if (restartRead) then if (restartRead) then
#ifdef Marc4DAMASK #ifdef Marc4DAMASK
call IO_open_logFile(FILEUNIT) call IO_open_logFile(FILEUNIT)
rewind(FILEUNIT) rewind(FILEUNIT)
do do
read (FILEUNIT,'(a1024)',END=200) line read (FILEUNIT,'(a1024)',END=200) line
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
if ( IO_lc(IO_stringValue(line,chunkPos,1)) == 'restart' & 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,2)) == 'file' &
.and. IO_lc(IO_stringValue(line,chunkPos,3)) == 'job' & .and. IO_lc(IO_stringValue(line,chunkPos,3)) == 'job' &
.and. IO_lc(IO_stringValue(line,chunkPos,4)) == 'id' ) & .and. IO_lc(IO_stringValue(line,chunkPos,4)) == 'id' ) &
modelName = IO_StringValue(line,chunkPos,6) modelName = IO_StringValue(line,chunkPos,6)
enddo enddo
#else ! QUESTION: is this meaningful for the spectral/FEM case? #else
call IO_open_inputFile(FILEUNIT,modelName) call IO_open_inputFile(FILEUNIT,modelName)
rewind(FILEUNIT) rewind(FILEUNIT)
do do
read (FILEUNIT,'(a1024)',END=200) line read (FILEUNIT,'(a1024)',END=200) line
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
if (IO_lc(IO_stringValue(line,chunkPos,1))=='*heading') then if (IO_lc(IO_stringValue(line,chunkPos,1))=='*heading') then
read (FILEUNIT,'(a1024)',END=200) line read (FILEUNIT,'(a1024)',END=200) line
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
modelName = IO_StringValue(line,chunkPos,1) modelName = IO_StringValue(line,chunkPos,1)
endif endif
enddo enddo
#endif #endif
200 close(FILEUNIT) 200 close(FILEUNIT)
endif endif
#endif #endif
if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0) then if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0) then
write(6,'(a21,l1)') ' restart writing: ', restartWrite write(6,'(a21,l1)') ' restart writing: ', restartWrite
write(6,'(a21,l1)') ' restart reading: ', restartRead write(6,'(a21,l1)') ' restart reading: ', restartRead
if (restartRead) write(6,'(a,/)') ' restart Job: '//trim(modelName) if (restartRead) write(6,'(a,/)') ' restart Job: '//trim(modelName)
endif endif
end subroutine FE_init end subroutine FE_init

316
src/HDF5_utilities.f90
View File

@ -5,20 +5,24 @@
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module HDF5_utilities module HDF5_utilities
use prec #if defined(PETSc) || defined(DAMASK_HDF5)
use IO
use HDF5 use HDF5
use rotations #endif
use numerics
#ifdef PETSc #ifdef PETSc
use PETSC use PETSC
#endif #endif
use prec
use IO
use rotations
use numerics
implicit none implicit none
public 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 !> @details for parallel IO, all dimension except for the last need to match
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
interface HDF5_read interface HDF5_read
@ -41,7 +45,7 @@ module HDF5_utilities
end interface HDF5_read 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 !> @details for parallel IO, all dimension except for the last need to match
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
interface HDF5_write interface HDF5_write
@ -66,7 +70,7 @@ module HDF5_utilities
end interface HDF5_write 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 interface HDF5_addAttribute
module procedure HDF5_addAttribute_str module procedure HDF5_addAttribute_str
@ -111,7 +115,7 @@ subroutine HDF5_utilities_init
call h5tget_size_f(H5T_NATIVE_INTEGER,typeSize, hdferr) 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 (hdferr < 0) call IO_error(1,ext_msg='HDF5_Utilities_init: h5tget_size_f (int)')
if (int(bit_size(0),SIZE_T)/=typeSize*8) & 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) 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)') 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 endif
call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr) 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 #ifdef PETSc
if (present(parallel)) then; if (parallel) then if (present(parallel)) then; if (parallel) then
call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) 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; endif
#endif #endif
if (m == 'w') then if (m == 'w') then
call h5fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr,access_prp = plist_id) 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 elseif(m == 'a') then
call h5fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id) 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 elseif(m == 'r') then
call h5fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id) 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 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 endif
call h5pclose_f(plist_id, hdferr) 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 end function HDF5_openFile
@ -179,7 +183,7 @@ subroutine HDF5_closeFile(fileHandle)
integer :: hdferr integer :: hdferr
call h5fclose_f(fileHandle,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 end subroutine HDF5_closeFile
@ -198,19 +202,19 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName)
!------------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------------
! creating a property list for data access properties ! creating a property list for data access properties
call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr) 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 ! setting I/O mode to collective
#ifdef PETSc #ifdef PETSc
call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) 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 #endif
!------------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------------
! Create group ! Create group
call h5gcreate_f(fileHandle, trim(groupName), HDF5_addGroup, hdferr, OBJECT_NAMELEN_DEFAULT_F,gapl_id = aplist_id) 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) 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 ! creating a property list for data access properties
call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr) 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 ! setting I/O mode to collective
#ifdef PETSc #ifdef PETSc
call h5pget_all_coll_metadata_ops_f(aplist_id, is_collective, hdferr) 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 #endif
!------------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------------
! opening the group ! opening the group
call h5gopen_f(fileHandle, trim(groupName), HDF5_openGroup, hdferr, gapl_id = aplist_id) 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) call h5pclose_f(aplist_id,hdferr)
@ -262,7 +266,7 @@ subroutine HDF5_closeGroup(group_id)
integer :: hdferr integer :: hdferr
call h5gclose_f(group_id, 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 end subroutine HDF5_closeGroup
@ -285,11 +289,11 @@ logical function HDF5_objectExists(loc_id,path)
endif endif
call h5lexists_f(loc_id, p, HDF5_objectExists, hdferr) 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 if(HDF5_objectExists) then
call h5oexists_by_name_f(loc_id, p, HDF5_objectExists, hdferr) 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 endif
end function HDF5_objectExists end function HDF5_objectExists
@ -316,27 +320,27 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
endif endif
call h5screate_f(H5S_SCALAR_F,space_id,hdferr) 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) 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) 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) 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 if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) 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 endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) 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) 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) 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) 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) 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 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 integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: attrLabel character(len=*), intent(in) :: attrLabel
integer(pInt), intent(in) :: attrValue integer, intent(in) :: attrValue
character(len=*), intent(in), optional :: path character(len=*), intent(in), optional :: path
integer :: hdferr integer :: hdferr
@ -363,21 +367,21 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
endif endif
call h5screate_f(H5S_SCALAR_F,space_id,hdferr) 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) 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 if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) 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 endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr) 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) 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) 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) 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 end subroutine HDF5_addAttribute_int
@ -404,21 +408,21 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
endif endif
call h5screate_f(H5S_SCALAR_F,space_id,hdferr) 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) 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 if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) 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 endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr) 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) 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) 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) 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 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 integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: attrLabel character(len=*), intent(in) :: attrLabel
integer(pInt), intent(in), dimension(:) :: attrValue integer, intent(in), dimension(:) :: attrValue
character(len=*), intent(in), optional :: path character(len=*), intent(in), optional :: path
integer :: hdferr integer :: hdferr
@ -448,21 +452,21 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
array_size = size(attrValue,kind=HSIZE_T) array_size = size(attrValue,kind=HSIZE_T)
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size) 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) 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 if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) 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 endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr) 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) 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) 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) 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 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) array_size = size(attrValue,kind=HSIZE_T)
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size) 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) 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 if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) 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 endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr) 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) 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) 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) 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 end subroutine HDF5_addAttribute_real_array
@ -522,19 +526,19 @@ subroutine HDF5_setLink(loc_id,target_name,link_name)
logical :: linkExists logical :: linkExists
call h5lexists_f(loc_id, link_name,linkExists, hdferr) 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 if (linkExists) then
call h5ldelete_f(loc_id,link_name, hdferr) 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 endif
call h5lcreate_soft_f(target_name, loc_id, link_name, hdferr) 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 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real1 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real2 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real3 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real4 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real5 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_real6 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) 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,& 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) 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) 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int1 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int2 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int3 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int4 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int5 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) 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,& 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) 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) call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id)
end subroutine HDF5_read_int6 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) 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,& 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) 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) 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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 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) 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 if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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) 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,& 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) 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 endif
call finalize_write(plist_id, dset_id, filespace_id, memspace_id) 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) globalShape !< shape of the dataset (all processes)
integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id 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 readSize !< contribution of all processes
integer :: ierr integer :: ierr
integer :: hdferr 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) ! creating a property list for transfer properties (is collective for MPI)
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) 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 = 0
readSize(worldrank+1) = int(localShape(ubound(localShape,1)),pInt) readSize(worldrank+1) = int(localShape(ubound(localShape,1)))
#ifdef PETSc #ifdef PETSc
if (parallel) then if (parallel) then
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) 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 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
#endif #endif
myStart = int(0,HSIZE_T) 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) ! create dataspace in memory (local shape)
call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) 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 ! creating a property list for IO and set it to collective
call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) 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 #ifdef PETSc
call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) 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 #endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! open the dataset in the file and get the space ID ! open the dataset in the file and get the space ID
call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_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) 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 ! 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) 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 end subroutine initialize_read
@ -1828,15 +1832,15 @@ subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer :: hdferr integer :: hdferr
call h5pclose_f(plist_id, 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) 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) 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) 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) 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 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) ! creating a property list for transfer properties (is collective when reading in parallel)
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) 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 #ifdef PETSc
if (parallel) then if (parallel) then
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) 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
#endif #endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! determine the global data layout among all processes ! determine the global data layout among all processes
writeSize = 0_pInt writeSize = 0
writeSize(worldrank+1) = int(myShape(ubound(myShape,1)),pInt) writeSize(worldrank+1) = int(myShape(ubound(myShape,1)))
#ifdef PETSc #ifdef PETSc
if (parallel) then 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 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
#endif #endif
myStart = int(0,HSIZE_T) myStart = int(0,HSIZE_T)
@ -1892,17 +1896,16 @@ if (parallel) then
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! create dataspace in memory (local shape) and in file (global shape) ! create dataspace in memory (local shape) and in file (global shape)
call h5screate_simple_f(size(myShape), myShape, memspace_id, hdferr, myShape) 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) 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) ! 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) 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) 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 end subroutine initialize_write
@ -1916,14 +1919,15 @@ subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id)
integer :: hdferr integer :: hdferr
call h5pclose_f(plist_id, 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) 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) 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) 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 end subroutine finalize_write
#endif
end module HDF5_Utilities end module HDF5_Utilities

12
src/IO.f90
View File

@ -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 :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
character(len=*), parameter :: comment = achar(35) ! comment id '#' character(len=*), parameter :: comment = achar(35) ! comment id '#'
integer :: posNonBlank, posComment ! no pInt integer :: posNonBlank, posComment
posNonBlank = verify(string,blankChar) posNonBlank = verify(string,blankChar)
posComment = scan(string,comment) posComment = scan(string,comment)
@ -377,7 +377,7 @@ pure function IO_getTag(string,openChar,closeChar)
closeChar !< indicates end of tag closeChar !< indicates end of tag
character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
integer :: left,right ! no pInt integer :: left,right
IO_getTag = '' 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=*), 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 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) allocate(IO_stringPos(1), source=0)
right = 0 right = 0
@ -417,7 +417,7 @@ pure function IO_stringPos(string)
left = right + verify(string(right+1:),SEP) left = right + verify(string(right+1:),SEP)
right = left + scan(string(left:),SEP) - 2 right = left + scan(string(left:),SEP) - 2
if ( string(left:left) == '#' ) exit 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 IO_stringPos(1) = IO_stringPos(1)+1
endOfString: if (right < left) then endOfString: if (right < left) then
IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string) 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 :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,n ! no pInt (len returns default integer) integer :: i,n
IO_lc = string IO_lc = string
do i=1,len(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=19) :: width ! maximum digits for 64 bit integer
character(len=20) :: min_width ! longer for negative values 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(width, '(I19.19)') N_digits
write(min_width, '(I20.20)') N_digits + merge(1,0,intToPrint < 0) write(min_width, '(I20.20)') N_digits + merge(1,0,intToPrint < 0)
IO_intOut = 'I'//trim(min_width)//'.'//trim(width) IO_intOut = 'I'//trim(min_width)//'.'//trim(width)

4
src/MarcInclude/concom2018
View File

@ -5,7 +5,7 @@
! !
! MSC.Marc include file ! MSC.Marc include file
! !
integer(pInt) & integer &
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,& iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,& ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,&
ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,& 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,& iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror,&
icsprg icsprg
dimension :: ideva(60) dimension :: ideva(60)
integer(pInt) num_concom integer num_concom
parameter(num_concom=251) parameter(num_concom=251)
common/marc_concom/& common/marc_concom/&
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,& iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&

4
src/MarcInclude/concom2018.1
View File

@ -5,7 +5,7 @@
! !
! MSC.Marc include file ! MSC.Marc include file
! !
integer(pInt) & integer &
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,& iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,& ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,&
ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,& 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,& iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror,&
icsprg icsprg
dimension :: ideva(60) dimension :: ideva(60)
integer(pInt) num_concom integer num_concom
parameter(num_concom=251) parameter(num_concom=251)
common/marc_concom/& common/marc_concom/&
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,& iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&

4
src/MarcInclude/creeps2018
View File

@ -6,12 +6,12 @@
! MSC.Marc include file ! MSC.Marc include file
! !
real(pReal) cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b 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 icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa
real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst
real(pReal) fraction_donn,timinc_ol2 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_creepsr=7)
parameter(num_creepsi=17) parameter(num_creepsi=17)
parameter(num_creeps2r=6) parameter(num_creeps2r=6)

4
src/MarcInclude/creeps2018.1
View File

@ -6,12 +6,12 @@
! MSC.Marc include file ! MSC.Marc include file
! !
real(pReal) cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b 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 icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa
real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst
real(pReal) fraction_donn,timinc_ol2 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_creepsr=7)
parameter(num_creepsi=17) parameter(num_creepsi=17)
parameter(num_creeps2r=6) parameter(num_creeps2r=6)

7
src/commercialFEM_fileList.f90
View File

@ -17,16 +17,15 @@
#include "geometry_plastic_nonlocal.f90" #include "geometry_plastic_nonlocal.f90"
#include "element.f90" #include "element.f90"
#include "mesh_base.f90" #include "mesh_base.f90"
#include "HDF5_utilities.f90"
#include "results.f90"
#include "discretization.f90"
#ifdef Abaqus #ifdef Abaqus
#include "mesh_abaqus.f90" #include "mesh_abaqus.f90"
#endif #endif
#ifdef Marc4DAMASK #ifdef Marc4DAMASK
#include "mesh_marc.f90" #include "mesh_marc.f90"
#endif #endif
#ifdef DAMASK_HDF5
#include "HDF5_utilities.f90"
#include "results.f90"
#endif
#include "material.f90" #include "material.f90"
#include "lattice.f90" #include "lattice.f90"
#include "source_thermal_dissipation.f90" #include "source_thermal_dissipation.f90"

348
src/constitutive.f90
View File

@ -5,9 +5,37 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module constitutive module constitutive
use math 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 implicit none
private private
integer, public, protected :: & integer, public, protected :: &
constitutive_plasticity_maxSizePostResults, & constitutive_plasticity_maxSizePostResults, &
constitutive_plasticity_maxSizeDotState, & constitutive_plasticity_maxSizeDotState, &
@ -37,74 +65,6 @@ contains
!> @brief allocates arrays pointing to array of the various constitutive modules !> @brief allocates arrays pointing to array of the various constitutive modules
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine constitutive_init 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, parameter :: FILEUNIT = 204
integer :: & integer :: &
@ -127,8 +87,11 @@ subroutine constitutive_init
if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_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_DISLOTWIN_ID)) call plastic_dislotwin_init
if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_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 ! initialize source mechanisms
if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init 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 !> ToDo: homogenizedC66 would be more consistent
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function constitutive_homogenizedC(ipc,ip,el) 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 real(pReal), dimension(6,6) :: constitutive_homogenizedC
integer, intent(in) :: & integer, intent(in) :: &
@ -310,23 +264,6 @@ end function constitutive_homogenizedC
!> @brief calls microstructure function of the different constitutive models !> @brief calls microstructure function of the different constitutive models
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine constitutive_microstructure(Fe, Fp, ipc, ip, el) 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) :: & integer, intent(in) :: &
ipc, & !< component-ID of integration point ipc, & !< component-ID of integration point
@ -366,35 +303,6 @@ end subroutine constitutive_microstructure
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
S, Fi, ipc, ip, el) 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) :: & integer, intent(in) :: &
ipc, & !< component-ID of integration point ipc, & !< component-ID of integration point
@ -446,7 +354,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
case (PLASTICITY_NONLOCAL_ID) plasticityType case (PLASTICITY_NONLOCAL_ID) plasticityType
call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp,Mp, & 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 case (PLASTICITY_DISLOTWIN_ID) plasticityType
of = phasememberAt(ipc,ip,el) of = phasememberAt(ipc,ip,el)
@ -475,26 +383,6 @@ end subroutine constitutive_LpAndItsTangents
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
S, Fi, ipc, ip, el) 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) :: & integer, intent(in) :: &
ipc, & !< component-ID of integration point ipc, & !< component-ID of integration point
@ -573,16 +461,6 @@ end subroutine constitutive_LiAndItsTangents
!> @brief collects initial intermediate deformation gradient !> @brief collects initial intermediate deformation gradient
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function constitutive_initialFi(ipc, ip, el) 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) :: & integer, intent(in) :: &
ipc, & !< component-ID of integration point ipc, & !< component-ID of integration point
@ -644,14 +522,6 @@ end subroutine constitutive_SandItsTangents
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, &
Fe, Fi, ipc, ip, el) 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) :: & integer, intent(in) :: &
ipc, & !< component-ID of integration point 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 !> @brief contains the constitutive equation for calculating the rate of change of microstructure
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip, el) 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) :: & integer, intent(in) :: &
ipc, & !< component-ID of integration point ipc, & !< component-ID of integration point
@ -755,7 +577,7 @@ subroutine constitutive_collectDotState(S, FeArray, Fi, FpArray, subdt, ipc, ip,
el !< element el !< element
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
subdt !< timestep 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 FeArray, & !< elastic deformation gradient
FpArray !< plastic deformation gradient FpArray !< plastic deformation gradient
real(pReal), intent(in), dimension(3,3) :: & 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 !> will return false if delta state is not needed/supported by the constitutive model
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el) 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) :: & integer, intent(in) :: &
ipc, & !< component-ID of integration point ipc, & !< component-ID of integration point
@ -903,49 +705,6 @@ end subroutine constitutive_collectDeltaState
!> @brief returns array of constitutive results !> @brief returns array of constitutive results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function constitutive_postResults(S, Fi, ipc, ip, el) 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) :: & integer, intent(in) :: &
ipc, & !< component-ID of integration point ipc, & !< component-ID of integration point
@ -1031,47 +790,18 @@ end function constitutive_postResults
!> @brief writes constitutive results to HDF5 output file !> @brief writes constitutive results to HDF5 output file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine constitutive_results 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 integer :: p
character(len=256) :: group character(len=256) :: group
#if defined(PETSc) || defined(DAMASK_HDF5)
do p=1,size(config_name_phase) do p=1,size(phase_name)
group = trim('current/constituent')//'/'//trim(config_name_phase(p)) group = trim('current/constituent')//'/'//trim(phase_name(p))
call HDF5_closeGroup(results_addGroup(group)) call HDF5_closeGroup(results_addGroup(group))
group = trim(group)//'/plastic' group = trim(group)//'/plastic'
call HDF5_closeGroup(results_addGroup(group)) call HDF5_closeGroup(results_addGroup(group))
select case(material_phase_plasticity_type(p)) select case(phase_plasticity(p))
case(PLASTICITY_ISOTROPIC_ID) case(PLASTICITY_ISOTROPIC_ID)
call plastic_isotropic_results(phase_plasticityInstance(p),group) call plastic_isotropic_results(phase_plasticityInstance(p),group)

100
src/crystallite.f90
View File

@ -20,13 +20,15 @@ module crystallite
use FEsolving use FEsolving
use material use material
use constitutive use constitutive
use discretization
use lattice use lattice
use future use future
use plastic_nonlocal 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 HDF5_utilities
use results use results
#endif
implicit none implicit none
private private
@ -172,8 +174,8 @@ subroutine crystallite_init
write(6,'(/,a)') ' <<<+- crystallite init -+>>>' write(6,'(/,a)') ' <<<+- crystallite init -+>>>'
cMax = homogenization_maxNgrains cMax = homogenization_maxNgrains
iMax = theMesh%elem%nIPs iMax = discretization_nIP
eMax = theMesh%nElems eMax = discretization_nElem
allocate(crystallite_S0(3,3,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_S0(3,3,cMax,iMax,eMax), source=0.0_pReal)
allocate(crystallite_partionedS0(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) case(elasmatrix_ID)
mySize = 36 mySize = 36
case(neighboringip_ID,neighboringelement_ID) case(neighboringip_ID,neighboringelement_ID)
mySize = theMesh%elem%nIPneighbors mySize = nIPneighbors
case default case default
mySize = 0 mySize = 0
end select end select
@ -361,7 +363,7 @@ subroutine crystallite_init
call IO_write_jobFile(FILEUNIT,'outputCrystallite') call IO_write_jobFile(FILEUNIT,'outputCrystallite')
do r = 1,size(config_crystallite) 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))//']' write(FILEUNIT,'(/,a,/)') '['//trim(crystallite_name(r))//']'
do o = 1,crystallite_Noutput(r) do o = 1,crystallite_Noutput(r)
write(FILEUNIT,'(a,i4)') trim(crystallite_output(o,r))//char(9),crystallite_sizePostResult(o,r) write(FILEUNIT,'(a,i4)') trim(crystallite_output(o,r))//char(9),crystallite_sizePostResult(o,r)
@ -379,7 +381,7 @@ subroutine crystallite_init
! initialize ! initialize
!$OMP PARALLEL DO PRIVATE(myNcomponents,i,c) !$OMP PARALLEL DO PRIVATE(myNcomponents,i,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2) 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 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_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) crystallite_Fi0(1:3,1:3,c,i,e) = constitutive_initialFi(c,i,e)
@ -407,7 +409,7 @@ subroutine crystallite_init
!$OMP PARALLEL DO !$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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), & call constitutive_microstructure(crystallite_Fe(1:3,1:3,c,i,e), &
crystallite_Fp(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 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)') ' # of elements: ', eMax
write(6,'(a42,1x,i10)') 'max # of integration points/element: ', iMax 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 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) write(6,'(a42,1x,i10)') ' # of nonlocal constituents: ',count(.not. crystallite_localPlasticity)
flush(6) flush(6)
endif endif
@ -441,7 +442,7 @@ end subroutine crystallite_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC) 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 :: & real(pReal), intent(in), optional :: &
dummyArgumentToPreventInternalCompilerErrorWithGCC dummyArgumentToPreventInternalCompilerErrorWithGCC
real(pReal) :: & real(pReal) :: &
@ -480,7 +481,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
crystallite_subStep = 0.0_pReal crystallite_subStep = 0.0_pReal
!$OMP PARALLEL DO !$OMP PARALLEL DO
elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) 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 homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then
plasticState (phaseAt(c,i,e))%subState0( :,phasememberAt(c,i,e)) = & plasticState (phaseAt(c,i,e))%subState0( :,phasememberAt(c,i,e)) = &
plasticState (phaseAt(c,i,e))%partionedState0(:,phasememberAt(c,i,e)) plasticState (phaseAt(c,i,e))%partionedState0(:,phasememberAt(c,i,e))
@ -510,7 +511,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
endIP = startIP endIP = startIP
else singleRun else singleRun
startIP = 1 startIP = 1
endIP = theMesh%elem%nIPs endIP = discretization_nIP
endif singleRun endif singleRun
NiterationCrystallite = 0 NiterationCrystallite = 0
@ -524,7 +525,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
!$OMP PARALLEL DO PRIVATE(formerSubStep) !$OMP PARALLEL DO PRIVATE(formerSubStep)
elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 ! wind forward
if (crystallite_converged(c,i,e)) then if (crystallite_converged(c,i,e)) then
@ -646,7 +647,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
#ifdef DEBUG #ifdef DEBUG
elementLooping6: do e = FEsolving_execElem(1),FEsolving_execElem(2) elementLooping6: do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 (.not. crystallite_converged(c,i,e)) then
if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) & 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 ', & 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) !$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) elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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, & call constitutive_SandItsTangents(devNull,dSdFe,dSdFi, &
crystallite_Fe(1:3,1:3,c,i,e), & crystallite_Fe(1:3,1:3,c,i,e), &
@ -829,7 +830,7 @@ subroutine crystallite_orientations
!$OMP PARALLEL DO !$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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)))) call crystallite_orientation(c,i,e)%fromRotationMatrix(transpose(math_rotationalPart33(crystallite_Fe(1:3,1:3,c,i,e))))
enddo; enddo; enddo enddo; enddo; enddo
!$OMP END PARALLEL DO !$OMP END PARALLEL DO
@ -851,11 +852,6 @@ end subroutine crystallite_orientations
!> @brief Map 2nd order tensor to reference config !> @brief Map 2nd order tensor to reference config
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function crystallite_push33ToRef(ipc,ip,el, tensor33) 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) :: crystallite_push33ToRef
real(pReal), dimension(3,3), intent(in) :: tensor33 real(pReal), dimension(3,3), intent(in) :: tensor33
@ -882,12 +878,10 @@ function crystallite_postResults(ipc, ip, el)
ip, & !< integration point index ip, & !< integration point index
ipc !< grain 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 + & 1+plasticState(material_phase(ipc,ip,el))%sizePostResults + &
sum(sourceState(material_phase(ipc,ip,el))%p(:)%sizePostResults)) :: & sum(sourceState(material_phase(ipc,ip,el))%p(:)%sizePostResults)) :: &
crystallite_postResults crystallite_postResults
real(pReal) :: &
detF
integer :: & integer :: &
o, & o, &
c, & c, &
@ -896,7 +890,7 @@ function crystallite_postResults(ipc, ip, el)
n n
type(rotation) :: rot type(rotation) :: rot
crystID = microstructure_crystallite(mesh_element(4,el)) crystID = microstructure_crystallite(discretization_microstructureAt(el))
crystallite_postResults = 0.0_pReal crystallite_postResults = 0.0_pReal
crystallite_postResults(1) = real(crystallite_sizePostResults(crystID),pReal) ! header-like information (length) crystallite_postResults(1) = real(crystallite_sizePostResults(crystID),pReal) ! header-like information (length)
@ -960,15 +954,15 @@ function crystallite_postResults(ipc, ip, el)
mySize = 36 mySize = 36
crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize]) crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize])
case(neighboringelement_ID) case(neighboringelement_ID)
mySize = theMesh%elem%nIPneighbors mySize = nIPneighbors
crystallite_postResults(c+1:c+mySize) = 0.0_pReal crystallite_postResults(c+1:c+mySize) = 0.0_pReal
forall (n = 1:mySize) & 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) case(neighboringip_ID)
mySize = theMesh%elem%nIPneighbors mySize = nIPneighbors
crystallite_postResults(c+1:c+mySize) = 0.0_pReal crystallite_postResults(c+1:c+mySize) = 0.0_pReal
forall (n = 1:mySize) & 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 end select
c = c + mySize c = c + mySize
enddo enddo
@ -1064,10 +1058,6 @@ subroutine crystallite_results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function select_tensors(dataset,instance) function select_tensors(dataset,instance)
use material, only: &
homogenization_maxNgrains, &
material_phaseAt
integer, intent(in) :: instance integer, intent(in) :: instance
real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset
real(pReal), allocatable, dimension(:,:,:) :: select_tensors real(pReal), allocatable, dimension(:,:,:) :: select_tensors
@ -1095,10 +1085,6 @@ subroutine crystallite_results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function select_rotations(dataset,instance) function select_rotations(dataset,instance)
use material, only: &
homogenization_maxNgrains, &
material_phaseAt
integer, intent(in) :: instance integer, intent(in) :: instance
type(rotation), dimension(:,:,:), intent(in) :: dataset type(rotation), dimension(:,:,:), intent(in) :: dataset
type(rotation), allocatable, dimension(:) :: select_rotations type(rotation), allocatable, dimension(:) :: select_rotations
@ -1567,7 +1553,7 @@ subroutine integrateStateFPI
!$OMP PARALLEL DO PRIVATE(p,c) !$OMP PARALLEL DO PRIVATE(p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e) 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) !$OMP DO PRIVATE(sizeDotState,residuum_plastic,residuum_source,zeta,p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e) p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
sizeDotState = plasticState(p)%sizeDotState sizeDotState = plasticState(p)%sizeDotState
@ -1650,7 +1636,7 @@ subroutine integrateStateFPI
!$OMP DO !$OMP DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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) !$OMP FLUSH(crystallite_todo)
if (crystallite_todo(g,i,e) .and. crystallite_converged(g,i,e)) then ! converged and still alive... 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) crystallite_todo(g,i,e) = stateJump(g,i,e)
@ -1676,7 +1662,7 @@ subroutine integrateStateFPI
doneWithIntegration = .true. doneWithIntegration = .true.
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
doneWithIntegration = .false. doneWithIntegration = .false.
exit 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 ! 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, & real(pReal), dimension(constitutive_plasticity_maxSizeDotState, &
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
residuum_plastic residuum_plastic
real(pReal), dimension(constitutive_source_maxSizeDotState,& real(pReal), dimension(constitutive_source_maxSizeDotState,&
maxval(phase_Nsources), & maxval(phase_Nsources), &
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
residuum_source residuum_source
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1758,7 +1744,7 @@ subroutine integrateStateAdaptiveEuler
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,c) !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e) p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
sizeDotState = plasticState(p)%sizeDotState sizeDotState = plasticState(p)%sizeDotState
@ -1787,7 +1773,7 @@ subroutine integrateStateAdaptiveEuler
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,c) !$OMP PARALLEL DO PRIVATE(sizeDotState,p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e) p = phaseAt(g,i,e); c = phasememberAt(g,i,e)
sizeDotState = plasticState(p)%sizeDotState sizeDotState = plasticState(p)%sizeDotState
@ -1847,7 +1833,7 @@ subroutine integrateStateRK4
!$OMP PARALLEL DO PRIVATE(p,c) !$OMP PARALLEL DO PRIVATE(p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e) 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 ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of RKCK45
real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & 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 residuum_plastic ! relative residuum from evolution in microstructure
real(pReal), dimension(constitutive_source_maxSizeDotState, & real(pReal), dimension(constitutive_source_maxSizeDotState, &
maxval(phase_Nsources), & maxval(phase_Nsources), &
homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & homogenization_maxNgrains,discretization_nIP,discretization_nElem) :: &
residuum_source ! relative residuum from evolution in microstructure residuum_source ! relative residuum from evolution in microstructure
@ -1938,7 +1924,7 @@ subroutine integrateStateRKCK45
!$OMP PARALLEL DO PRIVATE(p,cc) !$OMP PARALLEL DO PRIVATE(p,cc)
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) p = phaseAt(g,i,e); cc = phasememberAt(g,i,e)
@ -1978,7 +1964,7 @@ subroutine integrateStateRKCK45
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc) !$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc)
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) p = phaseAt(g,i,e); cc = phasememberAt(g,i,e)
@ -2017,7 +2003,7 @@ subroutine integrateStateRKCK45
!$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc) !$OMP PARALLEL DO PRIVATE(sizeDotState,p,cc)
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 if (crystallite_todo(g,i,e)) then
p = phaseAt(g,i,e); cc = phasememberAt(g,i,e) p = phaseAt(g,i,e); cc = phasememberAt(g,i,e)
@ -2075,7 +2061,7 @@ subroutine setConvergenceFlag
!OMP DO PARALLEL PRIVATE !OMP DO PARALLEL PRIVATE
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 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 enddo; enddo; enddo
!OMP END DO PARALLEL !OMP END DO PARALLEL
@ -2115,7 +2101,7 @@ subroutine update_stress(timeFraction)
!$OMP PARALLEL DO !$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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) !$OMP FLUSH(crystallite_todo)
if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
crystallite_todo(g,i,e) = integrateStress(g,i,e,timeFraction) crystallite_todo(g,i,e) = integrateStress(g,i,e,timeFraction)
@ -2145,7 +2131,7 @@ subroutine update_dependentState
!$OMP PARALLEL DO !$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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)) & 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), & call constitutive_dependentState(crystallite_Fe(1:3,1:3,g,i,e), &
crystallite_Fp(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) !$OMP PARALLEL DO PRIVATE(mySize,p,c)
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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 if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then
p = phaseAt(g,i,e); c = phasememberAt(g,i,e) 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) !$OMP PARALLEL DO PRIVATE (p,c,NaN)
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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) !$OMP FLUSH(nonlocalStop)
if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then 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), & 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) !$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize,NaN)
do e = FEsolving_execElem(1),FEsolving_execElem(2) do e = FEsolving_execElem(1),FEsolving_execElem(2)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) 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) !$OMP FLUSH(nonlocalStop)
if ((crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) .and. .not. nonlocalStop) then 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), & call constitutive_collectDeltaState(crystallite_S(1:3,1:3,g,i,e), &

366
src/damage_local.f90
View File

@ -3,43 +3,46 @@
!> @brief material subroutine for locally evolving damage field !> @brief material subroutine for locally evolving damage field
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module damage_local module damage_local
use prec use prec
use material use material
use numerics use numerics
use config use config
use source_damage_isoBrittle
use source_damage_isoDuctile
use source_damage_anisoBrittle
use source_damage_anisoDuctile
implicit none implicit none
private private
integer, dimension(:,:), allocatable, target, public :: & integer, dimension(:,:), allocatable, target, public :: &
damage_local_sizePostResult !< size of each post result output 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 :: & enum, bind(c)
damage_local_output !< name of each post result output enumerator :: &
undefined_ID, &
integer, dimension(:), allocatable, target, public :: & damage_ID
damage_local_Noutput !< number of outputs per instance of this damage end enum
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
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 contains
@ -49,167 +52,160 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine damage_local_init subroutine damage_local_init
integer :: maxNinstance,homog,instance,i integer :: maxNinstance,homog,instance,i
integer :: sizeState integer :: sizeState
integer :: NofMyHomog, h integer :: NofMyHomog, h
integer(kind(undefined_ID)) :: & integer(kind(undefined_ID)) :: &
outputID outputID
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
character(len=65536), dimension(:), allocatable :: & character(len=65536), dimension(:), allocatable :: &
outputs 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))
do h = 1, size(damage_type) write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>'
if (damage_type(h) /= DAMAGE_LOCAL_ID) cycle
associate(prm => param(damage_typeInstance(h)), &
config => config_homogenization(h))
outputs = config%getStrings('(output)',defaultVal=emptyStringArray) maxNinstance = count(damage_type == DAMAGE_local_ID)
allocate(prm%outputID(0)) 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) do h = 1, size(damage_type)
outputID = undefined_ID if (damage_type(h) /= DAMAGE_LOCAL_ID) cycle
select case(outputs(i)) associate(prm => param(damage_typeInstance(h)), &
config => config_homogenization(h))
case ('damage')
damage_local_output(i,damage_typeInstance(h)) = outputs(i)
damage_local_Noutput(instance) = damage_local_Noutput(instance) + 1 outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
damage_local_sizePostResult(i,damage_typeInstance(h)) = 1 allocate(prm%outputID(0))
prm%outputID = [prm%outputID , damage_ID]
end select do i=1, size(outputs)
outputID = undefined_ID
enddo 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) NofMyHomog = count(material_homogenizationAt == homog)
instance = damage_typeInstance(homog) instance = damage_typeInstance(homog)
! allocate state arrays ! allocate state arrays
sizeState = 1 sizeState = 1
damageState(homog)%sizeState = sizeState damageState(homog)%sizeState = sizeState
damageState(homog)%sizePostResults = sum(damage_local_sizePostResult(:,instance)) damageState(homog)%sizePostResults = sum(damage_local_sizePostResult(:,instance))
allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog))
allocate(damageState(homog)%subState0(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)) allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog))
nullify(damageMapping(homog)%p) nullify(damageMapping(homog)%p)
damageMapping(homog)%p => mappingHomogenization(1,:,:) damageMapping(homog)%p => mappingHomogenization(1,:,:)
deallocate(damage(homog)%p) deallocate(damage(homog)%p)
damage(homog)%p => damageState(homog)%state(1,:) damage(homog)%p => damageState(homog)%state(1,:)
end associate end associate
enddo enddo
end subroutine damage_local_init end subroutine damage_local_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief calculates local change in damage field !> @brief calculates local change in damage field
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function damage_local_updateState(subdt, ip, el) function damage_local_updateState(subdt, ip, el)
integer, intent(in) :: & integer, intent(in) :: &
ip, & !< integration point number ip, & !< integration point number
el !< element number el !< element number
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
subdt subdt
logical, dimension(2) :: & logical, dimension(2) :: &
damage_local_updateState damage_local_updateState
integer :: & integer :: &
homog, & homog, &
offset offset
real(pReal) :: & real(pReal) :: &
phi, phiDot, dPhiDot_dPhi phi, phiDot, dPhiDot_dPhi
homog = material_homogenizationAt(el) homog = material_homogenizationAt(el)
offset = mappingHomogenization(1,ip,el) offset = mappingHomogenization(1,ip,el)
phi = damageState(homog)%subState0(1,offset) phi = damageState(homog)%subState0(1,offset)
call damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) call damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
phi = max(residualStiffness,min(1.0_pReal,phi + subdt*phiDot)) phi = max(residualStiffness,min(1.0_pReal,phi + subdt*phiDot))
damage_local_updateState = [ abs(phi - damageState(homog)%state(1,offset)) & damage_local_updateState = [ abs(phi - damageState(homog)%state(1,offset)) &
<= err_damage_tolAbs & <= err_damage_tolAbs &
.or. abs(phi - damageState(homog)%state(1,offset)) & .or. abs(phi - damageState(homog)%state(1,offset)) &
<= err_damage_tolRel*abs(damageState(homog)%state(1,offset)), & <= err_damage_tolRel*abs(damageState(homog)%state(1,offset)), &
.true.] .true.]
damageState(homog)%state(1,offset) = phi damageState(homog)%state(1,offset) = phi
end function damage_local_updateState end function damage_local_updateState
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief calculates homogenized local damage driving forces !> @brief calculates homogenized local damage driving forces
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
use source_damage_isoBrittle, only: &
source_damage_isobrittle_getRateAndItsTangent integer, intent(in) :: &
use source_damage_isoDuctile, only: & ip, & !< integration point number
source_damage_isoductile_getRateAndItsTangent el !< element number
use source_damage_anisoBrittle, only: & real(pReal), intent(in) :: &
source_damage_anisobrittle_getRateAndItsTangent phi
use source_damage_anisoDuctile, only: & integer :: &
source_damage_anisoductile_getRateAndItsTangent phase, &
grain, &
integer, intent(in) :: & source, &
ip, & !< integration point number constituent
el !< element number real(pReal) :: &
real(pReal), intent(in) :: & phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi
phi
integer :: &
phase, &
grain, &
source, &
constituent
real(pReal) :: &
phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi
phiDot = 0.0_pReal phiDot = 0.0_pReal
dPhiDot_dPhi = 0.0_pReal dPhiDot_dPhi = 0.0_pReal
do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
phase = phaseAt(grain,ip,el) phase = phaseAt(grain,ip,el)
constituent = phasememberAt(grain,ip,el) constituent = phasememberAt(grain,ip,el)
do source = 1, phase_Nsources(phase) do source = 1, phase_Nsources(phase)
select case(phase_source(source,phase)) select case(phase_source(source,phase))
case (SOURCE_damage_isoBrittle_ID) case (SOURCE_damage_isoBrittle_ID)
call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_isoDuctile_ID) case (SOURCE_damage_isoDuctile_ID)
call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_anisoBrittle_ID) case (SOURCE_damage_anisoBrittle_ID)
call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case (SOURCE_damage_anisoDuctile_ID) case (SOURCE_damage_anisoDuctile_ID)
call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
case default case default
localphiDot = 0.0_pReal localphiDot = 0.0_pReal
dLocalphiDot_dPhi = 0.0_pReal dLocalphiDot_dPhi = 0.0_pReal
end select end select
phiDot = phiDot + localphiDot phiDot = phiDot + localphiDot
dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi
enddo enddo
enddo enddo
phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
end subroutine damage_local_getSourceAndItsTangent end subroutine damage_local_getSourceAndItsTangent
@ -219,31 +215,31 @@ end subroutine damage_local_getSourceAndItsTangent
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function damage_local_postResults(ip,el) function damage_local_postResults(ip,el)
integer, intent(in) :: & integer, intent(in) :: &
ip, & !< integration point ip, & !< integration point
el !< element el !< element
real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: & real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: &
damage_local_postResults damage_local_postResults
integer :: & integer :: instance, homog, offset, o, c
instance, homog, offset, o, c
homog = material_homogenizationAt(el)
homog = material_homogenizationAt(el) offset = damageMapping(homog)%p(ip,el)
offset = damageMapping(homog)%p(ip,el) instance = damage_typeInstance(homog)
instance = damage_typeInstance(homog) associate(prm => param(instance))
associate(prm => param(instance)) c = 0
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 function damage_local_postResults
end module damage_local end module damage_local

27
src/damage_nonlocal.f90
View File

@ -19,26 +19,25 @@ module damage_nonlocal
implicit none implicit none
private private
integer, dimension(:,:), allocatable, target, public :: & integer, dimension(:,:), allocatable, target, public :: &
damage_nonlocal_sizePostResult !< size of each post result output damage_nonlocal_sizePostResult
character(len=64), dimension(:,:), allocatable, target, public :: &
character(len=64), dimension(:,:), allocatable, target, public :: & damage_nonlocal_output
damage_nonlocal_output !< name of each post result output integer, dimension(:), allocatable, target, public :: &
damage_nonlocal_Noutput
integer, dimension(:), allocatable, target, public :: &
damage_nonlocal_Noutput !< number of outputs per instance of this damage
enum, bind(c) enum, bind(c)
enumerator :: undefined_ID, & enumerator :: &
damage_ID undefined_ID, &
damage_ID
end enum end enum
type :: tParameters type :: tParameters
integer(kind(undefined_ID)), dimension(:), allocatable :: & integer(kind(undefined_ID)), dimension(:), allocatable :: &
outputID outputID
end type tParameters end type tParameters
type(tparameters), dimension(:), allocatable :: & type(tparameters), dimension(:), allocatable :: &
param param
public :: & public :: &
@ -217,12 +216,12 @@ real(pReal) function damage_nonlocal_getMobility(ip,el)
damage_nonlocal_getMobility = 0.0_pReal 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)) damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el))
enddo enddo
damage_nonlocal_getMobility = damage_nonlocal_getMobility/& 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 end function damage_nonlocal_getMobility

110
src/debug.f90
View File

@ -12,49 +12,49 @@ module debug
implicit none implicit none
private private
integer(pInt), parameter, public :: & integer, parameter, public :: &
debug_LEVELSELECTIVE = 2_pInt**0_pInt, & debug_LEVELSELECTIVE = 2**0, &
debug_LEVELBASIC = 2_pInt**1_pInt, & debug_LEVELBASIC = 2**1, &
debug_LEVELEXTENSIVE = 2_pInt**2_pInt debug_LEVELEXTENSIVE = 2**2
integer(pInt), parameter, private :: & integer, parameter, private :: &
debug_MAXGENERAL = debug_LEVELEXTENSIVE ! must be set to the last bitcode used by (potentially) all debug types debug_MAXGENERAL = debug_LEVELEXTENSIVE ! must be set to the last bitcode used by (potentially) all debug types
integer(pInt), parameter, public :: & integer, parameter, public :: &
debug_SPECTRALRESTART = debug_MAXGENERAL*2_pInt**1_pInt, & debug_SPECTRALRESTART = debug_MAXGENERAL*2**1, &
debug_SPECTRALFFTW = debug_MAXGENERAL*2_pInt**2_pInt, & debug_SPECTRALFFTW = debug_MAXGENERAL*2**2, &
debug_SPECTRALDIVERGENCE = debug_MAXGENERAL*2_pInt**3_pInt, & debug_SPECTRALDIVERGENCE = debug_MAXGENERAL*2**3, &
debug_SPECTRALROTATION = debug_MAXGENERAL*2_pInt**4_pInt, & debug_SPECTRALROTATION = debug_MAXGENERAL*2**4, &
debug_SPECTRALPETSC = debug_MAXGENERAL*2_pInt**5_pInt debug_SPECTRALPETSC = debug_MAXGENERAL*2**5
integer(pInt), parameter, public :: & integer, parameter, public :: &
debug_DEBUG = 1_pInt, & debug_DEBUG = 1, &
debug_MATH = 2_pInt, & debug_MATH = 2, &
debug_FESOLVING = 3_pInt, & debug_FESOLVING = 3, &
debug_MESH = 4_pInt, & !< stores debug level for mesh part of DAMASK bitwise coded debug_MESH = 4, & !< 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_MATERIAL = 5, & !< 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_LATTICE = 6, & !< 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_CONSTITUTIVE = 7, & !< stores debug level for constitutive part of DAMASK bitwise coded
debug_CRYSTALLITE = 8_pInt, & debug_CRYSTALLITE = 8, &
debug_HOMOGENIZATION = 9_pInt, & debug_HOMOGENIZATION = 9, &
debug_CPFEM = 10_pInt, & debug_CPFEM = 10, &
debug_SPECTRAL = 11_pInt, & debug_SPECTRAL = 11, &
debug_MARC = 12_pInt, & debug_MARC = 12, &
debug_ABAQUS = 13_pInt debug_ABAQUS = 13
integer(pInt), parameter, private :: & integer, parameter, private :: &
debug_MAXNTYPE = debug_ABAQUS !< must be set to the maximum defined debug type 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" integer,protected, dimension(debug_maxNtype+2), public :: & ! specific ones, and 2 for "all" and "other"
debug_level = 0_pInt debug_level = 0
integer(pInt), protected, public :: & integer, protected, public :: &
debug_e = 1_pInt, & debug_e = 1, &
debug_i = 1_pInt, & debug_i = 1, &
debug_g = 1_pInt debug_g = 1
integer(pInt), dimension(2), public :: & integer, dimension(2), public :: &
debug_stressMaxLocation = 0_pInt, & debug_stressMaxLocation = 0, &
debug_stressMinLocation = 0_pInt, & debug_stressMinLocation = 0, &
debug_jacobianMaxLocation = 0_pInt, & debug_jacobianMaxLocation = 0, &
debug_jacobianMinLocation = 0_pInt debug_jacobianMinLocation = 0
real(pReal), public :: & real(pReal), public :: &
@ -100,17 +100,17 @@ subroutine debug_init
line = fileContent(j) line = fileContent(j)
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line) 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) select case(tag)
case ('element','e','el') case ('element','e','el')
debug_e = IO_intValue(line,chunkPos,2_pInt) debug_e = IO_intValue(line,chunkPos,2)
case ('integrationpoint','i','ip') case ('integrationpoint','i','ip')
debug_i = IO_intValue(line,chunkPos,2_pInt) debug_i = IO_intValue(line,chunkPos,2)
case ('grain','g','gr') case ('grain','g','gr')
debug_g = IO_intValue(line,chunkPos,2_pInt) debug_g = IO_intValue(line,chunkPos,2)
end select end select
what = 0_pInt what = 0
select case(tag) select case(tag)
case ('debug') case ('debug')
what = debug_DEBUG what = debug_DEBUG
@ -139,12 +139,12 @@ subroutine debug_init
case ('abaqus') case ('abaqus')
what = debug_ABAQUS what = debug_ABAQUS
case ('all') case ('all')
what = debug_MAXNTYPE + 1_pInt what = debug_MAXNTYPE + 1
case ('other') case ('other')
what = debug_MAXNTYPE + 2_pInt what = debug_MAXNTYPE + 2
end select end select
if (what /= 0) then if (what /= 0) then
do i = 2_pInt, chunkPos(1) do i = 2, chunkPos(1)
select case(IO_lc(IO_stringValue(line,chunkPos,i))) select case(IO_lc(IO_stringValue(line,chunkPos,i)))
case('basic') case('basic')
debug_level(what) = ior(debug_level(what), debug_LEVELBASIC) debug_level(what) = ior(debug_level(what), debug_LEVELBASIC)
@ -167,11 +167,11 @@ subroutine debug_init
endif endif
enddo enddo
do i = 1_pInt, debug_maxNtype do i = 1, debug_maxNtype
if (debug_level(i) == 0) & 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 enddo
if (iand(debug_level(debug_debug),debug_LEVELBASIC) /= 0) & 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) ! output switched on (debug level for debug must be extensive)
if (iand(debug_level(debug_debug),debug_LEVELEXTENSIVE) /= 0) then if (iand(debug_level(debug_debug),debug_LEVELEXTENSIVE) /= 0) then
do i = 1_pInt, debug_MAXNTYPE do i = 1, debug_MAXNTYPE
select case(i) select case(i)
case (debug_DEBUG) case (debug_DEBUG)
tag = ' Debug' tag = ' Debug'
@ -241,10 +241,10 @@ end subroutine debug_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine debug_reset subroutine debug_reset
debug_stressMaxLocation = 0_pInt debug_stressMaxLocation = 0
debug_stressMinLocation = 0_pInt debug_stressMinLocation = 0
debug_jacobianMaxLocation = 0_pInt debug_jacobianMaxLocation = 0
debug_jacobianMinLocation = 0_pInt debug_jacobianMinLocation = 0
debug_stressMax = -huge(1.0_pReal) debug_stressMax = -huge(1.0_pReal)
debug_stressMin = huge(1.0_pReal) debug_stressMin = huge(1.0_pReal)
debug_jacobianMax = -huge(1.0_pReal) debug_jacobianMax = -huge(1.0_pReal)
@ -260,8 +260,8 @@ subroutine debug_info
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 & debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 &
.and. any(debug_stressMinLocation /= 0_pInt) & .and. any(debug_stressMinLocation /= 0) &
.and. any(debug_stressMaxLocation /= 0_pInt) ) then .and. any(debug_stressMaxLocation /= 0) ) then
write(6,'(2/,a,/)') ' Extreme values of returned stress and Jacobian' write(6,'(2/,a,/)') ' Extreme values of returned stress and Jacobian'
write(6,'(a39)') ' value el ip' write(6,'(a39)') ' value el ip'
write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation

82
src/discretization.f90 Normal file
View File

@ -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

20
src/element.f90
View File

@ -4,6 +4,7 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module element module element
use prec use prec
use IO
implicit none implicit none
private private
@ -27,7 +28,7 @@ module element
NnodeAtIP, & NnodeAtIP, &
IPneighbor, & IPneighbor, &
cellFace cellFace
real(pReal), dimension(:,:), allocatable :: & integer, dimension(:,:), allocatable :: &
! center of gravity of the weighted nodes gives the position of the cell node. ! 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, ! 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 ! 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 6 & ! 3D 8node
] !< number of ip neighbors / cell faces in a specific cell type ] !< 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 = & integer, dimension(4), parameter, private :: NCELLNODEPERCELLFACE = &
[ & [ &
2, & ! 2D 3node 2, & ! 2D 3node
@ -162,6 +163,10 @@ module element
8 & ! 3D 8node 8 & ! 3D 8node
] !< number of cell nodes in a specific cell type ] !< number of cell nodes in a specific cell type
! --------------------------------------------------------------------------------------------------
! MD: probably not needed START
integer, dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = & integer, dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = &
reshape([& reshape([&
1,2,3 & 1,2,3 &
@ -265,8 +270,7 @@ module element
7,8, 0,0, & 7,8, 0,0, &
7,0, 0,0 & 7,0, 0,0 &
],[maxNnodeAtIP(10),nIP(10)]) ],[maxNnodeAtIP(10),nIP(10)])
! *** FE_ipNeighbor *** ! *** FE_ipNeighbor ***
! is a list of the neighborhood of each IP. ! is a list of the neighborhood of each IP.
! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction.
@ -376,7 +380,11 @@ module element
27,25,-4,23,-6,17, & 27,25,-4,23,-6,17, &
-3,26,-4,24,-6,18 & -3,26,-4,24,-6,18 &
],[nIPneighbor(cellType(10)),nIP(10)]) ],[nIPneighbor(cellType(10)),nIP(10)])
! MD: probably not needed END
! --------------------------------------------------------------------------------------------------
real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = & real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = &
reshape(real([& reshape(real([&
@ -798,8 +806,6 @@ module element
contains contains
subroutine tElement_init(self,elemType) subroutine tElement_init(self,elemType)
use IO, only: &
IO_error
class(tElement) :: self class(tElement) :: self
integer, intent(in) :: elemType integer, intent(in) :: elemType

10
src/future.f90
View File

@ -3,7 +3,11 @@
!> @brief New fortran functions for compiler versions that do not support them !> @brief New fortran functions for compiler versions that do not support them
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module future module future
use prec
implicit none
public public
contains contains
#if defined(__GFORTRAN__) || __INTEL_COMPILER < 1800 #if defined(__GFORTRAN__) || __INTEL_COMPILER < 1800
@ -11,6 +15,7 @@ contains
!> @brief substitute for the findloc intrinsic (only for integer, dimension(:) at the moment) !> @brief substitute for the findloc intrinsic (only for integer, dimension(:) at the moment)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function findloc(a,v) function findloc(a,v)
integer, intent(in), dimension(:) :: a integer, intent(in), dimension(:) :: a
integer, intent(in) :: v integer, intent(in) :: v
integer :: i,j integer :: i,j
@ -29,13 +34,10 @@ end function findloc
#if defined(__PGI) #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) real(pReal) pure function norm2(v)
use prec, only: &
pReal
implicit none
real(pReal), intent(in), dimension(3) :: v real(pReal), intent(in), dimension(3) :: v
norm2 = sqrt(sum(v**2)) norm2 = sqrt(sum(v**2))

113
src/geometry_plastic_nonlocal.f90
View File

@ -10,43 +10,106 @@ module geometry_plastic_nonlocal
implicit none implicit none
private 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 integer, dimension(:,:,:,:), intent(in) :: IPneighborhood
geometry_plastic_nonlocal_IPneighborhood = 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 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 end module geometry_plastic_nonlocal

65
src/grid/grid_damage_spectral.f90
View File

@ -9,14 +9,17 @@ module grid_damage_spectral
#include <petsc/finclude/petscdmda.h> #include <petsc/finclude/petscdmda.h>
use PETScdmda use PETScdmda
use PETScsnes use PETScsnes
use prec, only: &
pReal use prec
use spectral_utilities, only: & use spectral_utilities
tSolutionState, & use mesh
tSolutionParams use damage_nonlocal
use numerics
use damage_nonlocal
implicit none implicit none
private private
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! derived types ! derived types
type(tSolutionParams), private :: params type(tSolutionParams), private :: params
@ -51,18 +54,6 @@ contains
! ToDo: Restart not implemented ! ToDo: Restart not implemented
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_damage_spectral_init 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 PetscInt, dimension(worldsize) :: localK
integer :: i, j, k, cell 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 !> @brief solution for the spectral damage scheme with internal iterations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function grid_damage_spectral_solution(timeinc,timeinc_old,loadCaseTime) result(solution) 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) :: & real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution timeinc, & !< increment in time for current solution
@ -223,17 +205,7 @@ end function grid_damage_spectral_solution
!> @brief spectral damage forwarding routine !> @brief spectral damage forwarding routine
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_damage_spectral_forward 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 integer :: i, j, k, cell
DM :: dm_local DM :: dm_local
PetscScalar, dimension(:,:,:), pointer :: x_scal PetscScalar, dimension(:,:,:), pointer :: x_scal
@ -278,25 +250,6 @@ end subroutine grid_damage_spectral_forward
!> @brief forms the spectral damage residual vector !> @brief forms the spectral damage residual vector
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine formResidual(in,x_scal,f_scal,dummy,ierr) 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) :: & DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
in in

112
src/grid/grid_mech_FEM.f90
View File

@ -11,13 +11,18 @@ module grid_mech_FEM
use HDF5_utilities use HDF5_utilities
use PETScdmda use PETScdmda
use PETScsnes use PETScsnes
use prec, only: & use prec
pReal use CPFEM2
use math, only: & use IO
math_I3 use debug
use spectral_utilities, only: & use FEsolving
tSolutionState, & use numerics
tSolutionParams use homogenization
use DAMASK_interface
use spectral_utilities
use discretization
use mesh
use math
implicit none implicit none
private private
@ -74,30 +79,6 @@ contains
!> @brief allocates all necessary fields and fills them with data, potentially from restart info !> @brief allocates all necessary fields and fills them with data, potentially from restart info
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_mech_FEM_init 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 real(pReal) :: HGCoeff = 0e-2_pReal
PetscInt, dimension(:), allocatable :: localK PetscInt, dimension(:), allocatable :: localK
@ -243,14 +224,6 @@ end subroutine grid_mech_FEM_init
!> @brief solution for the FEM scheme with internal iterations !> @brief solution for the FEM scheme with internal iterations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function grid_mech_FEM_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) result(solution) 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 ! 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 !> 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) 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) :: & logical, intent(in) :: &
guess guess
@ -422,17 +376,6 @@ end subroutine grid_mech_FEM_forward
!> @brief convergence check !> @brief convergence check
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,ierr) 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 SNES :: snes_local
PetscInt, intent(in) :: PETScIter PetscInt, intent(in) :: PETScIter
@ -481,28 +424,6 @@ end subroutine converged
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine formResidual(da_local,x_local, & subroutine formResidual(da_local,x_local, &
f_local,dummy,ierr) 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 DM :: da_local
Vec :: x_local, f_local Vec :: x_local, f_local
@ -617,12 +538,7 @@ end subroutine formResidual
!> @brief forms the FEM stiffness matrix !> @brief forms the FEM stiffness matrix
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr) subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr)
use mesh, only: &
mesh_ipCoordinates
use homogenization, only: &
materialpoint_dPdF
DM :: da_local DM :: da_local
Vec :: x_local, coordinates Vec :: x_local, coordinates
Mat :: Jac_pre, Jac Mat :: Jac_pre, Jac
@ -699,7 +615,7 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr)
ele = 0 ele = 0
do k = zstart, zend; do j = ystart, yend; do i = xstart, xend do k = zstart, zend; do j = ystart, yend; do i = xstart, xend
ele = ele + 1 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 enddo; enddo; enddo
call DMDAVecRestoreArrayF90(da_local,coordinates,x_scal,ierr);CHKERRQ(ierr) ! initialize to undeformed coordinates (ToDo: use ip coordinates) 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 call MatNullSpaceCreateRigidBody(coordinates,matnull,ierr);CHKERRQ(ierr) ! get rigid body deformation modes

111
src/grid/grid_mech_spectral_basic.f90
View File

@ -7,18 +7,23 @@
module grid_mech_spectral_basic module grid_mech_spectral_basic
#include <petsc/finclude/petscsnes.h> #include <petsc/finclude/petscsnes.h>
#include <petsc/finclude/petscdmda.h> #include <petsc/finclude/petscdmda.h>
use DAMASK_interface
use HDF5_utilities
use PETScdmda use PETScdmda
use PETScsnes use PETScsnes
use prec, only: &
pReal use prec
use math, only: & use DAMASK_interface
math_I3 use HDF5_utilities
use spectral_utilities, only: & use math
tSolutionState, & use spectral_utilities
tSolutionParams use IO
use FEsolving
use config
use numerics
use homogenization
use mesh
use CPFEM2
use debug
implicit none implicit none
private private
@ -81,31 +86,6 @@ contains
!> @brief allocates all necessary fields and fills them with data, potentially from restart info !> @brief allocates all necessary fields and fills them with data, potentially from restart info
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_mech_spectral_basic_init 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,grid(1),grid(2),grid3) :: P
real(pReal), dimension(3,3) :: & 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 !> @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) 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 ! 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 !> 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) 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) :: & logical, intent(in) :: &
guess guess
@ -387,15 +339,6 @@ end subroutine grid_mech_spectral_basic_forward
!> @brief convergence check !> @brief convergence check
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dummy,ierr) 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 SNES :: snes_local
PetscInt, intent(in) :: PETScIter PetscInt, intent(in) :: PETScIter
@ -442,30 +385,6 @@ end subroutine converged
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine formResidual(in, F, & subroutine formResidual(in, F, &
residuum, dummy, ierr) 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) 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), & PetscScalar, dimension(3,3,XG_RANGE,YG_RANGE,ZG_RANGE), &

124
src/grid/grid_mech_spectral_polarisation.f90
View File

@ -7,17 +7,22 @@
module grid_mech_spectral_polarisation module grid_mech_spectral_polarisation
#include <petsc/finclude/petscsnes.h> #include <petsc/finclude/petscsnes.h>
#include <petsc/finclude/petscdmda.h> #include <petsc/finclude/petscdmda.h>
use DAMASK_interface
use HDF5_utilities
use PETScdmda use PETScdmda
use PETScsnes use PETScsnes
use prec, only: &
pReal use prec
use math, only: & use DAMASK_interface
math_I3 use HDF5_utilities
use spectral_utilities, only: & use math
tSolutionState, & use spectral_utilities
tSolutionParams use IO
use FEsolving
use config
use numerics
use homogenization
use mesh
use CPFEM2
use debug
implicit none implicit none
private private
@ -87,32 +92,7 @@ contains
!> @brief allocates all necessary fields and fills them with data, potentially from restart info !> @brief allocates all necessary fields and fills them with data, potentially from restart info
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_mech_spectral_polarisation_init 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,grid(1),grid(2),grid3) :: P
real(pReal), dimension(3,3) :: & real(pReal), dimension(3,3) :: &
temp33_Real = 0.0_pReal 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 !> @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) 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 ! 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 !> 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) 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) :: & logical, intent(in) :: &
guess guess
@ -434,17 +383,6 @@ end subroutine grid_mech_spectral_polarisation_forward
!> @brief convergence check !> @brief convergence check
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dummy,ierr) 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 SNES :: snes_local
PetscInt, intent(in) :: PETScIter PetscInt, intent(in) :: PETScIter
@ -496,38 +434,6 @@ end subroutine converged
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine formResidual(in, FandF_tau, & subroutine formResidual(in, FandF_tau, &
residuum, dummy,ierr) 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) 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), & PetscScalar, dimension(3,3,2,XG_RANGE,YG_RANGE,ZG_RANGE), &

70
src/grid/grid_thermal_spectral.f90
View File

@ -9,14 +9,17 @@ module grid_thermal_spectral
#include <petsc/finclude/petscdmda.h> #include <petsc/finclude/petscdmda.h>
use PETScdmda use PETScdmda
use PETScsnes use PETScsnes
use prec, only: &
pReal use prec
use spectral_utilities, only: & use spectral_utilities
tSolutionState, & use mesh
tSolutionParams use thermal_conduction
use material
use numerics
implicit none implicit none
private private
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! derived types ! derived types
type(tSolutionParams), private :: params type(tSolutionParams), private :: params
@ -51,23 +54,6 @@ contains
! ToDo: Restart not implemented ! ToDo: Restart not implemented
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_thermal_spectral_init 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 PetscInt, dimension(worldsize) :: localK
integer :: i, j, k, cell 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 !> @brief solution for the spectral thermal scheme with internal iterations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function grid_thermal_spectral_solution(timeinc,timeinc_old,loadCaseTime) result(solution) 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) :: & real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution timeinc, & !< increment in time for current solution
@ -228,18 +205,7 @@ end function grid_thermal_spectral_solution
!> @brief forwarding routine !> @brief forwarding routine
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_thermal_spectral_forward 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 integer :: i, j, k, cell
DM :: dm_local DM :: dm_local
PetscScalar, dimension(:,:,:), pointer :: x_scal PetscScalar, dimension(:,:,:), pointer :: x_scal
@ -289,24 +255,6 @@ end subroutine grid_thermal_spectral_forward
!> @brief forms the spectral thermal residual vector !> @brief forms the spectral thermal residual vector
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine formResidual(in,x_scal,f_scal,dummy,ierr) 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) :: & DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
in in

146
src/grid/spectral_utilities.f90
View File

@ -7,14 +7,20 @@ module spectral_utilities
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
#include <petsc/finclude/petscsys.h> #include <petsc/finclude/petscsys.h>
use PETScSys 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 implicit none
private private
include 'fftw3-mpi.f03' 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 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. !> Initializes FFTW.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_init 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 PetscErrorCode :: ierr
integer :: i, j, k, & integer :: i, j, k, &
FFTW_planner_flag FFTW_planner_flag
@ -412,17 +393,6 @@ end subroutine utilities_init
!> Also writes out the current reference stiffness for restart. !> Also writes out the current reference stiffness for restart.
!--------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------
subroutine utilities_updateGamma(C,saveReference) 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 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 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 !> @brief doing convolution gamma_hat * field_real, ensuring that average value = fieldAim
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_fourierGammaConvolution(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 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 complex(pReal), dimension(3,3) :: temp33_complex, xiDyad_cmplx
@ -600,12 +563,7 @@ end subroutine utilities_fourierGammaConvolution
!> @brief doing convolution DamageGreenOp_hat * field_real !> @brief doing convolution DamageGreenOp_hat * field_real
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_fourierGreenConvolution(D_ref, mobility_ref, deltaT) 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), dimension(3,3), intent(in) :: D_ref
real(pReal), intent(in) :: mobility_ref, deltaT real(pReal), intent(in) :: mobility_ref, deltaT
complex(pReal) :: GreenOp_hat complex(pReal) :: GreenOp_hat
@ -627,12 +585,6 @@ end subroutine utilities_fourierGreenConvolution
!> @brief calculate root mean square of divergence of field_fourier !> @brief calculate root mean square of divergence of field_fourier
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
real(pReal) function utilities_divergenceRMS() real(pReal) function utilities_divergenceRMS()
use IO, only: &
IO_error
use mesh, only: &
geomSize, &
grid, &
grid3
integer :: i, j, k, ierr integer :: i, j, k, ierr
complex(pReal), dimension(3) :: rescaledGeom complex(pReal), dimension(3) :: rescaledGeom
@ -676,13 +628,7 @@ end function utilities_divergenceRMS
!> @brief calculate max of curl of field_fourier !> @brief calculate max of curl of field_fourier
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
real(pReal) function utilities_curlRMS() real(pReal) function utilities_curlRMS()
use IO, only: &
IO_error
use mesh, only: &
geomSize, &
grid, &
grid3
integer :: i, j, k, l, ierr integer :: i, j, k, l, ierr
complex(pReal), dimension(3,3) :: curl_fourier complex(pReal), dimension(3,3) :: curl_fourier
complex(pReal), dimension(3) :: rescaledGeom 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 !> @brief calculates mask compliance tensor used to adjust F to fullfill stress BC
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function utilities_maskedCompliance(rot_BC,mask_stress,C) 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), 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,3,3) :: C !< current average stiffness
real(pReal), intent(in) , dimension(3,3) :: rot_BC !< rotation of load frame 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 !> @brief calculate scalar gradient in fourier field
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_fourierScalarGradient() subroutine utilities_fourierScalarGradient()
use mesh, only: &
grid3, &
grid
integer :: i, j, k integer :: i, j, k
@ -861,9 +794,6 @@ end subroutine utilities_fourierScalarGradient
!> @brief calculate vector divergence in fourier field !> @brief calculate vector divergence in fourier field
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_fourierVectorDivergence() subroutine utilities_fourierVectorDivergence()
use mesh, only: &
grid3, &
grid
integer :: i, j, k integer :: i, j, k
@ -879,9 +809,6 @@ end subroutine utilities_fourierVectorDivergence
!> @brief calculate vector gradient in fourier field !> @brief calculate vector gradient in fourier field
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_fourierVectorGradient() subroutine utilities_fourierVectorGradient()
use mesh, only: &
grid3, &
grid
integer :: i, j, k, m, n integer :: i, j, k, m, n
@ -899,10 +826,7 @@ end subroutine utilities_fourierVectorGradient
!> @brief calculate tensor divergence in fourier field !> @brief calculate tensor divergence in fourier field
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_fourierTensorDivergence() subroutine utilities_fourierTensorDivergence()
use mesh, only: &
grid3, &
grid
integer :: i, j, k, m, n integer :: i, j, k, m, n
vectorField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal) 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,& subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
F,timeinc,rotation_BC) 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,3,3) :: C_volAvg, C_minmaxAvg !< average stiffness
real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress 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 !> @brief calculates forward rate, either guessing or just add delta/timeinc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function utilities_calculateRate(heterogeneous,field0,field,dt,avRate) pure function utilities_calculateRate(heterogeneous,field0,field,dt,avRate)
use mesh, only: &
grid3, &
grid
real(pReal), intent(in), dimension(3,3) :: & real(pReal), intent(in), dimension(3,3) :: &
avRate !< homogeneous addon avRate !< homogeneous addon
@ -1040,9 +946,6 @@ end function utilities_calculateRate
!> ensures that the average matches the aim !> ensures that the average matches the aim
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function utilities_forwardField(timeinc,field_lastInc,rate,aim) function utilities_forwardField(timeinc,field_lastInc,rate,aim)
use mesh, only: &
grid3, &
grid
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
timeinc !< timeinc of current step timeinc !< timeinc of current step
@ -1074,11 +977,6 @@ end function utilities_forwardField
! standard approach ! standard approach
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function utilities_getFreqDerivative(k_s) 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 integer, intent(in), dimension(3) :: k_s !< indices of frequency
complex(pReal), dimension(3) :: utilities_getFreqDerivative complex(pReal), dimension(3) :: utilities_getFreqDerivative
@ -1127,16 +1025,6 @@ end function utilities_getFreqDerivative
! convolution ! convolution
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_updateIPcoords(F) 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 real(pReal), dimension(3,3,grid(1),grid(2),grid3), intent(in) :: F
integer :: i, j, k, m, ierr integer :: i, j, k, m, ierr
@ -1178,6 +1066,8 @@ subroutine utilities_updateIPcoords(F)
+ matmul(Favg,step*real([i,j,k+grid3Offset]-1,pReal)) + matmul(Favg,step*real([i,j,k+grid3Offset]-1,pReal))
m = m+1 m = m+1
enddo; enddo; enddo enddo; enddo; enddo
call discretization_setIPcoords(reshape(mesh_ipCoordinates,[3,grid(1)*grid(2)*grid3]))
end subroutine utilities_updateIPcoords end subroutine utilities_updateIPcoords

98
src/homogenization.f90
View File

@ -14,24 +14,24 @@ module homogenization
use numerics use numerics
use constitutive use constitutive
use crystallite use crystallite
use mesh
use FEsolving use FEsolving
use mesh
use discretization
use thermal_isothermal use thermal_isothermal
use thermal_adiabatic use thermal_adiabatic
use thermal_conduction use thermal_conduction
use damage_none use damage_none
use damage_local use damage_local
use damage_nonlocal use damage_nonlocal
#if defined(PETSc) || defined(DAMASK_HDF5)
use results use results
use HDF5_utilities use HDF5_utilities
#endif
implicit none
private
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! General variables for the homogenization at a material point ! General variables for the homogenization at a material point
implicit none real(pReal), dimension(:,:,:,:), allocatable, public :: &
private
real(pReal), dimension(:,:,:,:), allocatable, public :: &
materialpoint_F0, & !< def grad of IP at start of FE increment 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_F, & !< def grad of IP to be reached at end of FE increment
materialpoint_P !< first P--K stress of IP materialpoint_P !< first P--K stress of IP
@ -44,17 +44,17 @@ module homogenization
thermal_maxSizePostResults, & thermal_maxSizePostResults, &
damage_maxSizePostResults damage_maxSizePostResults
real(pReal), dimension(:,:,:,:), allocatable, private :: & real(pReal), dimension(:,:,:,:), allocatable :: &
materialpoint_subF0, & !< def grad of IP at beginning of homogenization increment 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 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_subFrac, &
materialpoint_subStep, & materialpoint_subStep, &
materialpoint_subdt materialpoint_subdt
logical, dimension(:,:), allocatable, private :: & logical, dimension(:,:), allocatable :: &
materialpoint_requested, & materialpoint_requested, &
materialpoint_converged materialpoint_converged
logical, dimension(:,:,:), allocatable, private :: & logical, dimension(:,:,:), allocatable :: &
materialpoint_doneAndHappy materialpoint_doneAndHappy
interface interface
@ -236,20 +236,20 @@ subroutine homogenization_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate and initialize global variables ! allocate and initialize global variables
allocate(materialpoint_dPdF(3,3,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,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) allocate(materialpoint_F0(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
materialpoint_F0 = spread(spread(math_I3,3,theMesh%elem%nIPs),4,theMesh%nElems) ! initialize to identity materialpoint_F0 = spread(spread(math_I3,3,discretization_nIP),4,discretization_nElem) ! initialize to identity
allocate(materialpoint_F(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) allocate(materialpoint_F(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
materialpoint_F = materialpoint_F0 ! initialize to identity materialpoint_F = materialpoint_F0 ! initialize to identity
allocate(materialpoint_subF0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) allocate(materialpoint_subF0(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_subF(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) allocate(materialpoint_subF(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_P(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) allocate(materialpoint_P(3,3,discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_subFrac(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) allocate(materialpoint_subFrac(discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_subStep(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) allocate(materialpoint_subStep(discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_subdt(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) allocate(materialpoint_subdt(discretization_nIP,discretization_nElem), source=0.0_pReal)
allocate(materialpoint_requested(theMesh%elem%nIPs,theMesh%nElems), source=.false.) allocate(materialpoint_requested(discretization_nIP,discretization_nElem), source=.false.)
allocate(materialpoint_converged(theMesh%elem%nIPs,theMesh%nElems), source=.true.) allocate(materialpoint_converged(discretization_nIP,discretization_nElem), source=.true.)
allocate(materialpoint_doneAndHappy(2,theMesh%elem%nIPs,theMesh%nElems), source=.true.) allocate(materialpoint_doneAndHappy(2,discretization_nIP,discretization_nElem), source=.true.)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate and initialize global state and postresutls variables ! allocate and initialize global state and postresutls variables
@ -266,7 +266,7 @@ subroutine homogenization_init
+ homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results
+ 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results
+ constitutive_source_maxSizePostResults) + 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 -+>>>' write(6,'(/,a)') ' <<<+- homogenization init -+>>>'
@ -286,7 +286,7 @@ subroutine homogenization_init
endif endif
flush(6) 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) call IO_error(602,ext_msg='constituent', el=debug_e, g=debug_g)
end subroutine homogenization_init end subroutine homogenization_init
@ -322,7 +322,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! initialize restoration points of ... ! initialize restoration points of ...
do e = FEsolving_execElem(1),FEsolving_execElem(2) 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 i = FEsolving_execIP(1,e),FEsolving_execIP(2,e);
do g = 1,myNgrains do g = 1,myNgrains
@ -370,7 +370,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
!$OMP PARALLEL DO PRIVATE(myNgrains) !$OMP PARALLEL DO PRIVATE(myNgrains)
elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) 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) IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
converged: if (materialpoint_converged(i,e)) then converged: if (materialpoint_converged(i,e)) then
@ -521,7 +521,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
! results in crystallite_partionedF ! results in crystallite_partionedF
!$OMP PARALLEL DO PRIVATE(myNgrains) !$OMP PARALLEL DO PRIVATE(myNgrains)
elementLooping2: do e = FEsolving_execElem(1),FEsolving_execElem(2) 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) IpLooping2: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
if ( materialpoint_requested(i,e) .and. & ! process requested but... if ( materialpoint_requested(i,e) .and. & ! process requested but...
.not. materialpoint_doneAndHappy(1,i,e)) then ! ...not yet done material points .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) !$OMP PARALLEL DO PRIVATE(myNgrains,myCrystallite,thePos,theSize)
elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2) elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2)
myNgrains = homogenization_Ngrains(mesh_element(3,e)) myNgrains = homogenization_Ngrains(material_homogenizationAt(e))
myCrystallite = microstructure_crystallite(mesh_element(4,e)) myCrystallite = microstructure_crystallite(discretization_microstructureAt(e))
IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
thePos = 0 thePos = 0
@ -642,19 +642,19 @@ subroutine partitionDeformation(ip,el)
ip, & !< integration point ip, & !< integration point
el !< element number 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 case (HOMOGENIZATION_NONE_ID) chosenHomogenization
crystallite_partionedF(1:3,1:3,1,ip,el) = materialpoint_subF(1:3,1:3,ip,el) crystallite_partionedF(1:3,1:3,1,ip,el) = materialpoint_subF(1:3,1:3,ip,el)
case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
call mech_isostrain_partitionDeformation(& 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)) materialpoint_subF(1:3,1:3,ip,el))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization case (HOMOGENIZATION_RGC_ID) chosenHomogenization
call mech_RGC_partitionDeformation(& 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),& materialpoint_subF(1:3,1:3,ip,el),&
ip, & ip, &
el) el)
@ -675,21 +675,21 @@ function updateState(ip,el)
logical, dimension(2) :: updateState logical, dimension(2) :: updateState
updateState = .true. updateState = .true.
chosenHomogenization: select case(homogenization_type(mesh_element(3,el))) chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization case (HOMOGENIZATION_RGC_ID) chosenHomogenization
updateState = & updateState = &
updateState .and. & updateState .and. &
mech_RGC_updateState(crystallite_P(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(mesh_element(3,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(mesh_element(3,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_subF(1:3,1:3,ip,el),&
materialpoint_subdt(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, & ip, &
el) el)
end select chosenHomogenization 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 case (THERMAL_adiabatic_ID) chosenThermal
updateState = & updateState = &
updateState .and. & updateState .and. &
@ -698,7 +698,7 @@ function updateState(ip,el)
el) el)
end select chosenThermal 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 case (DAMAGE_local_ID) chosenDamage
updateState = & updateState = &
updateState .and. & updateState .and. &
@ -719,7 +719,7 @@ subroutine averageStressAndItsTangent(ip,el)
ip, & !< integration point ip, & !< integration point
el !< element number 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 case (HOMOGENIZATION_NONE_ID) chosenHomogenization
materialpoint_P(1:3,1:3,ip,el) = crystallite_P(1:3,1:3,1,ip,el) 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) 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(& call mech_isostrain_averageStressAndItsTangent(&
materialpoint_P(1:3,1:3,ip,el), & materialpoint_P(1:3,1:3,ip,el), &
materialpoint_dPdF(1:3,1:3,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_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(mesh_element(3,el)),ip,el), & crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
homogenization_typeInstance(mesh_element(3,el))) homogenization_typeInstance(material_homogenizationAt(el)))
case (HOMOGENIZATION_RGC_ID) chosenHomogenization case (HOMOGENIZATION_RGC_ID) chosenHomogenization
call mech_RGC_averageStressAndItsTangent(& call mech_RGC_averageStressAndItsTangent(&
materialpoint_P(1:3,1:3,ip,el), & materialpoint_P(1:3,1:3,ip,el), &
materialpoint_dPdF(1:3,1:3,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_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(mesh_element(3,el)),ip,el), & crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(material_homogenizationAt(el)),ip,el), &
homogenization_typeInstance(mesh_element(3,el))) homogenization_typeInstance(material_homogenizationAt(el)))
end select chosenHomogenization end select chosenHomogenization
end subroutine averageStressAndItsTangent end subroutine averageStressAndItsTangent
@ -765,7 +765,7 @@ function postResults(ip,el)
postResults = 0.0_pReal postResults = 0.0_pReal
startPos = 1 startPos = 1
endPos = thermalState(material_homogenizationAt(el))%sizePostResults 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 case (THERMAL_adiabatic_ID) chosenThermal
homog = material_homogenizationAt(el) homog = material_homogenizationAt(el)
@ -780,7 +780,7 @@ function postResults(ip,el)
startPos = endPos + 1 startPos = endPos + 1
endPos = endPos + damageState(material_homogenizationAt(el))%sizePostResults 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 case (DAMAGE_local_ID) chosenDamage
postResults(startPos:endPos) = damage_local_postResults(ip, el) postResults(startPos:endPos) = damage_local_postResults(ip, el)

276
src/material.f90
View File

@ -8,12 +8,20 @@
!! 'phase', 'texture', and 'microstucture' !! 'phase', 'texture', and 'microstucture'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module material module material
use prec use prec
use math use math
use config use config
use results
use IO
use debug
use mesh
use numerics
use rotations
use discretization
implicit none implicit none
private private
character(len=*), parameter, public :: & character(len=*), parameter, public :: &
ELASTICITY_hooke_label = 'hooke', & ELASTICITY_hooke_label = 'hooke', &
PLASTICITY_none_label = 'none', & PLASTICITY_none_label = 'none', &
@ -122,7 +130,7 @@ module material
! NEW MAPPINGS ! NEW MAPPINGS
integer, dimension(:), allocatable, public, protected :: & ! (elem) 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) integer, dimension(:,:), allocatable, public, protected :: & ! (ip,elem)
material_homogenizationMemberAt !< position of the element within its homogenization instance material_homogenizationMemberAt !< position of the element within its homogenization instance
integer, dimension(:,:), allocatable, public, protected :: & ! (constituent,elem) integer, dimension(:,:), allocatable, public, protected :: & ! (constituent,elem)
@ -145,34 +153,28 @@ module material
damageState damageState
integer, dimension(:,:,:), allocatable, public, protected :: & 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 :: & real(pReal), dimension(:,:,:,:), allocatable, public, protected :: &
material_EulerAngles !< initial orientation of each grain,IP,element material_EulerAngles !< initial orientation of each grain,IP,element
logical, dimension(:), allocatable, public, protected :: & logical, dimension(:), allocatable, public, protected :: &
microstructure_active, & microstructure_active, &
microstructure_elemhomo, & !< flag to indicate homogeneous microstructure distribution over element's IPs
phase_localPlasticity !< flags phases with local constitutive law phase_localPlasticity !< flags phases with local constitutive law
integer, private :: & integer, private :: &
microstructure_maxNconstituents, & !< max number of constituents in any phase microstructure_maxNconstituents !< max number of constituents in any phase
texture_maxNgauss !< max number of Gauss components in any texture
integer, dimension(:), allocatable, private :: & integer, dimension(:), allocatable, private :: &
microstructure_Nconstituents, & !< number of constituents in each microstructure microstructure_Nconstituents !< number of constituents in each microstructure
texture_Ngauss !< number of Gauss components per texture
integer, dimension(:,:), allocatable, private :: & integer, dimension(:,:), allocatable, private :: &
microstructure_phase, & !< phase IDs of each microstructure microstructure_phase, & !< phase IDs of each microstructure
microstructure_texture !< texture IDs of each microstructure microstructure_texture !< texture IDs of each microstructure
real(pReal), dimension(:,:), allocatable, private :: & 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_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 :: & logical, dimension(:), allocatable, private :: &
homogenization_active homogenization_active
@ -243,18 +245,6 @@ contains
!> material.config !> material.config
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine material_init 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, parameter :: FILEUNIT = 210
integer :: m,c,h, myDebug, myPhase, myHomog integer :: m,c,h, myDebug, myPhase, myHomog
@ -323,12 +313,11 @@ subroutine material_init
do h = 1,size(config_homogenization) do h = 1,size(config_homogenization)
write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h) write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h)
enddo 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) do m = 1,size(config_microstructure)
write(6,'(1x,a32,1x,i11,1x,i12,1x,l13)') microstructure_name(m), & write(6,'(1x,a32,1x,i11,1x,i12)') microstructure_name(m), &
microstructure_crystallite(m), & microstructure_crystallite(m), &
microstructure_Nconstituents(m), & microstructure_Nconstituents(m)
microstructure_elemhomo(m)
if (microstructure_Nconstituents(m) > 0) then if (microstructure_Nconstituents(m) > 0) then
do c = 1,microstructure_Nconstituents(m) do c = 1,microstructure_Nconstituents(m)
write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(c,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 ! new mappings
allocate(material_homogenizationAt,source=theMesh%homogenizationAt) allocate(material_homogenizationAt,source=discretization_homogenizationAt)
allocate(material_homogenizationMemberAt(theMesh%elem%nIPs,theMesh%Nelems),source=0) allocate(material_homogenizationMemberAt(discretization_nIP,discretization_nElem),source=0)
allocate(CounterHomogenization(size(config_homogenization)),source=0) allocate(CounterHomogenization(size(config_homogenization)),source=0)
do e = 1, theMesh%Nelems do e = 1, discretization_nElem
do i = 1, theMesh%elem%nIPs do i = 1, discretization_nIP
CounterHomogenization(material_homogenizationAt(e)) = & CounterHomogenization(material_homogenizationAt(e)) = &
CounterHomogenization(material_homogenizationAt(e)) + 1 CounterHomogenization(material_homogenizationAt(e)) + 1
material_homogenizationMemberAt(i,e) = CounterHomogenization(material_homogenizationAt(e)) material_homogenizationMemberAt(i,e) = CounterHomogenization(material_homogenizationAt(e))
@ -357,12 +346,12 @@ subroutine material_init
enddo enddo
allocate(material_phaseAt(homogenization_maxNgrains,theMesh%Nelems), source=material_phase(:,1,:)) allocate(material_phaseAt(homogenization_maxNgrains,discretization_nElem), source=material_phase(:,1,:))
allocate(material_phaseMemberAt(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0) allocate(material_phaseMemberAt(homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0)
allocate(CounterPhase(size(config_phase)),source=0) allocate(CounterPhase(size(config_phase)),source=0)
do e = 1, theMesh%Nelems do e = 1, discretization_nElem
do i = 1, theMesh%elem%nIPs do i = 1, discretization_nIP
do c = 1, homogenization_maxNgrains do c = 1, homogenization_maxNgrains
CounterPhase(material_phaseAt(c,e)) = & CounterPhase(material_phaseAt(c,e)) = &
CounterPhase(material_phaseAt(c,e)) + 1 CounterPhase(material_phaseAt(c,e)) + 1
@ -371,6 +360,9 @@ subroutine material_init
enddo enddo
enddo enddo
call config_deallocate('material.config/microstructure')
call config_deallocate('material.config/texture')
#if defined(PETSc) || defined(DAMASK_HDF5) #if defined(PETSc) || defined(DAMASK_HDF5)
call results_openJobFile call results_openJobFile
call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,phase_name) call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,phase_name)
@ -383,18 +375,18 @@ subroutine material_init
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! BEGIN DEPRECATED ! BEGIN DEPRECATED
allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0) allocate(phaseAt ( homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0)
allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0) allocate(phasememberAt ( homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0)
allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0) allocate(mappingHomogenization (2, discretization_nIP,discretization_nElem),source=0)
allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1) allocate(mappingHomogenizationConst( discretization_nIP,discretization_nElem),source=1)
CounterHomogenization=0 CounterHomogenization=0
CounterPhase =0 CounterPhase =0
do e = 1,theMesh%Nelems do e = 1,discretization_nElem
myHomog = theMesh%homogenizationAt(e) myHomog = discretization_homogenizationAt(e)
do i = 1, theMesh%elem%nIPs do i = 1, discretization_nIP
CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1 CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1
mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),huge(1)] mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),huge(1)]
do g = 1,homogenization_Ngrains(myHomog) do g = 1,homogenization_Ngrains(myHomog)
@ -424,10 +416,6 @@ end subroutine material_init
!> @brief parses the homogenization part from the material configuration !> @brief parses the homogenization part from the material configuration
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine material_parseHomogenization subroutine material_parseHomogenization
use mesh, only: &
theMesh
use IO, only: &
IO_error
integer :: h integer :: h
character(len=65536) :: tag character(len=65536) :: tag
@ -445,7 +433,7 @@ subroutine material_parseHomogenization
allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal) allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal)
forall (h = 1:size(config_homogenization)) & 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) do h=1, size(config_homogenization)
@ -519,14 +507,6 @@ end subroutine material_parseHomogenization
!> @brief parses the microstructure part in the material configuration file !> @brief parses the microstructure part in the material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine material_parseMicrostructure 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 :: & character(len=65536), dimension(:), allocatable :: &
strings strings
@ -538,18 +518,16 @@ subroutine material_parseMicrostructure
allocate(microstructure_crystallite(size(config_microstructure)), source=0) allocate(microstructure_crystallite(size(config_microstructure)), source=0)
allocate(microstructure_Nconstituents(size(config_microstructure)), source=0) allocate(microstructure_Nconstituents(size(config_microstructure)), source=0)
allocate(microstructure_active(size(config_microstructure)), source=.false.) 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') call IO_error(155,ext_msg='More microstructures in geometry than sections in material.config')
forall (e = 1:theMesh%Nelems) & forall (e = 1:discretization_nElem) &
microstructure_active(theMesh%microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements 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) do m=1, size(config_microstructure)
microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)') microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)')
microstructure_crystallite(m) = config_microstructure(m)%getInt('crystallite') microstructure_crystallite(m) = config_microstructure(m)%getInt('crystallite')
microstructure_elemhomo(m) = config_microstructure(m)%keyExists('/elementhomogeneous/')
enddo enddo
microstructure_maxNconstituents = maxval(microstructure_Nconstituents) microstructure_maxNconstituents = maxval(microstructure_Nconstituents)
@ -577,12 +555,9 @@ subroutine material_parseMicrostructure
enddo enddo
enddo enddo
if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) call IO_error(153,ext_msg=microstructure_name(m))
enddo 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 end subroutine material_parseMicrostructure
@ -596,7 +571,7 @@ subroutine material_parseCrystallite
allocate(crystallite_Noutput(size(config_crystallite)),source=0) allocate(crystallite_Noutput(size(config_crystallite)),source=0)
do c=1, size(config_crystallite) do c=1, size(config_crystallite)
crystallite_Noutput(c) = config_crystallite(c)%countKeys('(output)') crystallite_Noutput(c) = config_crystallite(c)%countKeys('(output)')
enddo enddo
end subroutine material_parseCrystallite end subroutine material_parseCrystallite
@ -606,10 +581,6 @@ end subroutine material_parseCrystallite
!> @brief parses the phase part in the material configuration file !> @brief parses the phase part in the material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine material_parsePhase subroutine material_parsePhase
use IO, only: &
IO_error, &
IO_getTag, &
IO_stringValue
integer :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p integer :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p
character(len=65536), dimension(:), allocatable :: str character(len=65536), dimension(:), allocatable :: str
@ -729,81 +700,71 @@ subroutine material_parsePhase
end subroutine material_parsePhase end subroutine material_parsePhase
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief parses the texture part in the material configuration file !> @brief parses the texture part in the material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine material_parseTexture subroutine material_parseTexture
use IO, only: &
IO_error, &
IO_stringPos, &
IO_floatValue, &
IO_stringValue
integer :: section, gauss, j, t, i integer :: j, t, i
character(len=65536), dimension(:), allocatable :: strings ! Values for given key in material config character(len=65536), dimension(:), allocatable :: strings ! Values for given key in material config
integer, dimension(:), allocatable :: chunkPos 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) allocate(texture_Gauss (3,size(config_texture)), source=0.0_pReal)
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
texture_maxNgauss = maxval(texture_Ngauss) do t=1, size(config_texture)
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) strings = config_texture(t)%getStrings('(gauss)',raw= .true.)
texture_transformation = spread(math_I3,3,size(config_texture)) do i = 1 , size(strings)
chunkPos = IO_stringPos(strings(i))
do t=1, size(config_texture) do j = 1,9,2
section = t select case (IO_stringValue(strings(i),chunkPos,j))
gauss = 0 case('phi1')
texture_Gauss(1,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
if (config_texture(t)%keyExists('axes')) then case('phi')
strings = config_texture(t)%getStrings('axes') texture_Gauss(2,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
do j = 1, 3 ! look for "x", "y", and "z" entries case('phi2')
select case (strings(j)) texture_Gauss(3,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
case('x', '+x') end select
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
enddo enddo
enddo enddo
endif
enddo if (config_texture(t)%keyExists('axes')) then
strings = config_texture(t)%getStrings('axes')
call config_deallocate('material.config/texture') 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 end subroutine material_parseTexture
@ -814,8 +775,6 @@ end subroutine material_parseTexture
subroutine material_allocatePlasticState(phase,NofMyPhase,& subroutine material_allocatePlasticState(phase,NofMyPhase,&
sizeState,sizeDotState,sizeDeltaState,& sizeState,sizeDotState,sizeDeltaState,&
Nslip,Ntwin,Ntrans) Nslip,Ntwin,Ntrans)
use numerics, only: &
numerics_integrator
integer, intent(in) :: & integer, intent(in) :: &
phase, & phase, &
@ -861,8 +820,6 @@ end subroutine material_allocatePlasticState
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine material_allocateSourceState(phase,of,NofMyPhase,& subroutine material_allocateSourceState(phase,of,NofMyPhase,&
sizeState,sizeDotState,sizeDeltaState) sizeState,sizeDotState,sizeDeltaState)
use numerics, only: &
numerics_integrator
integer, intent(in) :: & integer, intent(in) :: &
phase, & phase, &
@ -902,36 +859,27 @@ end subroutine material_allocateSourceState
!! calculates the volume of the grains and deals with texture components !! calculates the volume of the grains and deals with texture components
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine material_populateGrains subroutine material_populateGrains
use mesh, only: &
theMesh
integer :: e,i,c,homog,micro integer :: e,i,c,homog,micro
allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0) allocate(material_phase(homogenization_maxNgrains,discretization_nIP,discretization_nElem), source=0)
allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0) allocate(material_texture(homogenization_maxNgrains,discretization_nIP,discretization_nElem), source=0)
allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal) allocate(material_EulerAngles(3,homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0.0_pReal)
do e = 1, theMesh%Nelems do e = 1, discretization_nElem
do i = 1, theMesh%elem%nIPs do i = 1, discretization_nIP
homog = theMesh%homogenizationAt(e) homog = discretization_homogenizationAt(e)
micro = theMesh%microstructureAt(e) micro = discretization_microstructureAt(e)
do c = 1, homogenization_Ngrains(homog) do c = 1, homogenization_Ngrains(homog)
material_phase(c,i,e) = microstructure_phase(c,micro) material_phase(c,i,e) = microstructure_phase(c,micro)
material_texture(c,i,e) = microstructure_texture(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) = texture_Gauss(1:3,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
) &
)
enddo enddo
enddo enddo
enddo enddo
deallocate(texture_transformation) deallocate(microstructure_phase)
deallocate(microstructure_texture)
call config_deallocate('material.config/microstructure')
end subroutine material_populateGrains end subroutine material_populateGrains

11
src/math.f90
View File

@ -8,7 +8,9 @@
module math module math
use prec use prec
use future use future
use IO
use debug
use numerics
implicit none implicit none
public public
#if __INTEL_COMPILER >= 1900 #if __INTEL_COMPILER >= 1900
@ -91,8 +93,6 @@ contains
!> @brief initialization of random seed generator and internal checks !> @brief initialization of random seed generator and internal checks
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine math_init subroutine math_init
use numerics, only: &
randomSeed
integer :: i integer :: i
real(pReal), dimension(4) :: randTest real(pReal), dimension(4) :: randTest
@ -133,7 +133,6 @@ end subroutine math_init
!> @brief check correctness of (some) math functions !> @brief check correctness of (some) math functions
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine unitTest subroutine unitTest
use IO, only: IO_error
character(len=64) :: error_msg character(len=64) :: error_msg
@ -526,8 +525,6 @@ end subroutine math_invert33
!> @brief Inversion of symmetriced 3x3x3x3 tensor. !> @brief Inversion of symmetriced 3x3x3x3 tensor.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function math_invSym3333(A) function math_invSym3333(A)
use IO, only: &
IO_error
real(pReal),dimension(3,3,3,3) :: math_invSym3333 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 !> @brief rotational part from polar decomposition of 33 tensor m
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function math_rotationalPart33(m) function math_rotationalPart33(m)
use IO, only: &
IO_warning
real(pReal), intent(in), dimension(3,3) :: m real(pReal), intent(in), dimension(3,3) :: m
real(pReal), dimension(3,3) :: math_rotationalPart33 real(pReal), dimension(3,3) :: math_rotationalPart33

724
src/mesh/DAMASK_FEM.f90
View File

@ -8,452 +8,418 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
program DAMASK_FEM program DAMASK_FEM
#include <petsc/finclude/petscsys.h> #include <petsc/finclude/petscsys.h>
use PetscDM use PetscDM
use prec, only: & use prec
pInt, & use DAMASK_interface
pReal, & use IO
tol_math_check use math
use DAMASK_interface, only: & use CPFEM2
DAMASK_interface_init, & use FEsolving
loadCaseFile, & use numerics
getSolverJobName use mesh
use IO, only: & use FEM_Utilities
IO_isBlank, & use FEM_mech
IO_stringPos, &
IO_stringValue, & implicit none
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
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! variables related to information from load case and geom file ! variables related to information from load case and geom file
integer(pInt), allocatable, dimension(:) :: chunkPos ! this is longer than needed for geometry parsing integer, allocatable, dimension(:) :: chunkPos ! this is longer than needed for geometry parsing
integer(pInt) :: & integer :: &
N_def = 0_pInt !< # of rate of deformation specifiers found in load case file N_def = 0 !< # of rate of deformation specifiers found in load case file
character(len=65536) :: & character(len=65536) :: &
line line
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! loop variables, convergence etc. ! loop variables, convergence etc.
integer(pInt), parameter :: & integer, parameter :: &
subStepFactor = 2_pInt !< for each substep, divide the last time increment by 2.0 subStepFactor = 2 !< for each substep, divide the last time increment by 2.0
real(pReal) :: & real(pReal) :: &
time = 0.0_pReal, & !< elapsed time time = 0.0_pReal, & !< elapsed time
time0 = 0.0_pReal, & !< begin of interval time0 = 0.0_pReal, & !< begin of interval
timeinc = 0.0_pReal, & !< current time interval timeinc = 0.0_pReal, & !< current time interval
timeIncOld = 0.0_pReal, & !< previous time interval timeIncOld = 0.0_pReal, & !< previous time interval
remainingLoadCaseTime = 0.0_pReal !< remaining time of current load case remainingLoadCaseTime = 0.0_pReal !< remaining time of current load case
logical :: & logical :: &
guess, & !< guess along former trajectory guess, & !< guess along former trajectory
stagIterate stagIterate
integer(pInt) :: & integer :: &
i, & i, &
errorID, & errorID, &
cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ cutBackLevel = 0, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
stepFraction = 0_pInt !< fraction of current time interval stepFraction = 0 !< fraction of current time interval
integer(pInt) :: & integer :: &
currentLoadcase = 0_pInt, & !< current load case currentLoadcase = 0, & !< current load case
currentFace = 0_pInt, & currentFace = 0, &
inc, & !< current increment in current load case inc, & !< current increment in current load case
totalIncsCounter = 0_pInt, & !< total # of increments totalIncsCounter = 0, & !< total # of increments
convergedCounter = 0_pInt, & !< # of converged increments convergedCounter = 0, & !< # of converged increments
notConvergedCounter = 0_pInt, & !< # of non-converged increments notConvergedCounter = 0, & !< # of non-converged increments
fileUnit = 0_pInt, & !< file unit for reading load case and writing results fileUnit = 0, & !< file unit for reading load case and writing results
myStat, & myStat, &
statUnit = 0_pInt, & !< file unit for statistics output statUnit = 0, & !< file unit for statistics output
lastRestartWritten = 0_pInt, & !< total increment No. at which last restart information was written lastRestartWritten = 0, & !< total increment No. at which last restart information was written
stagIter, & stagIter, &
component component
character(len=6) :: loadcase_string character(len=6) :: loadcase_string
character(len=1024) :: & character(len=1024) :: &
incInfo incInfo
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
type(tSolutionState), allocatable, dimension(:) :: solres type(tSolutionState), allocatable, dimension(:) :: solres
PetscInt :: faceSet, currentFaceSet PetscInt :: faceSet, currentFaceSet
PetscInt :: field, dimPlex PetscInt :: field, dimPlex
PetscErrorCode :: ierr PetscErrorCode :: ierr
external :: & external :: &
quit quit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! init DAMASK (all modules) ! init DAMASK (all modules)
call CPFEM_initAll call CPFEM_initAll
write(6,'(/,a)') ' <<<+- DAMASK_FEM init -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_FEM init -+>>>'
! reading basic information from load case file and allocate data structure containing load cases ! 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) call DMGetDimension(geomMesh,dimPlex,ierr); CHKERRA(ierr) !< dimension of mesh (2D or 3D)
nActiveFields = 1 nActiveFields = 1
allocate(solres(nActiveFields)) allocate(solres(nActiveFields))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! reading basic information from load case file and allocate data structure containing load cases ! reading basic information from load case file and allocate data structure containing load cases
open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read') 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)) if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=trim(loadCaseFile))
do do
read(fileUnit, '(A)', iostat=myStat) line read(fileUnit, '(A)', iostat=myStat) line
if ( myStat /= 0_pInt) exit if ( myStat /= 0) exit
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase do i = 1, chunkPos(1) ! reading compulsory parameters for loadcase
select case (IO_lc(IO_stringValue(line,chunkPos,i))) select case (IO_lc(IO_stringValue(line,chunkPos,i)))
case('$loadcase') case('$loadcase')
N_def = N_def + 1_pInt N_def = N_def + 1
end select end select
enddo ! count all identifiers to allocate memory and do sanity check enddo ! count all identifiers to allocate memory and do sanity check
enddo enddo
allocate (loadCases(N_def)) allocate (loadCases(N_def))
do i = 1, size(loadCases) do i = 1, size(loadCases)
allocate(loadCases(i)%fieldBC(nActiveFields)) allocate(loadCases(i)%fieldBC(nActiveFields))
field = 1 field = 1
loadCases(i)%fieldBC(field)%ID = FIELD_MECH_ID loadCases(i)%fieldBC(field)%ID = FIELD_MECH_ID
enddo enddo
do i = 1, size(loadCases) do i = 1, size(loadCases)
do field = 1, nActiveFields do field = 1, nActiveFields
select case (loadCases(i)%fieldBC(field)%ID) select case (loadCases(i)%fieldBC(field)%ID)
case(FIELD_MECH_ID) case(FIELD_MECH_ID)
loadCases(i)%fieldBC(field)%nComponents = dimPlex !< X, Y (, Z) displacements loadCases(i)%fieldBC(field)%nComponents = dimPlex !< X, Y (, Z) displacements
allocate(loadCases(i)%fieldBC(field)%componentBC(loadCases(i)%fieldBC(field)%nComponents)) allocate(loadCases(i)%fieldBC(field)%componentBC(loadCases(i)%fieldBC(field)%nComponents))
do component = 1, loadCases(i)%fieldBC(field)%nComponents do component = 1, loadCases(i)%fieldBC(field)%nComponents
select case (component) select case (component)
case (1) case (1)
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_X_ID loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_X_ID
case (2) case (2)
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_Y_ID loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_Y_ID
case (3) case (3)
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_Z_ID loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_Z_ID
end select end select
enddo enddo
end select end select
do component = 1, loadCases(i)%fieldBC(field)%nComponents 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)%Value(mesh_Nboundaries), source = 0.0_pReal)
allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.) allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.)
enddo enddo
enddo enddo
enddo enddo
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! reading the load case and assign values to the allocated data structure ! reading the load case and assign values to the allocated data structure
rewind(fileUnit) rewind(fileUnit)
do do
read(fileUnit, '(A)', iostat=myStat) line read(fileUnit, '(A)', iostat=myStat) line
if ( myStat /= 0_pInt) exit if ( myStat /= 0) exit
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line) chunkPos = IO_stringPos(line)
do i = 1_pInt, chunkPos(1) do i = 1, chunkPos(1)
select case (IO_lc(IO_stringValue(line,chunkPos,i))) select case (IO_lc(IO_stringValue(line,chunkPos,i)))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! loadcase information ! loadcase information
case('$loadcase') case('$loadcase')
currentLoadCase = IO_intValue(line,chunkPos,i+1_pInt) currentLoadCase = IO_intValue(line,chunkPos,i+1)
case('face') case('face')
currentFace = IO_intValue(line,chunkPos,i+1_pInt) currentFace = IO_intValue(line,chunkPos,i+1)
currentFaceSet = -1_pInt currentFaceSet = -1
do faceSet = 1, mesh_Nboundaries do faceSet = 1, mesh_Nboundaries
if (mesh_boundaries(faceSet) == currentFace) currentFaceSet = faceSet if (mesh_boundaries(faceSet) == currentFace) currentFaceSet = faceSet
enddo enddo
if (currentFaceSet < 0_pInt) call IO_error(error_ID = errorID, ext_msg = 'invalid BC') if (currentFaceSet < 0) call IO_error(error_ID = errorID, ext_msg = 'invalid BC')
case('t','time','delta') ! increment time case('t','time','delta') ! increment time
loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt) loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1)
case('n','incs','increments','steps') ! number of increments case('n','incs','increments','steps') ! number of increments
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1)
case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling) case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling)
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1)
loadCases(currentLoadCase)%logscale = 1_pInt loadCases(currentLoadCase)%logscale = 1
case('freq','frequency','outputfreq') ! frequency of result writings case('freq','frequency','outputfreq') ! frequency of result writings
loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1)
case('r','restart','restartwrite') ! frequency of writing restart information case('r','restart','restartwrite') ! frequency of writing restart information
loadCases(currentLoadCase)%restartfrequency = & loadCases(currentLoadCase)%restartfrequency = &
max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt)) max(0,IO_intValue(line,chunkPos,i+1))
case('guessreset','dropguessing') case('guessreset','dropguessing')
loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! boundary condition information ! boundary condition information
case('x') ! X displacement field case('x') ! X displacement field
do field = 1, nActiveFields do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_X_ID) then if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_X_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true. .true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt) IO_floatValue(line,chunkPos,i+1)
endif endif
enddo enddo
endif endif
enddo enddo
case('y') ! Y displacement field case('y') ! Y displacement field
do field = 1, nActiveFields do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Y_ID) then if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Y_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true. .true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt) IO_floatValue(line,chunkPos,i+1)
endif endif
enddo enddo
endif endif
enddo enddo
case('z') ! Z displacement field case('z') ! Z displacement field
do field = 1, nActiveFields do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Z_ID) then if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Z_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true. .true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt) IO_floatValue(line,chunkPos,i+1)
endif endif
enddo enddo
endif endif
enddo enddo
end select end select
enddo; enddo enddo; enddo
close(fileUnit) close(fileUnit)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! consistency checks and output of load case ! consistency checks and output of load case
loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase
errorID = 0_pInt errorID = 0
checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases) checkLoadcases: do currentLoadCase = 1, size(loadCases)
write (loadcase_string, '(i6)' ) currentLoadCase write (loadcase_string, '(i6)' ) currentLoadCase
write(6,'(1x,a,i6)') 'load case: ', currentLoadCase write(6,'(1x,a,i6)') 'load case: ', currentLoadCase
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) & if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
write(6,'(2x,a)') 'drop guessing along trajectory' write(6,'(2x,a)') 'drop guessing along trajectory'
do field = 1_pInt, nActiveFields do field = 1, nActiveFields
select case (loadCases(currentLoadCase)%fieldBC(field)%ID) select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID) case(FIELD_MECH_ID)
write(6,'(2x,a)') 'Field '//trim(FIELD_MECH_label) write(6,'(2x,a)') 'Field '//trim(FIELD_MECH_label)
end select end select
do faceSet = 1_pInt, mesh_Nboundaries do faceSet = 1, mesh_Nboundaries
do component = 1_pInt, loadCases(currentLoadCase)%fieldBC(field)%nComponents do component = 1, loadCases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) & if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) &
write(6,'(4x,a,i2,a,i2,a,f12.7)') 'Face ', mesh_boundaries(faceSet), & write(6,'(4x,a,i2,a,i2,a,f12.7)') 'Face ', mesh_boundaries(faceSet), &
' Component ', component, & ' Component ', component, &
' Value ', loadCases(currentLoadCase)%fieldBC(field)% & ' Value ', loadCases(currentLoadCase)%fieldBC(field)% &
componentBC(component)%Value(faceSet) componentBC(component)%Value(faceSet)
enddo enddo
enddo enddo
enddo enddo
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count if (loadCases(currentLoadCase)%incs < 1) errorID = 835 ! non-positive incs count
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency if (loadCases(currentLoadCase)%outputfrequency < 1) errorID = 836 ! non-positive result frequency
write(6,'(2x,a,i5)') 'output frequency: ', & write(6,'(2x,a,i5)') 'output frequency: ', &
loadCases(currentLoadCase)%outputfrequency loadCases(currentLoadCase)%outputfrequency
write(6,'(2x,a,i5,/)') 'restart frequency: ', & write(6,'(2x,a,i5,/)') 'restart frequency: ', &
loadCases(currentLoadCase)%restartfrequency loadCases(currentLoadCase)%restartfrequency
if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
enddo checkLoadcases enddo checkLoadcases
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! doing initialization depending on active solvers ! doing initialization depending on active solvers
call Utilities_init() call Utilities_init
do field = 1, nActiveFields do field = 1, nActiveFields
select case (loadCases(1)%fieldBC(field)%ID) select case (loadCases(1)%fieldBC(field)%ID)
case(FIELD_MECH_ID) case(FIELD_MECH_ID)
call FEM_mech_init(loadCases(1)%fieldBC(field)) call FEM_mech_init(loadCases(1)%fieldBC(field))
end select end select
enddo enddo
loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) loadCaseLooping: do currentLoadCase = 1, size(loadCases)
time0 = time ! load case start time time0 = time ! load case start time
guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc
incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs incLooping: do inc = 1, loadCases(currentLoadCase)%incs
totalIncsCounter = totalIncsCounter + 1_pInt totalIncsCounter = totalIncsCounter + 1
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! forwarding time ! forwarding time
timeIncOld = timeinc ! last timeinc that brought former inc to an end timeIncOld = timeinc ! last timeinc that brought former inc to an end
if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale if (loadCases(currentLoadCase)%logscale == 0) then ! linear scale
timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal) timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal)
else else
if (currentLoadCase == 1_pInt) then ! 1st load case of logarithmic scale if (currentLoadCase == 1) then ! 1st load case of logarithmic scale
if (inc == 1_pInt) then ! 1st inc of 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_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd 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 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)) timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1-loadCases(1)%incs ,pReal))
endif endif
else ! not-1st load case of logarithmic scale else ! not-1st load case of logarithmic scale
timeinc = time0 * & timeinc = time0 * &
( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc,pReal)/& ( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc,pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal))& real(loadCases(currentLoadCase)%incs ,pReal))&
-(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1_pInt ,pReal)/& -(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1 ,pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal))) real(loadCases(currentLoadCase)%incs ,pReal)))
endif endif
endif endif
timeinc = timeinc * real(subStepFactor,pReal)**real(-cutBackLevel,pReal) ! depending on cut back level, decrease time step 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? skipping: if (totalIncsCounter <= restartInc) then ! not yet at restart inc?
time = time + timeinc ! just advance time, skip already performed calculation time = time + timeinc ! just advance time, skip already performed calculation
guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference guess = .true.
else skipping else skipping
stepFraction = 0_pInt ! fraction scaled by stepFactor**cutLevel stepFraction = 0 ! fraction scaled by stepFactor**cutLevel
subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel) subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel)
remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time
time = time + timeinc ! forward target time time = time + timeinc ! forward target time
stepFraction = stepFraction + 1_pInt ! count step stepFraction = stepFraction + 1 ! count step
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report begin of new step ! report begin of new step
write(6,'(/,a)') ' ###########################################################################' write(6,'(/,a)') ' ###########################################################################'
write(6,'(1x,a,es12.5'//& write(6,'(1x,a,es12.5'//&
',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//& ',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//&
',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//& ',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//&
',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') & ',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') &
'Time', time, & 'Time', time, &
's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,& 's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,&
'-', stepFraction, '/', subStepFactor**cutBackLevel,& '-', stepFraction, '/', subStepFactor**cutBackLevel,&
' of load case ', currentLoadCase,'/',size(loadCases) ' of load case ', currentLoadCase,'/',size(loadCases)
write(incInfo,& write(incInfo,&
'(a,'//IO_intOut(totalIncsCounter)//& '(a,'//IO_intOut(totalIncsCounter)//&
',a,'//IO_intOut(sum(loadCases%incs))//& ',a,'//IO_intOut(sum(loadCases%incs))//&
',a,'//IO_intOut(stepFraction)//& ',a,'//IO_intOut(stepFraction)//&
',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') & ',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') &
'Increment ',totalIncsCounter,'/',sum(loadCases%incs),& 'Increment ',totalIncsCounter,'/',sum(loadCases%incs),&
'-',stepFraction, '/', subStepFactor**cutBackLevel '-',stepFraction, '/', subStepFactor**cutBackLevel
flush(6) flush(6)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! forward fields ! forward fields
do field = 1, nActiveFields do field = 1, nActiveFields
select case (loadCases(currentLoadCase)%fieldBC(field)%ID) select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID) case(FIELD_MECH_ID)
call FEM_mech_forward (& call FEM_mech_forward (&
guess,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field)) guess,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field))
end select end select
enddo enddo
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! solve fields ! solve fields
stagIter = 0_pInt stagIter = 0
stagIterate = .true. stagIterate = .true.
do while (stagIterate) do while (stagIterate)
do field = 1, nActiveFields do field = 1, nActiveFields
select case (loadCases(currentLoadCase)%fieldBC(field)%ID) select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID) case(FIELD_MECH_ID)
solres(field) = FEM_mech_solution (& solres(field) = FEM_mech_solution (&
incInfo,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field)) 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 enddo
stagIter = stagIter + 1_pInt stagIter = stagIter + 1
stagIterate = stagIter < stagItMax & stagIterate = stagIter < stagItMax &
.and. all(solres(:)%converged) & .and. all(solres(:)%converged) &
.and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration .and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration
enddo enddo
! check solution ! check solution
cutBack = .False. cutBack = .False.
if(.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found if(.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found
if (cutBackLevel < maxCutBack) then ! do cut back if (cutBackLevel < maxCutBack) then ! do cut back
write(6,'(/,a)') ' cut back detected' write(6,'(/,a)') ' cut back detected'
cutBack = .True. cutBack = .True.
stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1_pInt cutBackLevel = cutBackLevel + 1
time = time - timeinc ! rewind time time = time - timeinc ! rewind time
timeinc = timeinc/2.0_pReal timeinc = timeinc/2.0_pReal
else ! default behavior, exit if spectral solver does not converge else ! default behavior, exit if spectral solver does not converge
call IO_warning(850_pInt) call IO_warning(850)
call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written call quit(-1*(lastRestartWritten+1)) ! quit and provide information about last restart inc written
endif endif
else else
guess = .true. ! start guessing after first converged (sub)inc guess = .true. ! start guessing after first converged (sub)inc
timeIncOld = timeinc timeIncOld = timeinc
endif endif
if (.not. cutBack) then if (.not. cutBack) then
if (worldrank == 0) write(statUnit,*) totalIncsCounter, time, cutBackLevel, & if (worldrank == 0) write(statUnit,*) totalIncsCounter, time, cutBackLevel, &
solres%converged, solres%iterationsNeeded ! write statistics about accepted solution solres%converged, solres%iterationsNeeded ! write statistics about accepted solution
endif endif
enddo subStepLooping 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 if (all(solres(:)%converged)) then
convergedCounter = convergedCounter + 1_pInt convergedCounter = convergedCounter + 1
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc
' increment ', totalIncsCounter, ' converged' ' increment ', totalIncsCounter, ' converged'
else else
notConvergedCounter = notConvergedCounter + 1_pInt notConvergedCounter = notConvergedCounter + 1
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc
' increment ', totalIncsCounter, ' NOT converged' ' increment ', totalIncsCounter, ' NOT converged'
endif; flush(6) endif; flush(6)
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then ! at output frequency
write(6,'(1/,a)') ' ... writing results to file ......................................' write(6,'(1/,a)') ' ... writing results to file ......................................'
call CPFEM_results(totalIncsCounter,time) call CPFEM_results(totalIncsCounter,time)
endif endif
if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ... if ( loadCases(currentLoadCase)%restartFrequency > 0 & ! writing of restart info requested ...
.and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0) then ! ... and at frequency of writing restart information
restartWrite = .true. ! set restart parameter for FEsolving restartWrite = .true. ! set restart parameter for FEsolving
lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write? lastRestartWritten = inc ! first call to CPFEM_general will write
endif endif
endif skipping endif skipping
enddo incLooping enddo incLooping
enddo loadCaseLooping enddo loadCaseLooping
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report summary of whole calculation ! report summary of whole calculation
write(6,'(/,a)') ' ###########################################################################' write(6,'(/,a)') ' ###########################################################################'
write(6,'(1x,'//IO_intOut(convergedCounter)//',a,'//IO_intOut(notConvergedCounter + convergedCounter)//',a,f5.1,a)') & write(6,'(1x,'//IO_intOut(convergedCounter)//',a,'//IO_intOut(notConvergedCounter + convergedCounter)//',a,f5.1,a)') &
convergedCounter, ' out of ', & convergedCounter, ' out of ', &
notConvergedCounter + convergedCounter, ' (', & notConvergedCounter + convergedCounter, ' (', &
real(convergedCounter, pReal)/& real(convergedCounter, pReal)/&
real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, ' %) increments converged!' real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, ' %) increments converged!'
flush(6) flush(6)
close(statUnit) close(statUnit)
if (notConvergedCounter > 0_pInt) call quit(2_pInt) ! error if some are not converged if (notConvergedCounter > 0) call quit(2) ! error if some are not converged
call quit(0_pInt) ! no complains ;) call quit(0) ! no complains ;)
end program DAMASK_FEM end program DAMASK_FEM

1054
src/mesh/FEM_mech.f90
View File

File diff suppressed because it is too large Load Diff

265
src/mesh/FEM_utilities.f90
View File

@ -6,85 +6,92 @@ module FEM_utilities
#include <petsc/finclude/petscdmplex.h> #include <petsc/finclude/petscdmplex.h>
#include <petsc/finclude/petscdmda.h> #include <petsc/finclude/petscdmda.h>
#include <petsc/finclude/petscis.h> #include <petsc/finclude/petscis.h>
use prec, only: pReal, pInt
use PETScdmplex use PETScdmplex
use PETScdmda use PETScdmda
use PETScis 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
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(pInt), public, parameter :: maxFields = 6_pInt integer, public :: nActiveFields = 0
integer(pInt), public :: nActiveFields = 0_pInt
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! grid related information information ! grid related information information
real(pReal), public :: wgt !< weighting factor 1/Nelems real(pReal), public :: wgt !< weighting factor 1/Nelems
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! field labels information ! field labels information
character(len=*), parameter, public :: & character(len=*), parameter, public :: &
FIELD_MECH_label = 'mechanical' FIELD_MECH_label = 'mechanical'
enum, bind(c) enum, bind(c)
enumerator :: FIELD_UNDEFINED_ID, & enumerator :: FIELD_UNDEFINED_ID, &
FIELD_MECH_ID FIELD_MECH_ID
end enum end enum
enum, bind(c) enum, bind(c)
enumerator :: COMPONENT_UNDEFINED_ID, & enumerator :: COMPONENT_UNDEFINED_ID, &
COMPONENT_MECH_X_ID, & COMPONENT_MECH_X_ID, &
COMPONENT_MECH_Y_ID, & COMPONENT_MECH_Y_ID, &
COMPONENT_MECH_Z_ID COMPONENT_MECH_Z_ID
end enum end enum
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! variables controlling debugging ! variables controlling debugging
logical, private :: & logical :: &
debugPETSc !< use some in debug defined options for more verbose PETSc solution debugPETSc !< use some in debug defined options for more verbose PETSc solution
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! derived types ! derived types
type, public :: tSolutionState !< return type of solution from FEM solver variants type, public :: tSolutionState !< return type of solution from FEM solver variants
logical :: converged = .true. logical :: converged = .true.
logical :: stagConverged = .true. logical :: stagConverged = .true.
integer(pInt) :: iterationsNeeded = 0_pInt integer :: iterationsNeeded = 0
end type tSolutionState 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
public :: & type, public :: tComponentBC
utilities_init, & integer(kind(COMPONENT_UNDEFINED_ID)) :: ID
utilities_constitutiveResponse, & real(pReal), allocatable :: Value(:)
utilities_projectBCValues, & logical, allocatable :: Mask(:)
FIELD_MECH_ID, & end type tComponentBC
COMPONENT_MECH_X_ID, &
COMPONENT_MECH_Y_ID, & type, public :: tFieldBC
COMPONENT_MECH_Z_ID 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 contains
@ -92,45 +99,32 @@ contains
!> @brief allocates all neccessary fields, sets debug flags !> @brief allocates all neccessary fields, sets debug flags
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_init 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 character(len=1024) :: petsc_optionsPhysics
PetscErrorCode :: ierr PetscErrorCode :: ierr
write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set debugging parameters ! set debugging parameters
debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0 debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0
if(debugPETSc) write(6,'(3(/,a),/)') & if(debugPETSc) write(6,'(3(/,a),/)') &
' Initializing PETSc with debug options: ', & ' Initializing PETSc with debug options: ', &
trim(PETScDebug), & trim(PETScDebug), &
' add more using the PETSc_Options keyword in numerics.config ' ' add more using the PETSc_Options keyword in numerics.config '
flush(6) flush(6)
call PetscOptionsClear(PETSC_NULL_OPTIONS,ierr) call PetscOptionsClear(PETSC_NULL_OPTIONS,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr) if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_defaultOptions),ierr) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_defaultOptions),ierr)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
write(petsc_optionsPhysics,'(a,i0)') '-mechFE_petscspace_degree ' , structOrder write(petsc_optionsPhysics,'(a,i0)') '-mechFE_petscspace_degree ' , structOrder
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsPhysics),ierr) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsPhysics),ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal) wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal)
end subroutine utilities_init end subroutine utilities_init
@ -139,28 +133,23 @@ end subroutine utilities_init
!> @brief calculates constitutive response !> @brief calculates constitutive response
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) 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 real(pReal), intent(in) :: timeinc !< loading time
logical, intent(in) :: forwardData !< age results logical, intent(in) :: forwardData !< age results
real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress
PetscErrorCode :: ierr 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 restartWrite = .false. ! reset restartWrite status
cutBack = .false. ! reset cutBack status cutBack = .false. ! reset cutBack status
P_av = sum(sum(materialpoint_P,dim=4),dim=3) * wgt ! average of P 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) call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
end subroutine utilities_constitutiveResponse end subroutine utilities_constitutiveResponse
@ -170,32 +159,32 @@ end subroutine utilities_constitutiveResponse
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_projectBCValues(localVec,section,field,comp,bcPointsIS,BCValue,BCDotValue,timeinc) subroutine utilities_projectBCValues(localVec,section,field,comp,bcPointsIS,BCValue,BCDotValue,timeinc)
Vec :: localVec Vec :: localVec
PetscInt :: field, comp, nBcPoints, point, dof, numDof, numComp, offset PetscInt :: field, comp, nBcPoints, point, dof, numDof, numComp, offset
PetscSection :: section PetscSection :: section
IS :: bcPointsIS IS :: bcPointsIS
PetscInt, pointer :: bcPoints(:) PetscInt, pointer :: bcPoints(:)
PetscScalar, pointer :: localArray(:) PetscScalar, pointer :: localArray(:)
PetscScalar :: BCValue,BCDotValue,timeinc PetscScalar :: BCValue,BCDotValue,timeinc
PetscErrorCode :: ierr PetscErrorCode :: ierr
call PetscSectionGetFieldComponents(section,field,numComp,ierr); CHKERRQ(ierr) call PetscSectionGetFieldComponents(section,field,numComp,ierr); CHKERRQ(ierr)
call ISGetSize(bcPointsIS,nBcPoints,ierr); CHKERRQ(ierr) call ISGetSize(bcPointsIS,nBcPoints,ierr); CHKERRQ(ierr)
if (nBcPoints > 0) call ISGetIndicesF90(bcPointsIS,bcPoints,ierr) if (nBcPoints > 0) call ISGetIndicesF90(bcPointsIS,bcPoints,ierr)
call VecGetArrayF90(localVec,localArray,ierr); CHKERRQ(ierr) call VecGetArrayF90(localVec,localArray,ierr); CHKERRQ(ierr)
do point = 1, nBcPoints do point = 1, nBcPoints
call PetscSectionGetFieldDof(section,bcPoints(point),field,numDof,ierr) call PetscSectionGetFieldDof(section,bcPoints(point),field,numDof,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call PetscSectionGetFieldOffset(section,bcPoints(point),field,offset,ierr) call PetscSectionGetFieldOffset(section,bcPoints(point),field,offset,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
do dof = offset+comp+1, offset+numDof, numComp do dof = offset+comp+1, offset+numDof, numComp
localArray(dof) = localArray(dof) + BCValue + BCDotValue*timeinc localArray(dof) = localArray(dof) + BCValue + BCDotValue*timeinc
enddo enddo
enddo enddo
call VecRestoreArrayF90(localVec,localArray,ierr); CHKERRQ(ierr) call VecRestoreArrayF90(localVec,localArray,ierr); CHKERRQ(ierr)
call VecAssemblyBegin(localVec, ierr); CHKERRQ(ierr) call VecAssemblyBegin(localVec, ierr); CHKERRQ(ierr)
call VecAssemblyEnd (localVec, ierr); CHKERRQ(ierr) call VecAssemblyEnd (localVec, ierr); CHKERRQ(ierr)
if (nBcPoints > 0) call ISRestoreIndicesF90(bcPointsIS,bcPoints,ierr) if (nBcPoints > 0) call ISRestoreIndicesF90(bcPointsIS,bcPoints,ierr)
end subroutine utilities_projectBCValues end subroutine utilities_projectBCValues

495
src/mesh/FEM_zoo.f90
View File

@ -3,29 +3,31 @@
!> @brief Interpolation data used by the FEM solver !> @brief Interpolation data used by the FEM solver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module FEM_Zoo 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 integer, dimension(2:3,maxOrder), public, protected :: &
private FEM_Zoo_nQuadrature !< number of quadrature points for a given spatial dimension(2-3) and interpolation order(1-maxOrder)
integer(pInt), parameter, public:: & type(group_float), dimension(2:3,maxOrder), public, protected :: &
maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary) FEM_Zoo_QuadratureWeights, & !< quadrature weights for each quadrature rule
real(pReal), dimension(2,3), private, parameter :: & FEM_Zoo_QuadraturePoints !< quadrature point coordinates (in simplical system) for each quadrature rule
triangle = reshape([-1.0_pReal, -1.0_pReal, &
1.0_pReal, -1.0_pReal, & public :: &
-1.0_pReal, 1.0_pReal], shape=[2,3]) FEM_Zoo_init
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
contains contains
@ -34,306 +36,329 @@ contains
!> @brief initializes FEM interpolation data !> @brief initializes FEM interpolation data
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_init subroutine FEM_Zoo_init
implicit none
write(6,'(/,a)') ' <<<+- FEM_Zoo init -+>>>' write(6,'(/,a)') ' <<<+- FEM_Zoo init -+>>>'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 2D linear ! 2D linear
FEM_Zoo_nQuadrature(2,1) = 1 FEM_Zoo_nQuadrature(2,1) = 1
allocate(FEM_Zoo_QuadratureWeights(2,1)%p(1))
allocate(FEM_Zoo_QuadraturePoints (2,1)%p(2)) allocate(FEM_Zoo_QuadratureWeights(2,1)%p(1))
FEM_Zoo_QuadratureWeights(2,1)%p(1) = 1.0_pReal 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)) 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 ! 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_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
FEM_Zoo_QuadratureWeights(2,2)%p(1:3) = 1.0_pReal/3.0_pReal
call FEM_Zoo_permutationStar21([1.0_pReal/6.0_pReal], & allocate(FEM_Zoo_QuadraturePoints (2,2)%p(6))
FEM_Zoo_QuadraturePoints(2,2)%p(1:6)) FEM_Zoo_QuadraturePoints (2,2)%p(1:6) = FEM_Zoo_permutationStar21([1.0_pReal/6.0_pReal])
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 2D cubic ! 2D cubic
FEM_Zoo_nQuadrature(2,3) = 6 FEM_Zoo_nQuadrature(2,3) = 6
allocate(FEM_Zoo_QuadratureWeights(2,3)%p(6 ))
allocate(FEM_Zoo_QuadraturePoints (2,3)%p(12)) 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(1:3) = 0.22338158967801146570_pReal
call FEM_Zoo_permutationStar21([0.44594849091596488632_pReal], & FEM_Zoo_QuadratureWeights(2,3)%p(4:6) = 0.10995174365532186764_pReal
FEM_Zoo_QuadraturePoints(2,3)%p(1:6))
FEM_Zoo_QuadratureWeights(2,3)%p(4:6) = 0.10995174365532186764_pReal allocate(FEM_Zoo_QuadraturePoints (2,3)%p(12))
call FEM_Zoo_permutationStar21([0.091576213509770743460_pReal], & FEM_Zoo_QuadraturePoints (2,3)%p(1:6) = FEM_Zoo_permutationStar21([0.44594849091596488632_pReal])
FEM_Zoo_QuadraturePoints(2,3)%p(7:12)) FEM_Zoo_QuadraturePoints (2,3)%p(7:12)= FEM_Zoo_permutationStar21([0.091576213509770743460_pReal])
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 2D quartic ! 2D quartic
FEM_Zoo_nQuadrature(2,4) = 12 FEM_Zoo_nQuadrature(2,4) = 12
allocate(FEM_Zoo_QuadratureWeights(2,4)%p(12))
allocate(FEM_Zoo_QuadraturePoints (2,4)%p(24)) 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(1:3) = 0.11678627572638_pReal
call FEM_Zoo_permutationStar21([0.24928674517091_pReal], & FEM_Zoo_QuadratureWeights(2,4)%p(4:6) = 0.05084490637021_pReal
FEM_Zoo_QuadraturePoints(2,4)%p(1:6)) FEM_Zoo_QuadratureWeights(2,4)%p(7:12) = 0.08285107561837_pReal
FEM_Zoo_QuadratureWeights(2,4)%p(4:6) = 0.05084490637021_pReal
call FEM_Zoo_permutationStar21([0.06308901449150_pReal], & allocate(FEM_Zoo_QuadraturePoints (2,4)%p(24))
FEM_Zoo_QuadraturePoints(2,4)%p(7:12)) FEM_Zoo_QuadraturePoints (2,4)%p(1:6) = FEM_Zoo_permutationStar21([0.24928674517091_pReal])
FEM_Zoo_QuadratureWeights(2,4)%p(7:12) = 0.08285107561837_pReal FEM_Zoo_QuadraturePoints (2,4)%p(7:12) = FEM_Zoo_permutationStar21([0.06308901449150_pReal])
call FEM_Zoo_permutationStar111([0.31035245103378_pReal, 0.63650249912140_pReal], & FEM_Zoo_QuadraturePoints (2,4)%p(13:24)= FEM_Zoo_permutationStar111([0.31035245103378_pReal, 0.63650249912140_pReal])
FEM_Zoo_QuadraturePoints(2,4)%p(13:24))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 2D order 5 ! 2D order 5
FEM_Zoo_nQuadrature(2,5) = 16 FEM_Zoo_nQuadrature(2,5) = 16
allocate(FEM_Zoo_QuadratureWeights(2,5)%p(16))
allocate(FEM_Zoo_QuadraturePoints (2,5)%p(32)) allocate(FEM_Zoo_QuadratureWeights(2,5)%p(16))
FEM_Zoo_QuadratureWeights(2,5)%p(1 ) = 0.14431560767779_pReal FEM_Zoo_QuadratureWeights(2,5)%p(1 ) = 0.14431560767779_pReal
call FEM_Zoo_permutationStar3([0.33333333333333_pReal], & FEM_Zoo_QuadratureWeights(2,5)%p(2:4) = 0.09509163426728_pReal
FEM_Zoo_QuadraturePoints(2,5)%p(1:2)) FEM_Zoo_QuadratureWeights(2,5)%p(5:7) = 0.10321737053472_pReal
FEM_Zoo_QuadratureWeights(2,5)%p(2:4) = 0.09509163426728_pReal FEM_Zoo_QuadratureWeights(2,5)%p(8:10) = 0.03245849762320_pReal
call FEM_Zoo_permutationStar21([0.45929258829272_pReal], & FEM_Zoo_QuadratureWeights(2,5)%p(11:16)= 0.02723031417443_pReal
FEM_Zoo_QuadraturePoints(2,5)%p(3:8))
FEM_Zoo_QuadratureWeights(2,5)%p(5:7) = 0.10321737053472_pReal allocate(FEM_Zoo_QuadraturePoints (2,5)%p(32))
call FEM_Zoo_permutationStar21([0.17056930775176_pReal], & FEM_Zoo_QuadraturePoints (2,5)%p(1:2) = FEM_Zoo_permutationStar3([0.33333333333333_pReal])
FEM_Zoo_QuadraturePoints(2,5)%p(9:14)) FEM_Zoo_QuadraturePoints (2,5)%p(3:8) = FEM_Zoo_permutationStar21([0.45929258829272_pReal])
FEM_Zoo_QuadratureWeights(2,5)%p(8:10) = 0.03245849762320_pReal FEM_Zoo_QuadraturePoints (2,5)%p(9:14) = FEM_Zoo_permutationStar21([0.17056930775176_pReal])
call FEM_Zoo_permutationStar21([0.05054722831703_pReal], & FEM_Zoo_QuadraturePoints (2,5)%p(15:20)= FEM_Zoo_permutationStar21([0.05054722831703_pReal])
FEM_Zoo_QuadraturePoints(2,5)%p(15:20)) FEM_Zoo_QuadraturePoints (2,5)%p(21:32)=FEM_Zoo_permutationStar111([0.26311282963464_pReal, 0.72849239295540_pReal])
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))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 3D linear ! 3D linear
FEM_Zoo_nQuadrature(3,1) = 1 FEM_Zoo_nQuadrature(3,1) = 1
allocate(FEM_Zoo_QuadratureWeights(3,1)%p(1))
allocate(FEM_Zoo_QuadraturePoints (3,1)%p(3)) allocate(FEM_Zoo_QuadratureWeights(3,1)%p(1))
FEM_Zoo_QuadratureWeights(3,1)%p(1) = 1.0_pReal 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)) allocate(FEM_Zoo_QuadraturePoints (3,1)%p(3))
FEM_Zoo_QuadraturePoints (3,1)%p(1:3)= FEM_Zoo_permutationStar4([0.25_pReal])
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 3D quadratic ! 3D quadratic
FEM_Zoo_nQuadrature(3,2) = 4 FEM_Zoo_nQuadrature(3,2) = 4
allocate(FEM_Zoo_QuadratureWeights(3,2)%p(4 ))
allocate(FEM_Zoo_QuadraturePoints (3,2)%p(12)) allocate(FEM_Zoo_QuadratureWeights(3,2)%p(4))
FEM_Zoo_QuadratureWeights(3,2)%p(1:4) = 0.25_pReal 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)) allocate(FEM_Zoo_QuadraturePoints (3,2)%p(12))
FEM_Zoo_QuadraturePoints (3,2)%p(1:12)= FEM_Zoo_permutationStar31([0.13819660112501051518_pReal])
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 3D cubic ! 3D cubic
FEM_Zoo_nQuadrature(3,3) = 14 FEM_Zoo_nQuadrature(3,3) = 14
allocate(FEM_Zoo_QuadratureWeights(3,3)%p(14))
allocate(FEM_Zoo_QuadraturePoints (3,3)%p(42)) allocate(FEM_Zoo_QuadratureWeights(3,3)%p(14))
FEM_Zoo_QuadratureWeights(3,3)%p(1:4) = 0.073493043116361949544_pReal FEM_Zoo_QuadratureWeights(3,3)%p(5:8) = 0.11268792571801585080_pReal
call FEM_Zoo_permutationStar31([0.092735250310891226402_pReal], & FEM_Zoo_QuadratureWeights(3,3)%p(1:4) = 0.073493043116361949544_pReal
FEM_Zoo_QuadraturePoints(3,3)%p(1:12)) FEM_Zoo_QuadratureWeights(3,3)%p(9:14) = 0.042546020777081466438_pReal
FEM_Zoo_QuadratureWeights(3,3)%p(5:8) = 0.11268792571801585080_pReal
call FEM_Zoo_permutationStar31([0.31088591926330060980_pReal], & allocate(FEM_Zoo_QuadraturePoints (3,3)%p(42))
FEM_Zoo_QuadraturePoints(3,3)%p(13:24)) FEM_Zoo_QuadraturePoints (3,3)%p(1:12) = FEM_Zoo_permutationStar31([0.092735250310891226402_pReal])
FEM_Zoo_QuadratureWeights(3,3)%p(9:14) = 0.042546020777081466438_pReal FEM_Zoo_QuadraturePoints (3,3)%p(13:24)= FEM_Zoo_permutationStar31([0.31088591926330060980_pReal])
call FEM_Zoo_permutationStar22([0.045503704125649649492_pReal], & FEM_Zoo_QuadraturePoints (3,3)%p(25:42)= FEM_Zoo_permutationStar22([0.045503704125649649492_pReal])
FEM_Zoo_QuadraturePoints(3,3)%p(25:42))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 3D quartic ! 3D quartic
FEM_Zoo_nQuadrature(3,4) = 35 FEM_Zoo_nQuadrature(3,4) = 35
allocate(FEM_Zoo_QuadratureWeights(3,4)%p(35))
allocate(FEM_Zoo_QuadraturePoints (3,4)%p(105)) 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(1:4) = 0.0021900463965388_pReal
call FEM_Zoo_permutationStar31([0.0267367755543735_pReal], & FEM_Zoo_QuadratureWeights(3,4)%p(5:16) = 0.0143395670177665_pReal
FEM_Zoo_QuadraturePoints(3,4)%p(1:12)) FEM_Zoo_QuadratureWeights(3,4)%p(17:22) = 0.0250305395686746_pReal
FEM_Zoo_QuadratureWeights(3,4)%p(5:16) = 0.0143395670177665_pReal FEM_Zoo_QuadratureWeights(3,4)%p(23:34) = 0.0479839333057554_pReal
call FEM_Zoo_permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal], & FEM_Zoo_QuadratureWeights(3,4)%p(35) = 0.0931745731195340_pReal
FEM_Zoo_QuadraturePoints(3,4)%p(13:48))
FEM_Zoo_QuadratureWeights(3,4)%p(17:22) = 0.0250305395686746_pReal allocate(FEM_Zoo_QuadraturePoints (3,4)%p(105))
call FEM_Zoo_permutationStar22([0.4547545999844830_pReal], & FEM_Zoo_QuadraturePoints (3,4)%p(1:12) = FEM_Zoo_permutationStar31([0.0267367755543735_pReal])
FEM_Zoo_QuadraturePoints(3,4)%p(49:66)) FEM_Zoo_QuadraturePoints (3,4)%p(13:48) = FEM_Zoo_permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal])
FEM_Zoo_QuadratureWeights(3,4)%p(23:34) = 0.0479839333057554_pReal FEM_Zoo_QuadraturePoints (3,4)%p(49:66) = FEM_Zoo_permutationStar22([0.4547545999844830_pReal])
call FEM_Zoo_permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal], & FEM_Zoo_QuadraturePoints (3,4)%p(67:102) = FEM_Zoo_permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal])
FEM_Zoo_QuadraturePoints(3,4)%p(67:102)) FEM_Zoo_QuadraturePoints (3,4)%p(103:105)= FEM_Zoo_permutationStar4([0.25_pReal])
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))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 3D quintic ! 3D quintic
FEM_Zoo_nQuadrature(3,5) = 56 FEM_Zoo_nQuadrature(3,5) = 56
allocate(FEM_Zoo_QuadratureWeights(3,5)%p(56))
allocate(FEM_Zoo_QuadraturePoints (3,5)%p(168)) 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(1:4) = 0.0010373112336140_pReal
call FEM_Zoo_permutationStar31([0.0149520651530592_pReal], & FEM_Zoo_QuadratureWeights(3,5)%p(5:16) = 0.0096016645399480_pReal
FEM_Zoo_QuadraturePoints(3,5)%p(1:12)) FEM_Zoo_QuadratureWeights(3,5)%p(17:28) = 0.0164493976798232_pReal
FEM_Zoo_QuadratureWeights(3,5)%p(5:16) = 0.0096016645399480_pReal FEM_Zoo_QuadratureWeights(3,5)%p(29:40) = 0.0153747766513310_pReal
call FEM_Zoo_permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal], & FEM_Zoo_QuadratureWeights(3,5)%p(41:52) = 0.0293520118375230_pReal
FEM_Zoo_QuadraturePoints(3,5)%p(13:48)) FEM_Zoo_QuadratureWeights(3,5)%p(53:56) = 0.0366291366405108_pReal
FEM_Zoo_QuadratureWeights(3,5)%p(17:28) = 0.0164493976798232_pReal
call FEM_Zoo_permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal], & allocate(FEM_Zoo_QuadraturePoints (3,5)%p(168))
FEM_Zoo_QuadraturePoints(3,5)%p(49:84)) FEM_Zoo_QuadraturePoints (3,5)%p(1:12) = FEM_Zoo_permutationStar31([0.0149520651530592_pReal])
FEM_Zoo_QuadratureWeights(3,5)%p(29:40) = 0.0153747766513310_pReal FEM_Zoo_QuadraturePoints (3,5)%p(13:48) = FEM_Zoo_permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal])
call FEM_Zoo_permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_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_QuadraturePoints (3,5)%p(85:120) = FEM_Zoo_permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal])
FEM_Zoo_QuadratureWeights(3,5)%p(41:52) = 0.0293520118375230_pReal FEM_Zoo_QuadraturePoints (3,5)%p(121:156)= FEM_Zoo_permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal])
call FEM_Zoo_permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal], & FEM_Zoo_QuadraturePoints (3,5)%p(157:168)= FEM_Zoo_permutationStar31([0.1344783347929940_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))
end subroutine FEM_Zoo_init end subroutine FEM_Zoo_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief star 3 permutation of input !> @brief star 3 permutation of input
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar3(point,qPt) pure function FEM_Zoo_permutationStar3(point) result(qPt)
implicit none real(pReal), dimension(2) :: qPt
real(pReal) :: point(1), qPt(2,1), temp(3,1) real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(3,1) :: temp
temp(:,1) = [point(1), point(1), point(1)] temp(:,1) = [point(1), point(1), point(1)]
qPt = matmul(triangle, temp)
qPt = reshape(matmul(triangle, temp),[2])
end subroutine FEM_Zoo_permutationStar3 end function FEM_Zoo_permutationStar3
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief star 21 permutation of input !> @brief star 21 permutation of input
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar21(point,qPt) pure function FEM_Zoo_permutationStar21(point) result(qPt)
implicit none real(pReal), dimension(6) :: qPt
real(pReal) :: point(1), qPt(2,3), temp(3,3) 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(:,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(:,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)] temp(:,3) = [1.0_pReal - 2.0_pReal*point(1), point(1), point(1)]
qPt = matmul(triangle, temp)
qPt = reshape(matmul(triangle, temp),[6])
end subroutine FEM_Zoo_permutationStar21 end function FEM_Zoo_permutationStar21
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief star 111 permutation of input !> @brief star 111 permutation of input
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar111(point,qPt) pure function FEM_Zoo_permutationStar111(point) result(qPt)
implicit none real(pReal), dimension(12) :: qPt
real(pReal) :: point(2), qPt(2,6), temp(3,6) 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(:,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(:,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(:,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(:,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)] temp(:,6) = [1.0_pReal - point(1) - point(2), point(1), point(2)]
qPt = matmul(triangle, temp)
qPt = reshape(matmul(triangle, temp),[12])
end subroutine FEM_Zoo_permutationStar111 end function FEM_Zoo_permutationStar111
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief star 4 permutation of input !> @brief star 4 permutation of input
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar4(point,qPt) pure function FEM_Zoo_permutationStar4(point) result(qPt)
implicit none real(pReal), dimension(3) :: qPt
real(pReal) :: point(1), qPt(3,1), temp(4,1) real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(4,1) :: temp
temp(:,1) = [point(1), point(1), point(1), point(1)] temp(:,1) = [point(1), point(1), point(1), point(1)]
qPt = matmul(tetrahedron, temp)
qPt = reshape(matmul(tetrahedron, temp),[3])
end subroutine FEM_Zoo_permutationStar4 end function FEM_Zoo_permutationStar4
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief star 31 permutation of input !> @brief star 31 permutation of input
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar31(point,qPt) pure function FEM_Zoo_permutationStar31(point) result(qPt)
implicit none real(pReal), dimension(12) :: qPt
real(pReal) :: point(1), qPt(3,4), temp(4,4) 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(:,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(:,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(:,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)] temp(:,4) = [1.0_pReal - 3.0_pReal*point(1), point(1), point(1), point(1)]
qPt = matmul(tetrahedron, temp)
end subroutine FEM_Zoo_permutationStar31 qPt = reshape(matmul(tetrahedron, temp),[12])
end function FEM_Zoo_permutationStar31
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief star 22 permutation of input !> @brief star 22 permutation of input
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar22(point,qPt) pure function FEM_Zoo_permutationStar22(point) result(qPt)
implicit none real(pReal), dimension(18) :: qPt
real(pReal) :: point(1), qPt(3,6), temp(4,6) 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(:,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(:,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(:,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(:,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(:,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)] temp(:,6) = [point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), point(1)]
qPt = matmul(tetrahedron, temp)
qPt = reshape(matmul(tetrahedron, temp),[18])
end subroutine FEM_Zoo_permutationStar22 end function FEM_Zoo_permutationStar22
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief star 211 permutation of input !> @brief star 211 permutation of input
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar211(point,qPt) pure function FEM_Zoo_permutationStar211(point) result(qPt)
implicit none real(pReal), dimension(36) :: qPt
real(pReal) :: point(2), qPt(3,12), temp(4,12) 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(:,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(:,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(:,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(:,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(:,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(:,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(:,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(:,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(:,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(:,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(:,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)] temp(:,12) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), point(1)]
qPt = matmul(tetrahedron, temp)
qPt = reshape(matmul(tetrahedron, temp),[36])
end subroutine FEM_Zoo_permutationStar211 end function FEM_Zoo_permutationStar211
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief star 1111 permutation of input !> @brief star 1111 permutation of input
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar1111(point,qPt) pure function FEM_Zoo_permutationStar1111(point) result(qPt)
implicit none real(pReal), dimension(72) :: qPt
real(pReal) :: point(3), qPt(3,24), temp(4,24) real(pReal), dimension(3), intent(in) :: point
temp(:,1 ) = [point(1), point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3)] real(pReal), dimension(4,24) :: temp
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)
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 end module FEM_Zoo

157
src/mesh_FEM.f90
View File

@ -3,37 +3,39 @@
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, 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 !> @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 module mesh
#include <petsc/finclude/petscdmplex.h> #include <petsc/finclude/petscdmplex.h>
#include <petsc/finclude/petscis.h> #include <petsc/finclude/petscis.h>
#include <petsc/finclude/petscdmda.h> #include <petsc/finclude/petscdmda.h>
use prec, only: pReal, pInt use prec
use mesh_base use mesh_base
use PETScdmplex use PETScdmplex
use PETScdmda use PETScdmda
use PETScis use PETScis
use DAMASK_interface
use IO
use debug
use discretization
use numerics
use FEsolving
use FEM_Zoo
implicit none implicit none
private private
integer(pInt), public, parameter :: &
mesh_ElemType=1_pInt !< Element type of the mesh (only support homogeneous meshes) integer, public, protected :: &
integer(pInt), public, protected :: &
mesh_Nboundaries, & mesh_Nboundaries, &
mesh_NcpElems, & !< total number of CP elements in mesh mesh_NcpElems, & !< total number of CP elements in mesh
mesh_NcpElemsGlobal, & mesh_NcpElemsGlobal, &
mesh_Nnodes, & !< total number of nodes in mesh mesh_Nnodes !< total number of nodes in mesh
mesh_maxNipNeighbors
!!!! BEGIN DEPRECATED !!!!! !!!! BEGIN DEPRECATED !!!!!
integer(pInt), public, protected :: & integer, public, protected :: &
mesh_maxNips !< max number of IPs in any CP element mesh_maxNips !< max number of IPs in any CP element
!!!! BEGIN DEPRECATED !!!!! !!!! BEGIN DEPRECATED !!!!!
integer(pInt), dimension(:,:), allocatable, public, protected :: & integer, dimension(:,:), allocatable, public, protected :: &
mesh_element !DEPRECATED mesh_element !DEPRECATED
real(pReal), dimension(:,:), allocatable, public :: & real(pReal), dimension(:,:), allocatable, public :: &
@ -46,35 +48,12 @@ use PETScis
real(pReal), dimension(:,:,:), allocatable, public :: & real(pReal), dimension(:,:,:), allocatable, public :: &
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) 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 DM, public :: geomMesh
PetscInt, dimension(:), allocatable, public, protected :: & PetscInt, dimension(:), allocatable, public, protected :: &
mesh_boundaries 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 type, public, extends(tMesh) :: tMesh_FEM
@ -96,18 +75,17 @@ contains
subroutine tMesh_FEM_init(self,dimen,order,nodes) subroutine tMesh_FEM_init(self,dimen,order,nodes)
implicit none integer, intent(in) :: dimen
integer, intent(in) :: dimen integer, intent(in) :: order
integer(pInt), intent(in) :: order real(pReal), intent(in), dimension(:,:) :: nodes
real(pReal), intent(in), dimension(:,:) :: nodes
class(tMesh_FEM) :: self class(tMesh_FEM) :: self
if (dimen == 2_pInt) then if (dimen == 2) then
if (order == 1_pInt) call self%tMesh%init('mesh',1_pInt,nodes) if (order == 1) call self%tMesh%init('mesh',1,nodes)
if (order == 2_pInt) call self%tMesh%init('mesh',2_pInt,nodes) if (order == 2) call self%tMesh%init('mesh',2,nodes)
elseif(dimen == 3_pInt) then elseif(dimen == 3) then
if (order == 1_pInt) call self%tMesh%init('mesh',6_pInt,nodes) if (order == 1) call self%tMesh%init('mesh',6,nodes)
if (order == 2_pInt) call self%tMesh%init('mesh',8_pInt,nodes) if (order == 2) call self%tMesh%init('mesh',8,nodes)
endif endif
end subroutine tMesh_FEM_init 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 !> @brief initializes the mesh by calling all necessary private routines the mesh module
!! Order and routines strongly depend on type of solver !! Order and routines strongly depend on type of solver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_init() subroutine mesh_init
use DAMASK_interface
use IO, only: & integer, dimension(1), parameter:: FE_geomtype = [1] !< geometry type of particular element type
IO_error, &
IO_open_file, & integer, dimension(1) :: FE_Nips !< number of IPs in a specific type of element
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
implicit none integer, parameter :: FILEUNIT = 222
integer(pInt), parameter :: FILEUNIT = 222_pInt integer :: j
integer(pInt) :: j integer, allocatable, dimension(:) :: chunkPos
integer(pInt), allocatable, dimension(:) :: chunkPos
integer :: dimPlex integer :: dimPlex
integer, parameter :: &
mesh_ElemType=1 !< Element type of the mesh (only support homogeneous meshes)
character(len=512) :: & character(len=512) :: &
line line
logical :: flag 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(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
call MPI_Bcast(dimPlex,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) call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call DMGetLabelIdIS(globalMesh,'Face Sets',faceSetIS,ierr) call DMGetLabelIdIS(globalMesh,'Face Sets',faceSetIS,ierr)
@ -230,31 +192,31 @@ subroutine mesh_init()
call DMGetStratumSize(geomMesh,'depth',0,mesh_Nnodes,ierr) call DMGetStratumSize(geomMesh,'depth',0,mesh_Nnodes,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder) FE_Nips(FE_geomtype(1)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder)
mesh_maxNips = FE_Nips(1_pInt) mesh_maxNips = FE_Nips(1)
write(6,*) 'mesh_maxNips',mesh_maxNips write(6,*) 'mesh_maxNips',mesh_maxNips
call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p) call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p)
call mesh_FEM_build_ipVolumes(dimPlex) 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 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( 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) call DMGetLabelValue(geomMesh,'material',j-1,mesh_element(4,j),ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
end do end do
if (debug_e < 1 .or. debug_e > mesh_NcpElems) & if (debug_e < 1 .or. debug_e > mesh_NcpElems) &
call IO_error(602_pInt,ext_msg='element') ! selected element does not exist 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_pInt,debug_e)))) & if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2,debug_e)))) &
call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP 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) 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... allocate(FEsolving_execIP(2,mesh_NcpElems)); FEsolving_execIP = 1 ! 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 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) allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal)
call theMesh%init(dimplex,integrationOrder,mesh_node0) call theMesh%init(dimplex,integrationOrder,mesh_node0)
@ -263,6 +225,10 @@ subroutine mesh_init()
theMesh%homogenizationAt = mesh_element(3,:) theMesh%homogenizationAt = mesh_element(3,:)
theMesh%microstructureAt = mesh_element(4,:) 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 end subroutine mesh_init
@ -271,12 +237,11 @@ end subroutine mesh_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function mesh_cellCenterCoordinates(ip,el) pure function mesh_cellCenterCoordinates(ip,el)
implicit none integer, intent(in) :: el, & !< element number
integer(pInt), intent(in) :: el, & !< element number ip !< integration point number
ip !< integration point number
real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell 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. !> and one corner at the central ip.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_FEM_build_ipVolumes(dimPlex) subroutine mesh_FEM_build_ipVolumes(dimPlex)
use math, only: &
math_I3, &
math_det33
implicit none
PetscInt :: dimPlex PetscInt :: dimPlex
PetscReal :: vol PetscReal :: vol
PetscReal, target :: cent(dimPlex), norm(dimPlex) PetscReal, target :: cent(dimPlex), norm(dimPlex)
@ -332,9 +293,9 @@ end subroutine mesh_FEM_build_ipVolumes
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints) subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints)
implicit none
PetscInt, intent(in) :: dimPlex PetscInt, intent(in) :: dimPlex
PetscReal, intent(in) :: qPoints(mesh_maxNips*dimPlex) PetscReal, intent(in) :: qPoints(mesh_maxNips*dimPlex)
PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), invcellJ(dimPlex*dimPlex) PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), invcellJ(dimPlex*dimPlex)
PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:)
PetscReal :: detJ PetscReal :: detJ

13
src/mesh_abaqus.f90
View File

@ -8,9 +8,12 @@
module mesh module mesh
use prec use prec
use mesh_base use mesh_base
use geometry_plastic_nonlocal
use discretization
implicit none implicit none
private private
integer, public, protected :: & integer, public, protected :: &
mesh_NcpElems, & !< total number of CP elements in local mesh mesh_NcpElems, & !< total number of CP elements in local mesh
mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes) 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%homogenizationAt = mesh_element(3,:)
theMesh%microstructureAt = mesh_element(4,:) 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 contains
@ -1909,6 +1920,8 @@ subroutine mesh_build_ipNeighborhood
enddo enddo
enddo enddo
call geometry_plastic_nonlocal_set_IPneighborhood(mesh_ipNeighborhood)
contains contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief find face-matching element of same type !> @brief find face-matching element of same type

4
src/mesh_base.f90
View File

@ -23,7 +23,7 @@ module mesh_base
elem elem
real(pReal), dimension(:,:), allocatable, public :: & real(pReal), dimension(:,:), allocatable, public :: &
ipVolume, & !< volume associated with each IP (initially!) 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) node !< node x,y,z coordinates (deformed)
integer(pInt), dimension(:,:), allocatable, public :: & integer(pInt), dimension(:,:), allocatable, public :: &
cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID 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 self%type = meshType
call self%elem%init(elemType) call self%elem%init(elemType)
self%node0 = nodes self%node_0 = nodes
self%nNodes = size(nodes,2) self%nNodes = size(nodes,2)
end subroutine tMesh_base_init end subroutine tMesh_base_init

648
src/mesh_grid.f90
View File

@ -1,204 +1,117 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, 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 !> @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 module mesh
use, intrinsic :: iso_c_binding
use prec
use geometry_plastic_nonlocal
use mesh_base
#include <petsc/finclude/petscsys.h> #include <petsc/finclude/petscsys.h>
use PETScsys use PETScsys
use prec
use system_routines
use DAMASK_interface use DAMASK_interface
use IO use IO
use debug use debug
use numerics use numerics
use discretization
use geometry_plastic_nonlocal
use FEsolving use FEsolving
implicit none implicit none
private private
include 'fftw3-mpi.f03'
integer, public, protected :: &
mesh_Nnodes
integer, dimension(:), allocatable, private :: &
microGlobal
integer, dimension(:), allocatable, private :: &
mesh_homogenizationAt
integer, dimension(:,:), allocatable, public, protected :: &
mesh_element !< entryCount and list of elements containing node
integer, 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 :: & real(pReal), dimension(:,:,:), allocatable, public :: &
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!)
real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & integer, dimension(3), 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, dimension(3), public, protected :: &
grid !< (global) grid grid !< (global) grid
integer, public, protected :: & integer, public, protected :: &
mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh
grid3, & !< (local) grid in 3rd direction grid3, & !< (local) grid in 3rd direction
grid3Offset !< (local) grid offset in 3rd direction grid3Offset !< (local) grid offset in 3rd direction
real(pReal), dimension(3), public, protected :: & real(pReal), dimension(3), public, protected :: &
geomSize geomSize
real(pReal), public, protected :: & real(pReal), public, protected :: &
size3, & !< (local) size in 3rd direction size3, & !< (local) size in 3rd direction
size3offset !< (local) size offset in 3rd direction size3offset !< (local) size offset in 3rd direction
public :: & public :: &
mesh_init 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
integer, dimension(3), public :: &
grid !< (global) grid
integer, 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
type(tMesh_grid), public, protected :: theMesh
contains contains
subroutine tMesh_grid_init(self,nodes)
class(tMesh_grid) :: self
real(pReal), dimension(:,:), intent(in) :: nodes
call self%tMesh%init('grid',10,nodes)
end subroutine tMesh_grid_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief initializes the mesh by calling all necessary private routines the mesh module !> @brief reads the geometry file to obtain information on discretization
!! Order and routines strongly depend on type of solver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_init(ip,el) subroutine mesh_init(ip,el)
integer(C_INTPTR_T) :: devNull, local_K, local_K_offset integer, intent(in), optional :: el, ip ! for compatibility reasons
integer :: ierr, worldsize, j
integer, intent(in), optional :: el, ip include 'fftw3-mpi.f03'
logical :: myDebug real(pReal), dimension(3) :: &
mySize !< domain size of this process
integer, dimension(3) :: &
myGrid !< domain grid of this process
integer, dimension(:), allocatable :: &
microstructureAt, &
homogenizationAt
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) !--------------------------------------------------------------------------------------------------
! grid solver specific quantities
call fftw_mpi_init()
call mesh_spectral_read_grid()
call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr)
if(ierr /=0) call IO_error(894, ext_msg='MPI_comm_size')
if(worldsize>grid(3)) call IO_error(894, ext_msg='number of processes exceeds grid(3)') if(worldsize>grid(3)) call IO_error(894, ext_msg='number of processes exceeds grid(3)')
call fftw_mpi_init
devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), &
int(grid(2),C_INTPTR_T), & int(grid(2),C_INTPTR_T), &
int(grid(1),C_INTPTR_T)/2+1, & int(grid(1),C_INTPTR_T)/2+1, &
PETSC_COMM_WORLD, & PETSC_COMM_WORLD, &
local_K, & ! domain grid size along z z, & ! domain grid size along z
local_K_offset) ! domain grid offset along z z_offset) ! domain grid offset along z
grid3 = int(local_K,pInt) grid3 = int(z)
grid3Offset = int(local_K_offset,pInt) grid3Offset = int(z_offset)
size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal)
size3Offset = geomSize(3)*real(grid3Offset,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]
mesh_NcpElemsGlobal = product(grid) !--------------------------------------------------------------------------------------------------
! 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
mesh_Nnodes = product(grid(1:2) + 1)*(grid3 + 1) mesh_ipCoordinates = IPcoordinates(myGrid,mySize,grid3Offset)
call discretization_init(homogenizationAt,microstructureAt, &
reshape(mesh_ipCoordinates,[3,product(myGrid)]), &
Nodes(myGrid,mySize,grid3Offset))
mesh_node0 = mesh_spectral_build_nodes() FEsolving_execElem = [1,product(myGrid)] ! parallel loop bounds set to comprise all elements
mesh_node = mesh_node0 allocate(FEsolving_execIP(2,product(myGrid)),source=1) ! parallel loop bounds set to comprise the only IP
if (myDebug) write(6,'(a)') ' Built nodes'; flush(6)
call theMesh%init(mesh_node) !--------------------------------------------------------------------------------------------------
call theMesh%setNelems(product(grid(1:2))*grid3) ! geometry information required by the nonlocal CP model
call mesh_spectral_build_elements() call geometry_plastic_nonlocal_setIPvolume(reshape([(product(mySize/real(myGrid,pReal)),j=1,product(myGrid))], &
mesh_homogenizationAt = mesh_homogenizationAt(product(grid(1:2))*grid3Offset+1: & [1,product(myGrid)]))
product(grid(1:2))*(grid3Offset+grid3)) ! reallocate/shrink in case of MPI call geometry_plastic_nonlocal_setIParea (cellEdgeArea(mySize,myGrid))
call geometry_plastic_nonlocal_setIPareaNormal (cellEdgeNormal(product(myGrid)))
if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call geometry_plastic_nonlocal_setIPneighborhood(IPneighborhood(myGrid))
if (myDebug) write(6,'(a)') ' Built cell nodes'; flush(6) !--------------------------------------------------------------------------------------------------
mesh_ipCoordinates = mesh_build_ipCoordinates() ! sanity checks for debugging
if (myDebug) write(6,'(a)') ' Built IP coordinates'; flush(6) if (debug_e < 1 .or. debug_e > product(myGrid)) call IO_error(602,ext_msg='element') ! selected element does not exist
allocate(mesh_ipVolume(1,theMesh%nElems),source=product([geomSize(1:2),size3]/real([grid(1:2),grid3]))) if (debug_i /= 1) call IO_error(602,ext_msg='IP') ! selected IP does not exist
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,ext_msg='element') ! selected element does not exist
if (debug_i < 1 .or. debug_i > theMesh%elem%nIPs) &
call IO_error(602,ext_msg='IP') ! selected element does not have requested IP
FEsolving_execElem = [ 1,theMesh%nElems ] ! parallel loop bounds set to comprise all DAMASK elements
allocate(FEsolving_execIP(2,theMesh%nElems), source=1) ! parallel loop bounds set to comprise from first IP...
forall (j = 1: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,:)
!!!!!!!!!!!!!!!!!!!!!!!!
end subroutine mesh_init end subroutine mesh_init
@ -208,13 +121,19 @@ end subroutine mesh_init
!> @details important variables have an implicit "save" attribute. Therefore, this function is !> @details important variables have an implicit "save" attribute. Therefore, this function is
! supposed to be called only once! ! supposed to be called only once!
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_read_grid() subroutine readGeom(grid,geomSize,microstructure,homogenization)
character(len=:), allocatable :: rawData integer, dimension(3), intent(out) :: grid ! grid (for all processes!)
character(len=65536) :: line 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, allocatable, dimension(:) :: chunkPos
integer :: h =- 1 integer :: &
integer :: & h =- 1, &
headerLength = -1, & !< length of header (in lines) headerLength = -1, & !< length of header (in lines)
fileLength, & !< length of the geom file (in characters) fileLength, & !< length of the geom file (in characters)
fileUnit, & fileUnit, &
@ -230,7 +149,7 @@ subroutine mesh_spectral_read_grid()
geomSize = -1.0_pReal geomSize = -1.0_pReal
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! read data as stream ! read raw data as stream
inquire(file = trim(geometryFile), size=fileLength) inquire(file = trim(geometryFile), size=fileLength)
open(newunit=fileUnit, file=trim(geometryFile), access='stream',& open(newunit=fileUnit, file=trim(geometryFile), access='stream',&
status='old', position='rewind', action='read',iostat=myStat) status='old', position='rewind', action='read',iostat=myStat)
@ -244,10 +163,10 @@ subroutine mesh_spectral_read_grid()
endPos = index(rawData,new_line('')) endPos = index(rawData,new_line(''))
if(endPos <= index(rawData,'head')) then if(endPos <= index(rawData,'head')) then
startPos = len(rawData) startPos = len(rawData)
call IO_error(error_ID=841, ext_msg='mesh_spectral_read_grid') call IO_error(error_ID=841, ext_msg='readGeom')
else else
chunkPos = IO_stringPos(rawData(1:endPos)) chunkPos = IO_stringPos(rawData(1:endPos))
if (chunkPos(1) < 2) call IO_error(error_ID=841, ext_msg='mesh_spectral_read_grid') if (chunkPos(1) < 2) call IO_error(error_ID=841, ext_msg='readGeom')
headerLength = IO_intValue(rawData(1:endPos),chunkPos,1) headerLength = IO_intValue(rawData(1:endPos),chunkPos,1)
startPos = endPos + 1 startPos = endPos + 1
endif endif
@ -303,14 +222,14 @@ subroutine mesh_spectral_read_grid()
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! sanity checks ! sanity checks
if(h < 1) & if(h < 1) &
call IO_error(error_ID = 842, ext_msg='homogenization (mesh_spectral_read_grid)') call IO_error(error_ID = 842, ext_msg='homogenization (readGeom)')
if(any(grid < 1)) & if(any(grid < 1)) &
call IO_error(error_ID = 842, ext_msg='grid (mesh_spectral_read_grid)') call IO_error(error_ID = 842, ext_msg='grid (readGeom)')
if(any(geomSize < 0.0_pReal)) & if(any(geomSize < 0.0_pReal)) &
call IO_error(error_ID = 842, ext_msg='size (mesh_spectral_read_grid)') call IO_error(error_ID = 842, ext_msg='size (readGeom)')
allocate(microGlobal(product(grid)), source = -1) allocate(microstructure(product(grid)), source = -1) ! too large in case of MPI (shrink later, not very elegant)
allocate(mesh_homogenizationAt(product(grid)), source = h) ! 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 ! read and interpret content
@ -325,18 +244,18 @@ subroutine mesh_spectral_read_grid()
noCompression: if (chunkPos(1) /= 3) then noCompression: if (chunkPos(1) /= 3) then
c = chunkPos(1) c = chunkPos(1)
microGlobal(e:e+c-1) = [(IO_intValue(line,chunkPos,i+1), i=0, c-1)] microstructure(e:e+c-1) = [(IO_intValue(line,chunkPos,i+1), i=0, c-1)]
else noCompression else noCompression
compression: if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then compression: if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then
c = IO_intValue(line,chunkPos,1) c = IO_intValue(line,chunkPos,1)
microGlobal(e:e+c-1) = [(IO_intValue(line,chunkPos,3),i = 1,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 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 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)) o = merge(+1, -1, IO_intValue(line,chunkPos,3) > IO_intValue(line,chunkPos,1))
microGlobal(e:e+c-1) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3),o)] microstructure(e:e+c-1) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3),o)]
else compression else compression
c = chunkPos(1) c = chunkPos(1)
microGlobal(e:e+c-1) = [(IO_intValue(line,chunkPos,i+1), i=0, c-1)] microstructure(e:e+c-1) = [(IO_intValue(line,chunkPos,i+1), i=0, c-1)]
endif compression endif compression
endif noCompression endif noCompression
@ -345,244 +264,217 @@ subroutine mesh_spectral_read_grid()
if (e-1 /= product(grid)) call IO_error(error_ID = 843, 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, dimension(3), intent(in) :: grid ! grid (for this process!)
integer :: n,a,b,c real(pReal), dimension(3), intent(in) :: geomSize ! size (for this process!)
integer, intent(in) :: grid3Offset ! grid(3) offset
n = 0 real(pReal), dimension(3,1,product(grid)) :: ipCoordinates
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
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
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
end function mesh_build_ipCoordinates
!--------------------------------------------------------------------------------------------------
!> @brief Store FEid, type, material, texture, and node list per element.
!! Allocates global array 'mesh_element'
!--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_build_elements
integer :: & integer :: &
e, & a,b,c, &
elemOffset 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
allocate(mesh_element (4+8,theMesh%nElems), source = 0) end function IPcoordinates
elemOffset = product(grid(1:2))*grid3Offset
do e=1, theMesh%nElems
mesh_element( 1,e) = -1 ! DEPRECATED
mesh_element( 2,e) = -1 ! DEPRECATED
mesh_element( 3,e) = mesh_homogenizationAt(e)
mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure
mesh_element( 5,e) = e + (e-1)/grid(1) + &
((e-1)/(grid(1)*grid(2)))*(grid(1)+1) ! base node
mesh_element( 6,e) = mesh_element(5,e) + 1
mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2
mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1
mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1) * (grid(2) + 1) ! second floor base node
mesh_element(10,e) = mesh_element(9,e) + 1
mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2
mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1
enddo
end subroutine mesh_spectral_build_elements !---------------------------------------------------------------------------------------------------
!> @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 = 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 nodes
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief build neighborhood relations for spectral !> @brief Calculate IP interface areas
!> @details assign globals: mesh_ipNeighborhood
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_build_ipNeighborhood pure function cellEdgeArea(geomSize,grid)
real(pReal), dimension(3), intent(in) :: geomSize ! size (for this process!)
integer, dimension(3), intent(in) :: grid ! grid (for this process!)
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 :: & integer :: &
x,y,z, & x,y,z, &
e e
allocate(mesh_ipNeighborhood(3,6,1,theMesh%nElems),source=0)
e = 0 e = 0
do z = 0,grid3-1 do z = 0,grid(3)-1; do y = 0,grid(2)-1; do x = 0,grid(1)-1
do y = 0,grid(2)-1 e = e + 1
do x = 0,grid(1)-1 IPneighborhood(1,1,1,e) = z * grid(1) * grid(2) &
e = e + 1 + y * grid(1) &
! neigboring element + modulo(x+1,grid(1)) &
mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & + 1
+ y * grid(1) & IPneighborhood(1,2,1,e) = z * grid(1) * grid(2) &
+ modulo(x+1,grid(1)) & + y * grid(1) &
+ 1 + modulo(x-1,grid(1)) &
mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & + 1
+ y * grid(1) & IPneighborhood(1,3,1,e) = z * grid(1) * grid(2) &
+ modulo(x-1,grid(1)) & + modulo(y+1,grid(2)) * grid(1) &
+ 1 + x &
mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & + 1
+ modulo(y+1,grid(2)) * grid(1) & IPneighborhood(1,4,1,e) = z * grid(1) * grid(2) &
+ x & + modulo(y-1,grid(2)) * grid(1) &
+ 1 + x &
mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & + 1
+ modulo(y-1,grid(2)) * grid(1) & IPneighborhood(1,5,1,e) = modulo(z+1,grid(3)) * grid(1) * grid(2) &
+ x & + y * grid(1) &
+ 1 + x &
mesh_ipNeighborhood(1,5,1,e) = modulo(z+1,grid3) * grid(1) * grid(2) & + 1
+ y * grid(1) & IPneighborhood(1,6,1,e) = modulo(z-1,grid(3)) * grid(1) * grid(2) &
+ x & + y * grid(1) &
+ 1 + x &
mesh_ipNeighborhood(1,6,1,e) = modulo(z-1,grid3) * grid(1) * grid(2) & + 1
+ y * grid(1) & IPneighborhood(2,1:6,1,e) = 1
+ x & IPneighborhood(3,1,1,e) = 2
+ 1 IPneighborhood(3,2,1,e) = 1
! neigboring IP IPneighborhood(3,3,1,e) = 4
mesh_ipNeighborhood(2,1:6,1,e) = 1 IPneighborhood(3,4,1,e) = 3
! neigboring face IPneighborhood(3,5,1,e) = 6
mesh_ipNeighborhood(3,1,1,e) = 2 IPneighborhood(3,6,1,e) = 5
mesh_ipNeighborhood(3,2,1,e) = 1
mesh_ipNeighborhood(3,3,1,e) = 4
mesh_ipNeighborhood(3,4,1,e) = 3
mesh_ipNeighborhood(3,5,1,e) = 6
mesh_ipNeighborhood(3,6,1,e) = 5
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)
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 enddo; enddo; enddo
!-------------------------------------------------------------------------------------------------- end function IPneighborhood
! 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
!-------------------------------------------------------------------------------------------------- !!--------------------------------------------------------------------------------------------------
!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' !!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes)
!-------------------------------------------------------------------------------------------------- !!--------------------------------------------------------------------------------------------------
pure function mesh_build_ipAreas() !function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes)
!
real(pReal), dimension(6,1,theMesh%nElems) :: mesh_build_ipAreas ! real(pReal), intent(in), dimension(:,:,:,:) :: &
! centres
mesh_build_ipAreas(1:2,1,:) = geomSize(2)/real(grid(2)) * geomSize(3)/real(grid(3)) ! real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: &
mesh_build_ipAreas(3:4,1,:) = geomSize(3)/real(grid(3)) * geomSize(1)/real(grid(1)) ! nodes
mesh_build_ipAreas(5:6,1,:) = geomSize(1)/real(grid(1)) * geomSize(2)/real(grid(2)) ! real(pReal), intent(in), dimension(3) :: &
! gDim
end function mesh_build_ipAreas ! 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
!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' !
!-------------------------------------------------------------------------------------------------- ! integer :: &
pure function mesh_build_ipNormals() ! i,j,k,n
! integer, dimension(3), parameter :: &
real, dimension(3,6,1,theMesh%nElems) :: mesh_build_ipNormals ! diag = 1
! integer, dimension(3) :: &
mesh_build_ipNormals(1:3,1,1,:) = spread([+1.0_pReal, 0.0_pReal, 0.0_pReal],2,theMesh%nElems) ! shift = 0, &
mesh_build_ipNormals(1:3,2,1,:) = spread([-1.0_pReal, 0.0_pReal, 0.0_pReal],2,theMesh%nElems) ! lookup = 0, &
mesh_build_ipNormals(1:3,3,1,:) = spread([ 0.0_pReal,+1.0_pReal, 0.0_pReal],2,theMesh%nElems) ! me = 0, &
mesh_build_ipNormals(1:3,4,1,:) = spread([ 0.0_pReal,-1.0_pReal, 0.0_pReal],2,theMesh%nElems) ! iRes = 0
mesh_build_ipNormals(1:3,5,1,:) = spread([ 0.0_pReal, 0.0_pReal,+1.0_pReal],2,theMesh%nElems) ! integer, dimension(3,8) :: &
mesh_build_ipNormals(1:3,6,1,:) = spread([ 0.0_pReal, 0.0_pReal,-1.0_pReal],2,theMesh%nElems) ! neighbor = reshape([ &
! 0, 0, 0, &
end function mesh_build_ipNormals ! 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 end module mesh

2123
src/mesh_marc.f90
View File

File diff suppressed because it is too large Load Diff

238
src/numerics.f90
View File

@ -5,17 +5,24 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module numerics module numerics
use prec use prec
use IO
#ifdef PETSc
#include <petsc/finclude/petscsys.h>
use petscsys
#endif
!$ use OMP_LIB
implicit none implicit none
private private
integer(pInt), protected, public :: & integer, protected, public :: &
iJacoStiffness = 1_pInt, & !< frequency of stiffness update iJacoStiffness = 1, & !< frequency of stiffness update
nMPstate = 10_pInt, & !< materialpoint state loop limit nMPstate = 10, & !< materialpoint state loop limit
randomSeed = 0_pInt, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed randomSeed = 0, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed
worldrank = 0_pInt, & !< MPI worldrank (/=0 for MPI simulations only) worldrank = 0, & !< MPI worldrank (/=0 for MPI simulations only)
worldsize = 1_pInt, & !< MPI worldsize (/=1 for MPI simulations only) worldsize = 1, & !< MPI worldsize (/=1 for MPI simulations only)
numerics_integrator = 1_pInt !< method used for state integration Default 1: fix-point iteration numerics_integrator = 1 !< method used for state integration Default 1: fix-point iteration
integer(4), protected, public :: & integer(4), protected, public :: &
DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive
real(pReal), protected, public :: & real(pReal), protected, public :: &
@ -51,11 +58,11 @@ module numerics
err_thermal_tolRel = 1.0e-6_pReal, & !< relative tolerance for thermal equilibrium 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_tolAbs = 1.0e-2_pReal, & !< absolute tolerance for damage evolution
err_damage_tolRel = 1.0e-6_pReal !< relative tolerance for damage evolution err_damage_tolRel = 1.0e-6_pReal !< relative tolerance for damage evolution
integer(pInt), protected, public :: & integer, protected, public :: &
itmax = 250_pInt, & !< maximum number of iterations itmax = 250, & !< maximum number of iterations
itmin = 1_pInt, & !< minimum number of iterations itmin = 1, & !< minimum number of iterations
stagItMax = 10_pInt, & !< max number of field level staggered iterations stagItMax = 10, & !< max number of field level staggered iterations
maxCutBack = 3_pInt !< max number of cut backs maxCutBack = 3 !< max number of cut backs
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! spectral parameters: ! spectral parameters:
@ -83,9 +90,9 @@ module numerics
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! FEM parameters: ! FEM parameters:
#ifdef FEM #ifdef FEM
integer(pInt), protected, public :: & integer, protected, public :: &
integrationOrder = 2_pInt, & !< order of quadrature rule required integrationOrder = 2, & !< order of quadrature rule required
structOrder = 2_pInt !< order of displacement shape functions structOrder = 2 !< order of displacement shape functions
logical, protected, public :: & logical, protected, public :: &
BBarStabilisation = .false. BBarStabilisation = .false.
character(len=4096), protected, public :: & character(len=4096), protected, public :: &
@ -113,24 +120,9 @@ contains
! a sanity check ! a sanity check
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine numerics_init 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 :: gotDAMASK_NUM_THREADS = 1
integer :: i,j, ierr ! no pInt integer :: i,j, ierr
integer(pInt), allocatable, dimension(:) :: chunkPos integer, allocatable, dimension(:) :: chunkPos
character(len=pStringLen), dimension(:), allocatable :: fileContent character(len=pStringLen), dimension(:), allocatable :: fileContent
character(len=pStringLen) :: & character(len=pStringLen) :: &
tag ,& 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... !$ 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 !$ 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 !$ DAMASK_NumThreadsInt = 1_4
!$ else !$ else
!$ read(DAMASK_NumThreadsString,'(i6)') DAMASK_NumThreadsInt ! read as integer !$ read(DAMASK_NumThreadsString,'(i6)') DAMASK_NumThreadsInt ! read as integer
@ -170,128 +162,128 @@ subroutine numerics_init
enddo enddo
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line) 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) select case(tag)
case ('defgradtolerance') case ('defgradtolerance')
defgradTolerance = IO_floatValue(line,chunkPos,2_pInt) defgradTolerance = IO_floatValue(line,chunkPos,2)
case ('ijacostiffness') case ('ijacostiffness')
iJacoStiffness = IO_intValue(line,chunkPos,2_pInt) iJacoStiffness = IO_intValue(line,chunkPos,2)
case ('nmpstate') case ('nmpstate')
nMPstate = IO_intValue(line,chunkPos,2_pInt) nMPstate = IO_intValue(line,chunkPos,2)
case ('substepminhomog') case ('substepminhomog')
subStepMinHomog = IO_floatValue(line,chunkPos,2_pInt) subStepMinHomog = IO_floatValue(line,chunkPos,2)
case ('substepsizehomog') case ('substepsizehomog')
subStepSizeHomog = IO_floatValue(line,chunkPos,2_pInt) subStepSizeHomog = IO_floatValue(line,chunkPos,2)
case ('stepincreasehomog') case ('stepincreasehomog')
stepIncreaseHomog = IO_floatValue(line,chunkPos,2_pInt) stepIncreaseHomog = IO_floatValue(line,chunkPos,2)
case ('integrator') case ('integrator')
numerics_integrator = IO_intValue(line,chunkPos,2_pInt) numerics_integrator = IO_intValue(line,chunkPos,2)
case ('usepingpong') case ('usepingpong')
usepingpong = IO_intValue(line,chunkPos,2_pInt) > 0_pInt usepingpong = IO_intValue(line,chunkPos,2) > 0
case ('unitlength') case ('unitlength')
numerics_unitlength = IO_floatValue(line,chunkPos,2_pInt) numerics_unitlength = IO_floatValue(line,chunkPos,2)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! RGC parameters ! RGC parameters
case ('atol_rgc') case ('atol_rgc')
absTol_RGC = IO_floatValue(line,chunkPos,2_pInt) absTol_RGC = IO_floatValue(line,chunkPos,2)
case ('rtol_rgc') case ('rtol_rgc')
relTol_RGC = IO_floatValue(line,chunkPos,2_pInt) relTol_RGC = IO_floatValue(line,chunkPos,2)
case ('amax_rgc') case ('amax_rgc')
absMax_RGC = IO_floatValue(line,chunkPos,2_pInt) absMax_RGC = IO_floatValue(line,chunkPos,2)
case ('rmax_rgc') case ('rmax_rgc')
relMax_RGC = IO_floatValue(line,chunkPos,2_pInt) relMax_RGC = IO_floatValue(line,chunkPos,2)
case ('perturbpenalty_rgc') case ('perturbpenalty_rgc')
pPert_RGC = IO_floatValue(line,chunkPos,2_pInt) pPert_RGC = IO_floatValue(line,chunkPos,2)
case ('relevantmismatch_rgc') case ('relevantmismatch_rgc')
xSmoo_RGC = IO_floatValue(line,chunkPos,2_pInt) xSmoo_RGC = IO_floatValue(line,chunkPos,2)
case ('viscositypower_rgc') case ('viscositypower_rgc')
viscPower_RGC = IO_floatValue(line,chunkPos,2_pInt) viscPower_RGC = IO_floatValue(line,chunkPos,2)
case ('viscositymodulus_rgc') case ('viscositymodulus_rgc')
viscModus_RGC = IO_floatValue(line,chunkPos,2_pInt) viscModus_RGC = IO_floatValue(line,chunkPos,2)
case ('refrelaxationrate_rgc') case ('refrelaxationrate_rgc')
refRelaxRate_RGC = IO_floatValue(line,chunkPos,2_pInt) refRelaxRate_RGC = IO_floatValue(line,chunkPos,2)
case ('maxrelaxation_rgc') case ('maxrelaxation_rgc')
maxdRelax_RGC = IO_floatValue(line,chunkPos,2_pInt) maxdRelax_RGC = IO_floatValue(line,chunkPos,2)
case ('maxvoldiscrepancy_rgc') case ('maxvoldiscrepancy_rgc')
maxVolDiscr_RGC = IO_floatValue(line,chunkPos,2_pInt) maxVolDiscr_RGC = IO_floatValue(line,chunkPos,2)
case ('voldiscrepancymod_rgc') case ('voldiscrepancymod_rgc')
volDiscrMod_RGC = IO_floatValue(line,chunkPos,2_pInt) volDiscrMod_RGC = IO_floatValue(line,chunkPos,2)
case ('discrepancypower_rgc') case ('discrepancypower_rgc')
volDiscrPow_RGC = IO_floatValue(line,chunkPos,2_pInt) volDiscrPow_RGC = IO_floatValue(line,chunkPos,2)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! random seeding parameter ! random seeding parameter
case ('random_seed','fixed_seed') case ('random_seed','fixed_seed')
randomSeed = IO_intValue(line,chunkPos,2_pInt) randomSeed = IO_intValue(line,chunkPos,2)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! gradient parameter ! gradient parameter
case ('charlength') case ('charlength')
charLength = IO_floatValue(line,chunkPos,2_pInt) charLength = IO_floatValue(line,chunkPos,2)
case ('residualstiffness') case ('residualstiffness')
residualStiffness = IO_floatValue(line,chunkPos,2_pInt) residualStiffness = IO_floatValue(line,chunkPos,2)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! field parameters ! field parameters
case ('err_struct_tolabs') 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') 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') 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') 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') 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') case ('err_damage_tolrel')
err_damage_tolrel = IO_floatValue(line,chunkPos,2_pInt) err_damage_tolrel = IO_floatValue(line,chunkPos,2)
case ('itmax') case ('itmax')
itmax = IO_intValue(line,chunkPos,2_pInt) itmax = IO_intValue(line,chunkPos,2)
case ('itmin') case ('itmin')
itmin = IO_intValue(line,chunkPos,2_pInt) itmin = IO_intValue(line,chunkPos,2)
case ('maxcutback') case ('maxcutback')
maxCutBack = IO_intValue(line,chunkPos,2_pInt) maxCutBack = IO_intValue(line,chunkPos,2)
case ('maxstaggerediter') case ('maxstaggerediter')
stagItMax = IO_intValue(line,chunkPos,2_pInt) stagItMax = IO_intValue(line,chunkPos,2)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! spectral parameters ! spectral parameters
#ifdef Grid #ifdef Grid
case ('err_div_tolabs') 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') 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') 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') case ('err_stress_tolabs')
err_stress_tolabs = IO_floatValue(line,chunkPos,2_pInt) err_stress_tolabs = IO_floatValue(line,chunkPos,2)
case ('continuecalculation') case ('continuecalculation')
continueCalculation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt continueCalculation = IO_intValue(line,chunkPos,2) > 0
case ('petsc_options') case ('petsc_options')
petsc_options = trim(line(chunkPos(4):)) petsc_options = trim(line(chunkPos(4):))
case ('err_curl_tolabs') 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') case ('err_curl_tolrel')
err_curl_tolRel = IO_floatValue(line,chunkPos,2_pInt) err_curl_tolRel = IO_floatValue(line,chunkPos,2)
case ('polaralpha') case ('polaralpha')
polarAlpha = IO_floatValue(line,chunkPos,2_pInt) polarAlpha = IO_floatValue(line,chunkPos,2)
case ('polarbeta') case ('polarbeta')
polarBeta = IO_floatValue(line,chunkPos,2_pInt) polarBeta = IO_floatValue(line,chunkPos,2)
#endif #endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! FEM parameters ! FEM parameters
#ifdef FEM #ifdef FEM
case ('integrationorder') case ('integrationorder')
integrationorder = IO_intValue(line,chunkPos,2_pInt) integrationorder = IO_intValue(line,chunkPos,2)
case ('structorder') case ('structorder')
structorder = IO_intValue(line,chunkPos,2_pInt) structorder = IO_intValue(line,chunkPos,2)
case ('petsc_options') case ('petsc_options')
petsc_options = trim(line(chunkPos(4):)) petsc_options = trim(line(chunkPos(4):))
case ('bbarstabilisation') case ('bbarstabilisation')
BBarStabilisation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt BBarStabilisation = IO_intValue(line,chunkPos,2) > 0
#endif #endif
end select end select
enddo enddo
@ -334,7 +326,7 @@ subroutine numerics_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! Random seeding parameter ! Random seeding parameter
write(6,'(a16,1x,i16,/)') ' random_seed: ',randomSeed write(6,'(a16,1x,i16,/)') ' random_seed: ',randomSeed
if (randomSeed <= 0_pInt) & if (randomSeed <= 0) &
write(6,'(a,/)') ' random seed will be generated!' write(6,'(a,/)') ' random seed will be generated!'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -386,50 +378,50 @@ subroutine numerics_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! sanity checks ! sanity checks
if (defgradTolerance <= 0.0_pReal) call IO_error(301_pInt,ext_msg='defgradTolerance') if (defgradTolerance <= 0.0_pReal) call IO_error(301,ext_msg='defgradTolerance')
if (iJacoStiffness < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoStiffness') if (iJacoStiffness < 1) call IO_error(301,ext_msg='iJacoStiffness')
if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate') if (nMPstate < 1) call IO_error(301,ext_msg='nMPstate')
if (subStepMinHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepMinHomog') if (subStepMinHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinHomog')
if (subStepSizeHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='subStepSizeHomog') if (subStepSizeHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeHomog')
if (stepIncreaseHomog <= 0.0_pReal) call IO_error(301_pInt,ext_msg='stepIncreaseHomog') if (stepIncreaseHomog <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseHomog')
if (numerics_integrator <= 0_pInt .or. numerics_integrator >= 6_pInt) & if (numerics_integrator <= 0 .or. numerics_integrator >= 6) &
call IO_error(301_pInt,ext_msg='integrator') call IO_error(301,ext_msg='integrator')
if (numerics_unitlength <= 0.0_pReal) call IO_error(301_pInt,ext_msg='unitlength') if (numerics_unitlength <= 0.0_pReal) call IO_error(301,ext_msg='unitlength')
if (absTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absTol_RGC') if (absTol_RGC <= 0.0_pReal) call IO_error(301,ext_msg='absTol_RGC')
if (relTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relTol_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_pInt,ext_msg='absMax_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_pInt,ext_msg='relMax_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_pInt,ext_msg='pPert_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_pInt,ext_msg='xSmoo_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_pInt,ext_msg='viscPower_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_pInt,ext_msg='viscModus_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_pInt,ext_msg='refRelaxRate_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_pInt,ext_msg='maxdRelax_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_pInt,ext_msg='maxVolDiscr_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_pInt,ext_msg='volDiscrMod_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_pInt,ext_msg='volDiscrPw_RGC') if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301,ext_msg='volDiscrPw_RGC')
if (residualStiffness < 0.0_pReal) call IO_error(301_pInt,ext_msg='residualStiffness') if (residualStiffness < 0.0_pReal) call IO_error(301,ext_msg='residualStiffness')
if (itmax <= 1_pInt) call IO_error(301_pInt,ext_msg='itmax') if (itmax <= 1) call IO_error(301,ext_msg='itmax')
if (itmin > itmax .or. itmin < 1_pInt) call IO_error(301_pInt,ext_msg='itmin') if (itmin > itmax .or. itmin < 1) call IO_error(301,ext_msg='itmin')
if (maxCutBack < 0_pInt) call IO_error(301_pInt,ext_msg='maxCutBack') if (maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack')
if (stagItMax < 0_pInt) call IO_error(301_pInt,ext_msg='maxStaggeredIter') if (stagItMax < 0) call IO_error(301,ext_msg='maxStaggeredIter')
if (err_struct_tolRel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_struct_tolRel') 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_pInt,ext_msg='err_struct_tolAbs') 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_pInt,ext_msg='err_thermal_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_pInt,ext_msg='err_thermal_tolrel') 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_pInt,ext_msg='err_damage_tolabs') 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_pInt,ext_msg='err_damage_tolrel') if (err_damage_tolrel <= 0.0_pReal) call IO_error(301,ext_msg='err_damage_tolrel')
#ifdef Grid #ifdef Grid
if (err_stress_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_stress_tolRel') 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_pInt,ext_msg='err_stress_tolAbs') 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_pInt,ext_msg='err_div_tolRel') 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_pInt,ext_msg='err_div_tolAbs') 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_pInt,ext_msg='err_curl_tolRel') 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_pInt,ext_msg='err_curl_tolAbs') if (err_curl_tolAbs <= 0.0_pReal) call IO_error(301,ext_msg='err_curl_tolAbs')
if (polarAlpha <= 0.0_pReal .or. & 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. & 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 #endif
end subroutine numerics_init end subroutine numerics_init

44
src/plastic_disloUCLA.f90
View File

@ -6,11 +6,18 @@
!> @brief crystal plasticity model for bcc metals, especially Tungsten !> @brief crystal plasticity model for bcc metals, especially Tungsten
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module plastic_disloUCLA module plastic_disloUCLA
use prec, only: & use prec
pReal use debug
use math
use IO
use material
use config
use lattice
use results
implicit none implicit none
private private
integer, dimension(:,:), allocatable, target, public :: & integer, dimension(:,:), allocatable, target, public :: &
plastic_disloUCLA_sizePostResult !< size of each post result output plastic_disloUCLA_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: & character(len=64), dimension(:,:), allocatable, target, public :: &
@ -111,20 +118,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks !> @details reads in material parameters, allocates arrays, and does sanity checks
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine plastic_disloUCLA_init() 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 :: & integer :: &
Ninstance, & Ninstance, &
@ -394,12 +387,6 @@ end subroutine plastic_disloUCLA_LpAndItsTangent
!> @brief calculates the rate of change of microstructure !> @brief calculates the rate of change of microstructure
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine plastic_disloUCLA_dotState(Mp,T,instance,of) 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) :: & real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress Mp !< Mandel stress
@ -489,11 +476,6 @@ end subroutine plastic_disloUCLA_dependentState
!> @brief return array of constitutive results !> @brief return array of constitutive results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function plastic_disloUCLA_postResults(Mp,T,instance,of) result(postResults) 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) :: & real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress Mp !< Mandel stress
@ -548,8 +530,6 @@ end function plastic_disloUCLA_postResults
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine plastic_disloUCLA_results(instance,group) subroutine plastic_disloUCLA_results(instance,group)
#if defined(PETSc) || defined(DAMASK_HDF5) #if defined(PETSc) || defined(DAMASK_HDF5)
use results, only: &
results_writeDataset
integer, intent(in) :: instance integer, intent(in) :: instance
character(len=*), intent(in) :: group character(len=*), intent(in) :: group
@ -595,12 +575,6 @@ end subroutine plastic_disloUCLA_results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure subroutine kinetics(Mp,T,instance,of, & 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) 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) :: & real(pReal), dimension(3,3), intent(in) :: &
Mp !< Mandel stress Mp !< Mandel stress

260
src/plastic_nonlocal.f90
View File

@ -7,12 +7,22 @@
module plastic_nonlocal module plastic_nonlocal
use prec use prec
use future 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: & use geometry_plastic_nonlocal, only: &
periodicSurface => geometry_plastic_nonlocal_periodicSurface, & nIPneighbors => geometry_plastic_nonlocal_nIPneighbors, &
IPneighborhood => geometry_plastic_nonlocal_IPneighborhood, & IPneighborhood => geometry_plastic_nonlocal_IPneighborhood, &
IPvolume => geometry_plastic_nonlocal_IPvolume, & IPvolume => geometry_plastic_nonlocal_IPvolume0, &
IParea => geometry_plastic_nonlocal_IParea, & IParea => geometry_plastic_nonlocal_IParea0, &
IPareaNormal => geometry_plastic_nonlocal_IPareaNormal IPareaNormal => geometry_plastic_nonlocal_IPareaNormal0
implicit none implicit none
private private
@ -241,21 +251,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks !> @details reads in material parameters, allocates arrays, and does sanity checks
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_init 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)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
integer, dimension(0), parameter :: emptyIntArray = [integer::] integer, dimension(0), parameter :: emptyIntArray = [integer::]
@ -291,7 +286,6 @@ subroutine plastic_nonlocal_init
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances write(6,'(a16,1x,i5,/)') '# instances:',maxNinstances
allocate(param(maxNinstances)) allocate(param(maxNinstances))
allocate(state(maxNinstances)) allocate(state(maxNinstances))
allocate(dotState(maxNinstances)) allocate(dotState(maxNinstances))
@ -672,8 +666,8 @@ subroutine plastic_nonlocal_init
enddo enddo
allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & allocate(compatibility(2,maxval(totalNslip),maxval(totalNslip),nIPneighbors,&
source=0.0_pReal) discretization_nIP,discretization_nElem), source=0.0_pReal)
! BEGIN DEPRECATED---------------------------------------------------------------------------------- ! BEGIN DEPRECATED----------------------------------------------------------------------------------
allocate(iRhoU(maxval(totalNslip),4,maxNinstances), source=0) allocate(iRhoU(maxval(totalNslip),4,maxNinstances), source=0)
@ -738,15 +732,6 @@ subroutine plastic_nonlocal_init
!> @brief populates the initial dislocation density !> @brief populates the initial dislocation density
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine stateInit(phase,NofMyPhase) 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) ::& integer,intent(in) ::&
phase, & phase, &
@ -779,9 +764,9 @@ subroutine plastic_nonlocal_init
if (prm%rhoSglRandom > 0.0_pReal) then if (prm%rhoSglRandom > 0.0_pReal) then
! get the total volume of the instance ! get the total volume of the instance
do e = 1,theMesh%nElems do e = 1,discretization_nElem
do i = 1,theMesh%elem%nIPs do i = 1,discretization_nIP
if (material_phase(1,i,e) == phase) volume(phasememberAt(1,i,e)) = mesh_ipVolume(i,e) if (material_phase(1,i,e) == phase) volume(phasememberAt(1,i,e)) = IPvolume(i,e)
enddo enddo
enddo enddo
totalVolume = sum(volume) totalVolume = sum(volume)
@ -828,39 +813,6 @@ end subroutine plastic_nonlocal_init
!> @brief calculates quantities characterizing the microstructure !> @brief calculates quantities characterizing the microstructure
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el) 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) :: & integer, intent(in) :: &
ip, & ip, &
@ -900,7 +852,7 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
invFp, & !< inverse of plastic deformation gradient invFp, & !< inverse of plastic deformation gradient
connections, & connections, &
invConnections invConnections
real(pReal), dimension(3,theMesh%elem%nIPneighbors) :: & real(pReal), dimension(3,nIPneighbors) :: &
connection_latticeConf connection_latticeConf
real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: &
rhoExcess rhoExcess
@ -914,10 +866,10 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el)
totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: &
myInteractionMatrix ! corrected slip interaction matrix 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_edg_delta_neighbor, &
rho_scr_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_rhoExcess, & ! excess density at neighboring material point
neighbor_rhoTotal ! total 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) :: & 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(1,1:ns) = rho_edg_delta
rhoExcess(2,1:ns) = rho_scr_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 !* loop through my neighborhood and get the connection vectors (in lattice frame) and the excess densities
nRealNeighbors = 0.0_pReal nRealNeighbors = 0.0_pReal
neighbor_rhoTotal = 0.0_pReal neighbor_rhoTotal = 0.0_pReal
do n = 1,theMesh%elem%nIPneighbors do n = 1,nIPneighbors
neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_el = IPneighborhood(1,n,ip,el)
neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) neighbor_ip = IPneighborhood(2,n,ip,el)
no = phasememberAt(1,neighbor_ip,neighbor_el) no = phasememberAt(1,neighbor_ip,neighbor_el)
if (neighbor_el > 0 .and. neighbor_ip > 0) then if (neighbor_el > 0 .and. neighbor_ip > 0) then
neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) 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) = & connection_latticeConf(1:3,n) = &
matmul(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) & matmul(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) &
- mesh_ipCoordinates(1:3,ip,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 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 else
! local neighbor or different lattice structure or different constitution instance -> use central values instead ! local neighbor or different lattice structure or different constitution instance -> use central values instead
connection_latticeConf(1:3,n) = 0.0_pReal connection_latticeConf(1:3,n) = 0.0_pReal
@ -1224,13 +1176,6 @@ end subroutine plastic_nonlocal_kinetics
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, & subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, &
Mp, Temperature, volume, ip, el) Mp, Temperature, volume, ip, el)
use math, only: &
math_mul33xx33
use material, only: &
material_phase, &
plasticState, &
phaseAt, phasememberAt, &
phase_plasticityInstance
integer, intent(in) :: & integer, intent(in) :: &
ip, & !< current integration point ip, & !< current integration point
@ -1363,26 +1308,6 @@ end subroutine plastic_nonlocal_LpAndItsTangent
!> @brief (instantaneous) incremental change of microstructure !> @brief (instantaneous) incremental change of microstructure
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_deltaState(Mp,ip,el) 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) :: & integer, intent(in) :: &
ip, & ip, &
@ -1500,49 +1425,6 @@ end subroutine plastic_nonlocal_deltaState
!--------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
timestep,ip,el) 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) :: & integer, intent(in) :: &
ip, & !< current integration point ip, & !< current integration point
@ -1552,7 +1434,7 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
timestep !< substepped crystallite time increment timestep !< substepped crystallite time increment
real(pReal), dimension(3,3), intent(in) ::& real(pReal), dimension(3,3), intent(in) ::&
Mp !< MandelStress 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 Fe, & !< elastic deformation gradient
Fp !< plastic 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 !*** check CFL (Courant-Friedrichs-Lewy) condition for flux
if (any( abs(gdot) > 0.0_pReal & ! any active slip system ... if (any( abs(gdot) > 0.0_pReal & ! any active slip system ...
.and. prm%CFLfactor * abs(v) * timestep & .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 #ifdef DEBUG
if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0) then 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,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip
write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', & write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', &
maxval(abs(v), abs(gdot) > 0.0_pReal & maxval(abs(v), abs(gdot) > 0.0_pReal &
.and. prm%CFLfactor * abs(v) * timestep & .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 ' at a timestep of ',timestep
write(6,'(a)') '<< CONST >> enforcing cutback !!!' write(6,'(a)') '<< CONST >> enforcing cutback !!!'
endif endif
@ -1743,18 +1625,18 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
my_Fe = Fe(1:3,1:3,1,ip,el) my_Fe = Fe(1:3,1:3,1,ip,el)
my_F = matmul(my_Fe, Fp(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_el = IPneighborhood(1,n,ip,el)
neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) neighbor_ip = IPneighborhood(2,n,ip,el)
neighbor_n = mesh_ipNeighborhood(3,n,ip,el) neighbor_n = IPneighborhood(3,n,ip,el)
np = phaseAt(1,neighbor_ip,neighbor_el) np = phaseAt(1,neighbor_ip,neighbor_el)
no = phasememberAt(1,neighbor_ip,neighbor_el) no = phasememberAt(1,neighbor_ip,neighbor_el)
opposite_neighbor = n + mod(n,2) - mod(n+1,2) opposite_neighbor = n + mod(n,2) - mod(n+1,2)
opposite_el = mesh_ipNeighborhood(1,opposite_neighbor,ip,el) opposite_el = IPneighborhood(1,opposite_neighbor,ip,el)
opposite_ip = mesh_ipNeighborhood(2,opposite_neighbor,ip,el) opposite_ip = IPneighborhood(2,opposite_neighbor,ip,el)
opposite_n = mesh_ipNeighborhood(3,opposite_neighbor,ip,el) opposite_n = IPneighborhood(3,opposite_neighbor,ip,el)
if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient
neighbor_instance = phase_plasticityInstance(material_phase(1,neighbor_ip,neighbor_el)) 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) 0.0_pReal)
endforall 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) & .or. neighbor_rhoSgl < prm%significantRho) &
neighbor_rhoSgl = 0.0_pReal neighbor_rhoSgl = 0.0_pReal
normal_neighbor2me_defConf = math_det33(Favg) * matmul(math_inv33(transpose(Favg)), & 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) & normal_neighbor2me = matmul(transpose(neighbor_Fe), normal_neighbor2me_defConf) &
/ math_det33(neighbor_Fe) ! interface normal in the lattice configuration of my neighbor / 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 normal_neighbor2me = normal_neighbor2me / norm2(normal_neighbor2me) ! normalize the surface normal to unit length
do s = 1,ns do s = 1,ns
do t = 1,4 do t = 1,4
c = (t + 1) / 2 c = (t + 1) / 2
topp = t + mod(t,2) - mod(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 .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) & 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... where (compatibility(c,1:ns,s,n,ip,el) > 0.0_pReal) & ! positive compatibility...
rhoDotFlux(1:ns,t) = rhoDotFlux(1:ns,t) & 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 * 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... where (compatibility(c,1:ns,s,n,ip,el) < 0.0_pReal) & ! ..negative compatibility...
rhoDotFlux(1:ns,topp) = rhoDotFlux(1:ns,topp) & 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 * compatibility(c,1:ns,s,n,ip,el) ** 2.0_pReal
endif endif
enddo enddo
@ -1842,15 +1724,15 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
normal_me2neighbor_defConf = math_det33(Favg) & normal_me2neighbor_defConf = math_det33(Favg) &
* matmul(math_inv33(transpose(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) & normal_me2neighbor = matmul(transpose(my_Fe), normal_me2neighbor_defConf) &
/ math_det33(my_Fe) ! interface normal in my lattice configuration / 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 normal_me2neighbor = normal_me2neighbor / norm2(normal_me2neighbor) ! normalize the surface normal to unit length
do s = 1,ns do s = 1,ns
do t = 1,4 do t = 1,4
c = (t + 1) / 2 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 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 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 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 endif
lineLength = my_rhoSgl(s,t) * my_v(s,t) & 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 * 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) & 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 * 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 endif
enddo enddo
@ -1938,12 +1820,12 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, &
+ rhoDotAthermalAnnihilation & + rhoDotAthermalAnnihilation &
+ rhoDotThermalAnnihilation + rhoDotThermalAnnihilation
results(instance)%rhoDotFlux(1:ns,1:8,o) = rhoDotFlux(1:ns,1:8) 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)%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)%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)%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)%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)%rhoDotEdgeJogs(1:ns,o) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1)
#ifdef DEBUG #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. ! that sum up to a total of 1 are considered, all others are set to zero.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) 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) :: & integer, intent(in) :: &
i, & i, &
e 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 orientation ! crystal orientation in quaternions
integer :: & integer :: &
@ -2040,7 +1907,7 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor
real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),&
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 my_compatibility ! my_compatibility for current element and ip
real(pReal) :: & real(pReal) :: &
my_compatibilitySum, & my_compatibilitySum, &
@ -2050,7 +1917,7 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e)
belowThreshold belowThreshold
type(rotation) :: rot type(rotation) :: rot
Nneighbors = theMesh%elem%nIPneighbors Nneighbors = nIPneighbors
ph = material_phase(1,i,e) ph = material_phase(1,i,e)
textureID = material_texture(1,i,e) textureID = material_texture(1,i,e)
instance = phase_plasticityInstance(ph) 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. !*** Loop thrugh neighbors and check whether there is any compatibility.
neighbors: do n = 1,Nneighbors neighbors: do n = 1,Nneighbors
neighbor_e = mesh_ipNeighborhood(1,n,i,e) neighbor_e = IPneighborhood(1,n,i,e)
neighbor_i = mesh_ipNeighborhood(2,n,i,e) neighbor_i = IPneighborhood(2,n,i,e)
!* FREE SURFACE !* FREE SURFACE
@ -2159,10 +2026,6 @@ end subroutine plastic_nonlocal_updateCompatibility
!> @brief return array of constitutive results !> @brief return array of constitutive results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function plastic_nonlocal_postResults(ph,instance,of) result(postResults) function plastic_nonlocal_postResults(ph,instance,of) result(postResults)
use prec, only: &
dNeq0
use material, only: &
plasticState
integer, intent(in) :: & integer, intent(in) :: &
ph, & ph, &
@ -2364,7 +2227,6 @@ end function plastic_nonlocal_postResults
!> @details raw values is rectified !> @details raw values is rectified
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function getRho(instance,of,ip,el) function getRho(instance,of,ip,el)
use mesh
integer, intent(in) :: instance, of,ip,el integer, intent(in) :: instance, of,ip,el
real(pReal), dimension(param(instance)%totalNslip,10) :: getRho 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(:,mob) = max(getRho(:,mob),0.0_pReal)
getRho(:,dip) = max(getRho(:,dip),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 getRho = 0.0_pReal
end associate end associate

6
src/results.f90
View File

@ -15,6 +15,8 @@ module results
implicit none implicit none
private private
#if defined(PETSc) || defined(DAMASK_HDF5)
integer(HID_T), public, protected :: tempCoordinates, tempResults integer(HID_T), public, protected :: tempCoordinates, tempResults
integer(HID_T), private :: resultsFile, currentIncID, plist_id integer(HID_T), private :: resultsFile, currentIncID, plist_id
@ -105,7 +107,7 @@ end subroutine results_closeJobFile
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine results_addIncrement(inc,time) subroutine results_addIncrement(inc,time)
integer(pInt), intent(in) :: inc integer, intent(in) :: inc
real(pReal), intent(in) :: time real(pReal), intent(in) :: time
character(len=pStringLen) :: incChar character(len=pStringLen) :: incChar
@ -951,5 +953,5 @@ end subroutine results_mapping_materialpoint
!end subroutine HDF5_mappingCells !end subroutine HDF5_mappingCells
#endif
end module results end module results

10
src/rotations.f90
View File

@ -65,6 +65,7 @@ module rotations
procedure, public :: asRotationMatrix procedure, public :: asRotationMatrix
!------------------------------------------ !------------------------------------------
procedure, public :: fromRotationMatrix procedure, public :: fromRotationMatrix
procedure, public :: fromEulerAngles
!------------------------------------------ !------------------------------------------
procedure, public :: rotVector procedure, public :: rotVector
procedure, public :: rotTensor procedure, public :: rotTensor
@ -143,7 +144,16 @@ subroutine fromRotationMatrix(self,om)
self%q = om2qu(om) self%q = om2qu(om)
end subroutine 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 !> @author Marc De Graef, Carnegie Mellon University

37
src/source_damage_anisoDuctile.f90
View File

@ -6,9 +6,15 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module source_damage_anisoDuctile module source_damage_anisoDuctile
use prec use prec
use debug
use IO
use math
use material
use config
implicit none implicit none
private private
integer, dimension(:), allocatable, public, protected :: & integer, dimension(:), allocatable, public, protected :: &
source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism? source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism?
source_damage_anisoDuctile_instance !< instance of damage source 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 !> @details reads in material parameters, allocates arrays, and does sanity checks
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoDuctile_init 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 :: Ninstance,phase,instance,source,sourceOffset
integer :: NofMyPhase,p ,i integer :: NofMyPhase,p ,i
@ -181,13 +167,6 @@ end subroutine source_damage_anisoDuctile_init
!> @brief calculates derived quantities from state !> @brief calculates derived quantities from state
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) subroutine source_damage_anisoDuctile_dotState(ipc, ip, el)
use material, only: &
phaseAt, phasememberAt, &
plasticState, &
sourceState, &
material_homogenizationAt, &
damage, &
damageMapping
integer, intent(in) :: & integer, intent(in) :: &
ipc, & !< component-ID of integration point 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 !> @brief returns local part of nonlocal damage driving force
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: & integer, intent(in) :: &
phase, & phase, &
@ -249,8 +226,6 @@ end subroutine source_damage_anisoDuctile_getRateAndItsTangent
!> @brief return array of local damage results !> @brief return array of local damage results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function source_damage_anisoDuctile_postResults(phase, constituent) function source_damage_anisoDuctile_postResults(phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: & integer, intent(in) :: &
phase, & phase, &

377
src/source_damage_isoBrittle.f90
View File

@ -5,43 +5,47 @@
!> @details to be done !> @details to be done
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module source_damage_isoBrittle module source_damage_isoBrittle
use prec use prec
use debug
use IO
use math
use material
use config
implicit none implicit none
private private
integer, dimension(:), allocatable, public, protected :: & integer, dimension(:), allocatable, public, protected :: &
source_damage_isoBrittle_offset, & !< which source is my current damage mechanism? source_damage_isoBrittle_offset, &
source_damage_isoBrittle_instance !< instance of damage source mechanism 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 :: & enum, bind(c)
source_damage_isoBrittle_sizePostResult !< size of each post result output enumerator :: &
undefined_ID, &
character(len=64), dimension(:,:), allocatable, target, public :: & damage_drivingforce_ID
source_damage_isoBrittle_output !< name of each post result output end enum
enum, bind(c)
enumerator :: undefined_ID, &
damage_drivingforce_ID
end enum !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 ToDo
type, private :: tParameters !< container type for internal constitutive parameters type, private :: tParameters !< container type for internal constitutive parameters
real(pReal) :: & real(pReal) :: &
critStrainEnergy, & critStrainEnergy, &
N, & N, &
aTol aTol
integer(kind(undefined_ID)), allocatable, dimension(:) :: & integer(kind(undefined_ID)), allocatable, dimension(:) :: &
outputID outputID
end type tParameters 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 :: & public :: &
source_damage_isoBrittle_init, & source_damage_isoBrittle_init, &
source_damage_isoBrittle_deltaState, & source_damage_isoBrittle_deltaState, &
source_damage_isoBrittle_getRateAndItsTangent, & source_damage_isoBrittle_getRateAndItsTangent, &
source_damage_isoBrittle_postResults source_damage_isoBrittle_postResults
contains contains
@ -51,112 +55,93 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks !> @details reads in material parameters, allocates arrays, and does sanity checks
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine source_damage_isoBrittle_init 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 :: Ninstance,phase,instance,source,sourceOffset integer :: NofMyPhase,p,i
integer :: NofMyPhase,p,i character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: &
integer(kind(undefined_ID)) :: & outputID
outputID
character(len=pStringLen) :: &
extmsg = ''
character(len=65536), dimension(:), allocatable :: &
outputs
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>' character(len=pStringLen) :: &
extmsg = ''
Ninstance = count(phase_source == SOURCE_damage_isoBrittle_ID) character(len=65536), dimension(:), allocatable :: &
if (Ninstance == 0) return outputs
write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>'
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & Ninstance = count(phase_source == SOURCE_damage_isoBrittle_ID)
write(6,'(a16,1x,i5,/)') '# instances:',Ninstance 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(param(Ninstance))
allocate(source_damage_isoBrittle_instance(material_Nphase), source=0)
do phase = 1, material_Nphase do p=1, size(config_phase)
source_damage_isoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoBrittle_ID) if (all(phase_source(:,p) /= SOURCE_DAMAGE_ISOBRITTLE_ID)) cycle
do source = 1, phase_Nsources(phase) associate(prm => param(source_damage_isoBrittle_instance(p)), &
if (phase_source(source,phase) == source_damage_isoBrittle_ID) & config => config_phase(p))
source_damage_isoBrittle_offset(phase) = source
enddo prm%aTol = config%getFloat('isobrittle_atol',defaultVal = 1.0e-3_pReal)
enddo
prm%N = config%getFloat('isobrittle_n')
allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0) prm%critStrainEnergy = config%getFloat('isobrittle_criticalstrainenergy')
allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance))
source_damage_isoBrittle_output = '' ! sanity checks
if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_atol'
allocate(param(Ninstance))
if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_n'
do p=1, size(config_phase) if (prm%critStrainEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_criticalstrainenergy'
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 ! exit if any parameter is out of range
if (extmsg /= '') & if (extmsg /= '') &
call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')') call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')')
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! output pararameters ! output pararameters
outputs = config%getStrings('(output)',defaultVal=emptyStringArray) outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
allocate(prm%outputID(0)) allocate(prm%outputID(0))
do i=1, size(outputs) do i=1, size(outputs)
outputID = undefined_ID outputID = undefined_ID
select case(outputs(i)) select case(outputs(i))
case ('isobrittle_drivingforce') case ('isobrittle_drivingforce')
source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1 source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1
source_damage_isoBrittle_output(i,source_damage_isoBrittle_instance(p)) = outputs(i) source_damage_isoBrittle_output(i,source_damage_isoBrittle_instance(p)) = outputs(i)
prm%outputID = [prm%outputID, damage_drivingforce_ID] prm%outputID = [prm%outputID, damage_drivingforce_ID]
end select 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) enddo
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
end subroutine source_damage_isoBrittle_init end subroutine source_damage_isoBrittle_init
@ -164,47 +149,41 @@ end subroutine source_damage_isoBrittle_init
!> @brief calculates derived quantities from state !> @brief calculates derived quantities from state
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) 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) :: & integer, intent(in) :: &
ipc, & !< component-ID of integration point ipc, & !< component-ID of integration point
ip, & !< integration point ip, & !< integration point
el !< element el !< element
real(pReal), intent(in), dimension(3,3) :: & real(pReal), intent(in), dimension(3,3) :: &
Fe Fe
real(pReal), intent(in), dimension(6,6) :: & real(pReal), intent(in), dimension(6,6) :: &
C C
integer :: & integer :: &
phase, constituent, instance, sourceOffset phase, constituent, instance, sourceOffset
real(pReal) :: & real(pReal) :: &
strain(6), & strain(6), &
strainenergy strainenergy
phase = phaseAt(ipc,ip,el) !< phase ID at ipc,ip,el 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 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! ! 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 instance = source_damage_isoBrittle_instance(phase) !< instance of damage_isoBrittle source
sourceOffset = source_damage_isoBrittle_offset(phase) 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 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 ! 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 if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then
sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent) strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent)
else else
sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
sourceState(phase)%p(sourceOffset)%subState0(1,constituent) - & sourceState(phase)%p(sourceOffset)%subState0(1,constituent) - &
sourceState(phase)%p(sourceOffset)%state(1,constituent) sourceState(phase)%p(sourceOffset)%state(1,constituent)
endif endif
end subroutine source_damage_isoBrittle_deltaState 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 !> @brief returns local part of nonlocal damage driving force
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: & integer, intent(in) :: &
phase, & phase, &
constituent constituent
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
phi phi
real(pReal), intent(out) :: & real(pReal), intent(out) :: &
localphiDot, & localphiDot, &
dLocalphiDot_dPhi dLocalphiDot_dPhi
integer :: & integer :: &
instance, sourceOffset instance, sourceOffset
instance = source_damage_isoBrittle_instance(phase) instance = source_damage_isoBrittle_instance(phase)
sourceOffset = source_damage_isoBrittle_offset(phase) sourceOffset = source_damage_isoBrittle_offset(phase)
localphiDot = (1.0_pReal - phi)**(param(instance)%N - 1.0_pReal) - & localphiDot = (1.0_pReal - phi)**(param(instance)%N - 1.0_pReal) - &
phi*sourceState(phase)%p(sourceOffset)%state(1,constituent) phi*sourceState(phase)%p(sourceOffset)%state(1,constituent)
dLocalphiDot_dPhi = - (param(instance)%N - 1.0_pReal)* & dLocalphiDot_dPhi = - (param(instance)%N - 1.0_pReal)* &
(1.0_pReal - phi)**max(0.0_pReal,param(instance)%N - 2.0_pReal) & (1.0_pReal - phi)**max(0.0_pReal,param(instance)%N - 2.0_pReal) &
- sourceState(phase)%p(sourceOffset)%state(1,constituent) - sourceState(phase)%p(sourceOffset)%state(1,constituent)
end subroutine source_damage_isoBrittle_getRateAndItsTangent end subroutine source_damage_isoBrittle_getRateAndItsTangent
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief return array of local damage results !> @brief return array of local damage results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function source_damage_isoBrittle_postResults(phase, constituent) function source_damage_isoBrittle_postResults(phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: & integer, intent(in) :: &
phase, & phase, &
constituent constituent
real(pReal), dimension(sum(source_damage_isoBrittle_sizePostResult(:, & real(pReal), dimension(sum(source_damage_isoBrittle_sizePostResult(:, &
source_damage_isoBrittle_instance(phase)))) :: & source_damage_isoBrittle_instance(phase)))) :: &
source_damage_isoBrittle_postResults source_damage_isoBrittle_postResults
integer :: & integer :: &
instance, sourceOffset, o, c instance, sourceOffset, o, c
instance = source_damage_isoBrittle_instance(phase) instance = source_damage_isoBrittle_instance(phase)
sourceOffset = source_damage_isoBrittle_offset(phase) sourceOffset = source_damage_isoBrittle_offset(phase)
c = 0 c = 0
do o = 1,size(param(instance)%outputID) do o = 1,size(param(instance)%outputID)
select case(param(instance)%outputID(o)) select case(param(instance)%outputID(o))
case (damage_drivingforce_ID) case (damage_drivingforce_ID)
source_damage_isoBrittle_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent) source_damage_isoBrittle_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
c = c + 1 c = c + 1
end select end select
enddo enddo
end function source_damage_isoBrittle_postResults end function source_damage_isoBrittle_postResults
end module source_damage_isoBrittle end module source_damage_isoBrittle

34
src/source_damage_isoDuctile.f90
View File

@ -6,6 +6,10 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module source_damage_isoDuctile module source_damage_isoDuctile
use prec use prec
use debug
use IO
use material
use config
implicit none implicit none
private private
@ -51,25 +55,6 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks !> @details reads in material parameters, allocates arrays, and does sanity checks
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine source_damage_isoDuctile_init 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 :: Ninstance,phase,instance,source,sourceOffset
integer :: NofMyPhase,p,i integer :: NofMyPhase,p,i
@ -164,13 +149,6 @@ end subroutine source_damage_isoDuctile_init
!> @brief calculates derived quantities from state !> @brief calculates derived quantities from state
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine source_damage_isoDuctile_dotState(ipc, ip, el) subroutine source_damage_isoDuctile_dotState(ipc, ip, el)
use material, only: &
phaseAt, phasememberAt, &
plasticState, &
sourceState, &
material_homogenizationAt, &
damage, &
damageMapping
integer, intent(in) :: & integer, intent(in) :: &
ipc, & !< component-ID of integration point 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 !> @brief returns local part of nonlocal damage driving force
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: & integer, intent(in) :: &
phase, & phase, &
@ -224,8 +200,6 @@ end subroutine source_damage_isoDuctile_getRateAndItsTangent
!> @brief return array of local damage results !> @brief return array of local damage results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function source_damage_isoDuctile_postResults(phase, constituent) function source_damage_isoDuctile_postResults(phase, constituent)
use material, only: &
sourceState
integer, intent(in) :: & integer, intent(in) :: &
phase, & phase, &

9
src/thermal_adiabatic.f90
View File

@ -11,7 +11,6 @@ module thermal_adiabatic
use source_thermal_externalheat use source_thermal_externalheat
use crystallite use crystallite
use lattice use lattice
use mesh
implicit none implicit none
private private
@ -214,13 +213,13 @@ function thermal_adiabatic_getSpecificHeat(ip,el)
thermal_adiabatic_getSpecificHeat = 0.0_pReal 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 + & thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat + &
lattice_specificHeat(material_phase(grain,ip,el)) lattice_specificHeat(material_phase(grain,ip,el))
enddo enddo
thermal_adiabatic_getSpecificHeat = & 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 end function thermal_adiabatic_getSpecificHeat
@ -241,13 +240,13 @@ function thermal_adiabatic_getMassDensity(ip,el)
thermal_adiabatic_getMassDensity = 0.0_pReal 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 + & thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity + &
lattice_massDensity(material_phase(grain,ip,el)) lattice_massDensity(material_phase(grain,ip,el))
enddo enddo
thermal_adiabatic_getMassDensity = & 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 end function thermal_adiabatic_getMassDensity

93
src/thermal_conduction.f90
View File

@ -3,8 +3,13 @@
!> @brief material subroutine for temperature evolution from heat conduction !> @brief material subroutine for temperature evolution from heat conduction
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module thermal_conduction module thermal_conduction
use prec, only: & use prec
pReal use material
use config
use lattice
use crystallite
use source_thermal_dissipation
use source_thermal_externalheat
implicit none implicit none
private private
@ -42,22 +47,8 @@ contains
!> @details reads in material parameters, allocates arrays, and does sanity checks !> @details reads in material parameters, allocates arrays, and does sanity checks
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine thermal_conduction_init 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 :: maxNinstance,section,instance,i
integer :: sizeState integer :: sizeState
integer :: NofMyHomog integer :: NofMyHomog
@ -115,24 +106,6 @@ end subroutine thermal_conduction_init
!> @brief returns heat generation rate !> @brief returns heat generation rate
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) 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) :: & integer, intent(in) :: &
ip, & !< integration point number ip, & !< integration point number
@ -193,16 +166,7 @@ end subroutine thermal_conduction_getSourceAndItsTangent
!> @brief returns homogenized thermal conductivity in reference configuration !> @brief returns homogenized thermal conductivity in reference configuration
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function thermal_conduction_getConductivity33(ip,el) 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) :: & integer, intent(in) :: &
ip, & !< integration point number ip, & !< integration point number
el !< element number el !< element number
@ -213,13 +177,13 @@ function thermal_conduction_getConductivity33(ip,el)
thermal_conduction_getConductivity33 = 0.0_pReal 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 + & thermal_conduction_getConductivity33 = thermal_conduction_getConductivity33 + &
crystallite_push33ToRef(grain,ip,el,lattice_thermalConductivity33(:,:,material_phase(grain,ip,el))) crystallite_push33ToRef(grain,ip,el,lattice_thermalConductivity33(:,:,material_phase(grain,ip,el)))
enddo enddo
thermal_conduction_getConductivity33 = & 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 end function thermal_conduction_getConductivity33
@ -228,14 +192,7 @@ end function thermal_conduction_getConductivity33
!> @brief returns homogenized specific heat capacity !> @brief returns homogenized specific heat capacity
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function thermal_conduction_getSpecificHeat(ip,el) 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) :: & integer, intent(in) :: &
ip, & !< integration point number ip, & !< integration point number
el !< element number el !< element number
@ -247,13 +204,13 @@ function thermal_conduction_getSpecificHeat(ip,el)
thermal_conduction_getSpecificHeat = 0.0_pReal 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 + & thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat + &
lattice_specificHeat(material_phase(grain,ip,el)) lattice_specificHeat(material_phase(grain,ip,el))
enddo enddo
thermal_conduction_getSpecificHeat = & 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 end function thermal_conduction_getSpecificHeat
@ -261,14 +218,7 @@ end function thermal_conduction_getSpecificHeat
!> @brief returns homogenized mass density !> @brief returns homogenized mass density
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function thermal_conduction_getMassDensity(ip,el) 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) :: & integer, intent(in) :: &
ip, & !< integration point number ip, & !< integration point number
el !< element number el !< element number
@ -280,13 +230,13 @@ function thermal_conduction_getMassDensity(ip,el)
thermal_conduction_getMassDensity = 0.0_pReal 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 & thermal_conduction_getMassDensity = thermal_conduction_getMassDensity &
+ lattice_massDensity(material_phase(grain,ip,el)) + lattice_massDensity(material_phase(grain,ip,el))
enddo enddo
thermal_conduction_getMassDensity = & 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 end function thermal_conduction_getMassDensity
@ -295,11 +245,6 @@ end function thermal_conduction_getMassDensity
!> @brief updates thermal state with solution from heat conduction PDE !> @brief updates thermal state with solution from heat conduction PDE
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el) subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el)
use material, only: &
material_homogenizationAt, &
temperature, &
temperatureRate, &
thermalMapping
integer, intent(in) :: & integer, intent(in) :: &
ip, & !< integration point number ip, & !< integration point number
@ -323,8 +268,6 @@ end subroutine thermal_conduction_putTemperatureAndItsRate
!> @brief return array of thermal results !> @brief return array of thermal results
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function thermal_conduction_postResults(homog,instance,of) result(postResults) function thermal_conduction_postResults(homog,instance,of) result(postResults)
use material, only: &
temperature
integer, intent(in) :: & integer, intent(in) :: &
homog, & homog, &

59
src/thermal_isothermal.f90
View File

@ -3,48 +3,45 @@
!> @brief material subroutine for isothermal temperature field !> @brief material subroutine for isothermal temperature field
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module thermal_isothermal module thermal_isothermal
use prec
use config
use material
implicit none implicit none
private private
public :: & public :: &
thermal_isothermal_init thermal_isothermal_init
contains contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, reads information from material configuration file !> @brief allocates all neccessary fields, reads information from material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine thermal_isothermal_init() subroutine thermal_isothermal_init
use prec, only: &
pReal
use config, only: &
material_Nhomogenization
use material
integer :: & integer :: &
homog, & homog, &
NofMyHomog NofMyHomog
write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_isothermal_label//' init -+>>>' write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_isothermal_label//' init -+>>>'
initializeInstances: do homog = 1, material_Nhomogenization initializeInstances: do homog = 1, material_Nhomogenization
if (thermal_type(homog) /= THERMAL_isothermal_ID) cycle if (thermal_type(homog) /= THERMAL_isothermal_ID) cycle
NofMyHomog = count(material_homogenizationAt == homog) NofMyHomog = count(material_homogenizationAt == homog)
thermalState(homog)%sizeState = 0 thermalState(homog)%sizeState = 0
thermalState(homog)%sizePostResults = 0 thermalState(homog)%sizePostResults = 0
allocate(thermalState(homog)%state0 (0,NofMyHomog), source=0.0_pReal) allocate(thermalState(homog)%state0 (0,NofMyHomog), source=0.0_pReal)
allocate(thermalState(homog)%subState0(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) allocate(thermalState(homog)%state (0,NofMyHomog), source=0.0_pReal)
deallocate(temperature (homog)%p) deallocate(temperature (homog)%p)
allocate (temperature (homog)%p(1), source=thermal_initialT(homog)) allocate (temperature (homog)%p(1), source=thermal_initialT(homog))
deallocate(temperatureRate(homog)%p) deallocate(temperatureRate(homog)%p)
allocate (temperatureRate(homog)%p(1), source=0.0_pReal) allocate (temperatureRate(homog)%p(1), source=0.0_pReal)
enddo initializeInstances
enddo initializeInstances
end subroutine thermal_isothermal_init end subroutine thermal_isothermal_init