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

Merge remote-tracking branch 'origin/development' into restructure-Orientation-2

This commit is contained in:
Martin Diehl 2021-08-08 10:18:34 +02:00
parent 96767e75a3 be8e0dc86a
commit 4e6663d258
40 changed files with 1156 additions and 795 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
PRIVATE

@ -1 +1 @@
Subproject commit 174ecac2d3ab7596bdb60184d6bb9e1a52cb7378
Subproject commit 4ce625b4ac0da9d490620f8cf1694d0a057cfa47

42
examples/config/Phase_DisloUCLA_Tungsten.config
View File

@ -1,42 +0,0 @@
[Tungsten]
elasticity hooke
plasticity disloucla
(output) edge_density
(output) dipole_density
(output) shear_rate_slip
(output) accumulated_shear_slip
(output) resolved_stress_slip
(output) threshold_stress_slip
grainsize 2.7e-5 # Average grain size [m] 2.0e-5
SolidSolutionStrength 0.0 # Strength due to elements in solid solution
### Dislocation glide parameters ###
#per family
Nslip 12
slipburgers 2.72e-10 # Burgers vector of slip system [m]
rhoedge0 1.0e12 # Initial edge dislocation density [m/m**3]
rhoedgedip0 1.0 # Initial edged dipole dislocation density [m/m**3]
Qedge 2.61154e-19 # Activation energy for dislocation glide [J], 1.63 eV
v0 1 # Initial glide velocity [m/s]
p_slip 0.86 # p-exponent in glide velocity
q_slip 1.69 # q-exponent in glide velocity
tau_peierls 2.03e9 # peierls stress [Pa]
#mobility law
kink_height 2.567e-10 # kink height sqrt(6)/3*lattice_parameter [m]
omega 9.1e11 # attemp frequency (from kMC paper) [s^(-1)]
kink_width 29.95e-10 # kink pair width ~ 11 b (kMC paper) [m]
dislolength 78e-10 # dislocation length (ideally lambda) [m] initial value 11b
friction_coeff 8.3e-5 # friction coeff. B [Pa*s]
#hardening
dipoleformationfactor 0 # to have hardening due to dipole formation off
CLambdaSlip 10.0 # Adj. parameter controlling dislocation mean free path
D0 4.0e-5 # Vacancy diffusion prefactor [m**2/s]
Qsd 4.5e-19 # Activation energy for climb [J]
Catomicvolume 1.0 # Adj. parameter controlling the atomic volume [in b]
Cedgedipmindistance 1.0 # Adj. parameter controlling the minimum dipole distance [in b]
interaction_slipslip 0.009 0.72 0.009 0.05 0.05 0.06 0.09
nonschmid_coefficients 0.938 0.71 4.43 0.0 0.0 0.0

26
examples/config/Phase_Dislotungsten_W.yaml Normal file
View File

@ -0,0 +1,26 @@
type: dislotungsten
N_sl: [12]
rho_mob_0: [1.0e+9]
rho_dip_0: [1.0]
nu_a: [9.1e+11]
b_sl: [2.72e-10]
Delta_H_kp,0: [2.61154e-19] # 1.63 eV, Delta_H0
tau_Peierls: [2.03e+9]
p_sl: [0.86]
q_sl: [1.69]
h: [2.566e-10]
w: [2.992e-09]
B: [8.3e-5]
D_a: 1.0 # d_edge
# climb (disabled)
D_0: 0.0
Q_cl: 0.0
V_cl: [0.0]
h_sl-sl: [0.009, 0.72, 0.009, 0.05, 0.05, 0.06, 0.09]
a_nonSchmid: [0.938, 0.71, 4.43]

2
examples/config/Phase_Dislotwin_TWIP-Steel-FeMnC.yaml
View File

@ -6,7 +6,7 @@ b_sl: [2.56e-10]
rho_mob_0: [1.0e+12]
rho_dip_0: [1.0]
v_0: [1.0e+4]
Q_s: [3.7e-19]
Q_sl: [3.7e-19]
p_sl: [1.0]
q_sl: [1.0]
tau_0: [1.5e+8]

3
examples/config/phase/mechanical/plastic/dislotwin_IF-steel.yaml
View File

@ -11,7 +11,7 @@ b_sl: [2.49e-10, 2.49e-10]
rho_mob_0: [2.81e12, 2.8e+12]
rho_dip_0: [1.0, 1.0] # not given
v_0: [1.4e+3, 1.4e+3]
Q_s: [1.57e-19, 1.57e-19] # Delta_F
Q_sl: [1.57e-19, 1.57e-19] # Delta_F
tau_0: [454.e+6, 454.e+6]
p_sl: [0.325, 0.325]
q_sl: [1.55, 1.55]
@ -19,6 +19,5 @@ i_sl: [23.3, 23.3]
D_a: 7.4 # C_anni
B: [0.001, 0.001]
h_sl-sl: [0.1, 0.72, 0.1, 0.053, 0.053, 0.073, 0.137, 0.72, 0.72, 0.053, 0.053, 0.053, 0.053, 0.073, 0.073, 0.073, 0.073, 0.073, 0.073, 0.137, 0.073, 0.073, 0.137, 0.073]
D_0: 4.0e-05
Q_cl: 5.4e-19 # no recovery!
D: 40.e-6 # estimated

33
examples/config/Phase_Phenopowerlaw_Magnesium.yaml → examples/config/phase/mechanical/plastic/phenopowerlaw_Mg.yaml
View File

@ -1,20 +1,29 @@
N_sl: [3, 3, 0, 6, 0, 6]
N_tw: [6, 0, 0, 6]
h_0_tw-tw: 50.0e+6
h_0_sl-sl: 500.0e+6
h_0_tw-sl: 150.0e+6
h_sl-sl: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
h_tw-tw: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
h_sl-tw: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
h_tw-sl: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
output: [xi_sl, xi_tw]
type: phenopowerlaw
xi_0_sl: [10.e+6, 55.e+6, 0., 60.e+6, 0., 60.e+6]
references:
- F. Wang et al.,
Acta Materialia 80:77-93, 2014,
https://doi.org/10.1016/j.actamat.2014.07.048
output: [xi_sl, xi_tw]
N_sl: [3, 3, 0, 6, 0, 6] # basal, 1. prism, -, 1. pyr<a>, -, 2. pyr<c+a>
N_tw: [6, 0, 6] # tension, -, compression
xi_0_sl: [10.e+6, 55.e+6, 0., 60.e+6, 0., 60.e+6]
xi_inf_sl: [40.e+6, 135.e+6, 0., 150.e+6, 0., 150.e+6]
xi_0_tw: [40.e+6, 0., 0., 60.e+6]
xi_0_tw: [40.e+6, 0., 60.e+6]
a_sl: 2.25
dot_gamma_0_sl: 0.001
dot_gamma_0_tw: 0.001
n_sl: 20
n_tw: 20
f_sat_sl-tw: 10.0
h_0_sl-sl: 500.0e+6
h_0_tw-tw: 50.0e+6
h_0_tw-sl: 150.0e+6
h_sl-sl: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
h_tw-tw: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
h_tw-sl: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
h_sl-tw: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]

5
examples/config/phase/mechanical/plastic/phenopowerlaw_Ti.yaml
View File

@ -7,14 +7,17 @@ references:
Acta Materialia 132:598-610, 2017,
https://doi.org/10.1016/j.actamat.2017.05.015
output: [gamma_sl]
N_sl: [3, 3, 0, 0, 12]
N_sl: [3, 3, 0, 0, 12] # basal, 1. prism, -, -, 2. pyr<c+a>
n_sl: 20
a_sl: 2.0
dot_gamma_0_sl: 0.001
h_0_sl-sl: 200.e+6
# C. Zambaldi et al.:
xi_0_sl: [349.e+6, 150.e+6, 0.0, 0.0, 1107.e+6]
xi_inf_sl: [568.e+6, 150.e+7, 0.0, 0.0, 3420.e+6]
# L. Wang et al. :
# xi_0_sl: [127.e+6, 96.e+6, 0.0, 0.0, 240.e+6]
h_sl-sl: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]

4
examples/mesh/tensionZ.load
View File

@ -1,11 +1,11 @@
#initial elastic step
$Loadcase 1 time 0.0005 incs 1 frequency 5
$Loadcase 1 t 0.0005 N 1 f_out 5
Face 1 X 0.01
Face 2 X 0.0
Face 2 Y 0.0
Face 2 Z 0.0
$EndLoadcase
$Loadcase 2 time 10.0 incs 200 frequency 5
$Loadcase 2 t 10.0 N 200 f_out 5
Face 1 X 0.01
Face 2 X 0.0
Face 2 Y 0.0

2
python/damask/VERSION
View File

@ -1 +1 @@
v3.0.0-alpha4-137-gb69b85754
v3.0.0-alpha4-235-g2635bb012

35
python/damask/_result.py
View File

@ -99,8 +99,10 @@ class Result:
self.version_major = f.attrs['DADF5_version_major']
self.version_minor = f.attrs['DADF5_version_minor']
if self.version_major != 0 or not 12 <= self.version_minor <= 13:
if self.version_major != 0 or not 12 <= self.version_minor <= 14:
raise TypeError(f'Unsupported DADF5 version {self.version_major}.{self.version_minor}')
if self.version_major == 0 and self.version_minor < 14:
self.export_setup = None
self.structured = 'cells' in f['geometry'].attrs.keys()
@ -1383,7 +1385,7 @@ class Result:
def export_XDMF(self,output='*'):
"""
Write XDMF file to directly visualize data in DADF5 file.
Write XDMF file to directly visualize data from DADF5 file.
The XDMF format is only supported for structured grids
with single phase and single constituent.
@ -1736,3 +1738,32 @@ class Result:
if flatten: r = util.dict_flatten(r)
return None if (type(r) == dict and r == {}) else r
def export_setup(self,output='*',overwrite=False):
"""
Export configuration files.
Parameters
----------
output : (list of) str, optional
Names of the datasets to export to the file.
Defaults to '*', in which case all datasets are exported.
overwrite : boolean, optional
Overwrite existing configuration files.
Defaults to False.
"""
def export(name,obj,output,overwrite):
if type(obj) == h5py.Dataset and _match(output,[name]):
d = obj.attrs['description'] if h5py3 else obj.attrs['description'].decode()
if not Path(name).exists() or overwrite:
with open(name,'w') as f_out: f_out.write(obj[()].decode())
print(f"Exported {d} to '{name}'.")
else:
print(f"'{name}' exists, {d} not exported.")
elif type(obj) == h5py.Group:
os.makedirs(name, exist_ok=True)
with h5py.File(self.fname,'r') as f_in:
f_in['setup'].visititems(partial(export,output=output,overwrite=overwrite))

27
src/CPFEM.f90
View File

@ -4,22 +4,23 @@
!> @brief CPFEM engine
!--------------------------------------------------------------------------------------------------
module CPFEM
use DAMASK_interface
use prec
use math
use rotations
use IO
use YAML_types
use YAML_parse
use discretization_marc
use material
use config
use homogenization
use IO
use discretization
use DAMASK_interface
use HDF5_utilities
use results
use config
use math
use rotations
use lattice
use material
use phase
use homogenization
use discretization
use discretization_marc
implicit none
private
@ -68,7 +69,7 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief call all module initializations
!> @brief Initialize all modules.
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_initAll
@ -77,13 +78,13 @@ subroutine CPFEM_initAll
call IO_init
call YAML_types_init
call YAML_parse_init
call HDF5_utilities_init
call results_init(.false.)
call config_init
call math_init
call rotations_init
call HDF5_utilities_init
call results_init(.false.)
call discretization_marc_init
call lattice_init
call discretization_marc_init
call material_init(.false.)
call phase_init
call homogenization_init

34
src/CPFEM2.f90
View File

@ -4,28 +4,29 @@
!> @brief needs a good name and description
!--------------------------------------------------------------------------------------------------
module CPFEM2
use prec
use parallelization
use config
use math
use rotations
use DAMASK_interface
use prec
use IO
use YAML_types
use YAML_parse
use material
use lattice
use IO
use base64
use DAMASK_interface
use discretization
use HDF5
use HDF5_utilities
use results
use homogenization
use config
use math
use rotations
use lattice
use material
use phase
use homogenization
use discretization
#if defined(MESH)
use FEM_quadrature
use discretization_mesh
#elif defined(GRID)
use base64
use discretization_grid
#endif
@ -36,7 +37,7 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief call all module initializations
!> @brief Initialize all modules.
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_initAll
@ -44,18 +45,19 @@ subroutine CPFEM_initAll
call DAMASK_interface_init ! Spectral and FEM interface to commandline
call prec_init
call IO_init
call base64_init
#ifdef MESH
#if defined(MESH)
call FEM_quadrature_init
#elif defined(GRID)
call base64_init
#endif
call YAML_types_init
call YAML_parse_init
call HDF5_utilities_init
call results_init(restart=interface_restartInc>0)
call config_init
call math_init
call rotations_init
call lattice_init
call HDF5_utilities_init
call results_init(restart=interface_restartInc>0)
#if defined(MESH)
call discretization_mesh_init(restart=interface_restartInc>0)
#elif defined(GRID)

6
src/DAMASK_interface.f90
View File

@ -139,10 +139,10 @@ subroutine DAMASK_interface_init
print'(a)', ' Optional arguments:'
print'(/,a)',' --workingdirectory PathToWorkingDirectory'
print'(a)', ' Specifies the working directory and overwrites the default ./'
print'(a)', ' Make sure the file "material.config" exists in the working'
print'(a)', ' Make sure the file "material.yaml" exists in the working'
print'(a)', ' directory.'
print'(a)', ' For further configuration place "numerics.config"'
print'(a)',' and "debug.config" in that directory.'
print'(a)', ' For further configuration place "numerics.yaml"'
print'(a)',' and "debug.yaml" in that directory.'
print'(/,a)',' --restart N'
print'(a)', ' Reads in increment N and continues with calculating'
print'(a)', ' increment N+1 based on this.'

201
src/HDF5_utilities.f90
View File

@ -71,6 +71,7 @@ module HDF5_utilities
module procedure HDF5_addAttribute_str
module procedure HDF5_addAttribute_int
module procedure HDF5_addAttribute_real
module procedure HDF5_addAttribute_str_array
module procedure HDF5_addAttribute_int_array
module procedure HDF5_addAttribute_real_array
end interface HDF5_addAttribute
@ -84,6 +85,7 @@ module HDF5_utilities
HDF5_utilities_init, &
HDF5_read, &
HDF5_write, &
HDF5_write_str, &
HDF5_addAttribute, &
HDF5_addGroup, &
HDF5_openGroup, &
@ -127,10 +129,11 @@ end subroutine HDF5_utilities_init
!--------------------------------------------------------------------------------------------------
!> @brief open and initializes HDF5 output file
!--------------------------------------------------------------------------------------------------
integer(HID_T) function HDF5_openFile(fileName,mode)
integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
character(len=*), intent(in) :: fileName
character, intent(in), optional :: mode
logical, intent(in), optional :: parallel
character :: m
integer(HID_T) :: plist_id
@ -147,7 +150,11 @@ integer(HID_T) function HDF5_openFile(fileName,mode)
if(hdferr < 0) error stop 'HDF5 error'
#ifdef PETSC
call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
if (present(parallel)) then
if (parallel) call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
else
call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
endif
if(hdferr < 0) error stop 'HDF5 error'
#endif
@ -270,7 +277,7 @@ end subroutine HDF5_closeGroup
!--------------------------------------------------------------------------------------------------
!> @brief check whether a group or a dataset exists
!> @brief Check whether a group or a dataset exists.
!--------------------------------------------------------------------------------------------------
logical function HDF5_objectExists(loc_id,path)
@ -280,6 +287,7 @@ logical function HDF5_objectExists(loc_id,path)
integer :: hdferr
character(len=:), allocatable :: p
if (present(path)) then
p = trim(path)
else
@ -298,7 +306,7 @@ end function HDF5_objectExists
!--------------------------------------------------------------------------------------------------
!> @brief adds a string attribute to the path given relative to the location
!> @brief Add a string attribute to the path given relative to the location.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
@ -313,6 +321,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
character(len=:,kind=C_CHAR), allocatable,target :: attrValue_
type(c_ptr), target, dimension(1) :: ptr
if (present(path)) then
p = trim(path)
else
@ -326,6 +335,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error'
call h5tcopy_f(H5T_STRING, type_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then
@ -336,6 +346,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, type_id, c_loc(ptr(1)), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(type_id,hdferr)
@ -347,7 +358,7 @@ end subroutine HDF5_addAttribute_str
!--------------------------------------------------------------------------------------------------
!> @brief adds a integer attribute to the path given relative to the location
!> @brief Add an integer attribute to the path given relative to the location.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
@ -361,6 +372,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
logical :: attrExists
character(len=:), allocatable :: p
if (present(path)) then
p = trim(path)
else
@ -369,6 +381,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then
@ -379,6 +392,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
@ -388,7 +402,7 @@ end subroutine HDF5_addAttribute_int
!--------------------------------------------------------------------------------------------------
!> @brief adds a integer attribute to the path given relative to the location
!> @brief Add a real attribute to the path given relative to the location.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
@ -402,6 +416,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
logical :: attrExists
character(len=:), allocatable :: p
if (present(path)) then
p = trim(path)
else
@ -410,6 +425,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then
@ -420,6 +436,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
@ -429,7 +446,67 @@ end subroutine HDF5_addAttribute_real
!--------------------------------------------------------------------------------------------------
!> @brief adds a integer attribute to the path given relative to the location
!> @brief Add a string array attribute to the path given relative to the location.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path)
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: attrLabel
character(len=*), intent(in), dimension(:) :: attrValue
character(len=*), intent(in), optional :: path
integer(HID_T) :: attr_id, space_id, filetype_id, memtype_id
integer :: hdferr
logical :: attrExists
character(len=:), allocatable :: p
type(C_PTR) :: f_ptr
character(len=:), allocatable, dimension(:), target :: attrValue_
if (present(path)) then
p = trim(path)
else
p = '.'
endif
attrValue_ = attrValue
call h5tcopy_f(H5T_C_S1,filetype_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tset_size_f(filetype_id, int(len(attrValue_)+1,C_SIZE_T),hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tset_size_f(memtype_id, int(len(attrValue_),C_SIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5screate_simple_f(1,shape(attrValue_,kind=HSIZE_T),space_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),filetype_id,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
f_ptr = c_loc(attrValue_)
call h5awrite_f(attr_id, memtype_id, f_ptr, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(memtype_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(filetype_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_addAttribute_str_array
!--------------------------------------------------------------------------------------------------
!> @brief Add an integer array attribute to the path given relative to the location.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
@ -444,6 +521,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
logical :: attrExists
character(len=:), allocatable :: p
if (present(path)) then
p = trim(path)
else
@ -454,6 +532,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then
@ -464,6 +543,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, array_size, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
@ -473,7 +553,7 @@ end subroutine HDF5_addAttribute_int_array
!--------------------------------------------------------------------------------------------------
!> @brief adds a real attribute to the path given relative to the location
!> @brief Add a real array attribute to the path given relative to the location.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
@ -488,6 +568,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
logical :: attrExists
character(len=:), allocatable :: p
if (present(path)) then
p = trim(path)
else
@ -498,6 +579,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then
@ -508,6 +590,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, array_size, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
@ -517,7 +600,7 @@ end subroutine HDF5_addAttribute_real_array
!--------------------------------------------------------------------------------------------------
!> @brief set link to object in results file
!> @brief Set link to object in results file.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_setLink(loc_id,target_name,link_name)
@ -549,7 +632,7 @@ subroutine HDF5_read_real1(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & ! ToDo: Fortran 2018 size(shape(A)) = rank(A)
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -589,7 +672,7 @@ subroutine HDF5_read_real2(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -629,7 +712,7 @@ subroutine HDF5_read_real3(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -669,7 +752,7 @@ subroutine HDF5_read_real4(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -709,7 +792,7 @@ subroutine HDF5_read_real5(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -749,7 +832,7 @@ subroutine HDF5_read_real6(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -789,7 +872,7 @@ subroutine HDF5_read_real7(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -831,7 +914,7 @@ subroutine HDF5_read_int1(dataset,loc_id,datasetName,parallel)
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -871,7 +954,7 @@ subroutine HDF5_read_int2(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -911,7 +994,7 @@ subroutine HDF5_read_int3(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -951,7 +1034,7 @@ subroutine HDF5_read_int4(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -991,7 +1074,7 @@ subroutine HDF5_read_int5(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1031,7 +1114,7 @@ subroutine HDF5_read_int6(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1071,7 +1154,7 @@ subroutine HDF5_read_int7(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1114,7 +1197,7 @@ subroutine HDF5_write_real1(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1155,7 +1238,7 @@ subroutine HDF5_write_real2(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1196,7 +1279,7 @@ subroutine HDF5_write_real3(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1237,7 +1320,7 @@ subroutine HDF5_write_real4(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1279,7 +1362,7 @@ subroutine HDF5_write_real5(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1320,7 +1403,7 @@ subroutine HDF5_write_real6(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1361,7 +1444,7 @@ subroutine HDF5_write_real7(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1390,6 +1473,48 @@ subroutine HDF5_write_real7(dataset,loc_id,datasetName,parallel)
end subroutine HDF5_write_real7
!--------------------------------------------------------------------------------------------------
!> @brief Write dataset of type string (scalar).
!> @details Not collective, must be called by one process at at time.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_str(dataset,loc_id,datasetName)
character(len=*), intent(in) :: dataset
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
integer(HID_T) :: filetype_id, space_id, dataset_id
integer :: hdferr
character(len=len_trim(dataset)+1,kind=C_CHAR), dimension(1), target :: dataset_
type(C_PTR), target, dimension(1) :: ptr
dataset_(1) = trim(dataset)//C_NULL_CHAR
ptr(1) = c_loc(dataset_(1))
call h5tcopy_f(H5T_STRING, filetype_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tset_size_f(filetype_id, int(len(dataset_),HSIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5screate_f(H5S_SCALAR_F, space_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5dcreate_f(loc_id, datasetName, H5T_STRING, space_id, dataset_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5dwrite_f(dataset_id, H5T_STRING, c_loc(ptr), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5dclose_f(dataset_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(filetype_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_write_str
!--------------------------------------------------------------------------------------------------
!> @brief write dataset of type integer with 1 dimension
!--------------------------------------------------------------------------------------------------
@ -1403,7 +1528,7 @@ subroutine HDF5_write_int1(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1444,7 +1569,7 @@ subroutine HDF5_write_int2(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1485,7 +1610,7 @@ subroutine HDF5_write_int3(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1526,7 +1651,7 @@ subroutine HDF5_write_int4(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1567,7 +1692,7 @@ subroutine HDF5_write_int5(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1608,7 +1733,7 @@ subroutine HDF5_write_int6(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1649,7 +1774,7 @@ subroutine HDF5_write_int7(dataset,loc_id,datasetName,parallel)
integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: &
integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, &
myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes)
@ -1795,7 +1920,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
integer(HSIZE_T), parameter :: chunkSize = 1024_HSIZE_T**2/8_HSIZE_T
!-------------------------------------------------------------------------------------------------
! creating a property list for transfer properties (is collective when reading in parallel)
! creating a property list for transfer properties (is collective when writing in parallel)
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
#ifdef PETSC

16
src/IO.f90
View File

@ -16,7 +16,8 @@ module IO
private
character(len=*), parameter, public :: &
IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13) !< whitespace characters
IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13), & !< whitespace characters
IO_QUOTES = "'"//'"'
character, parameter, public :: &
IO_EOL = new_line('DAMASK'), & !< end of line character
IO_COMMENT = '#'
@ -119,27 +120,28 @@ function IO_read(fileName) result(fileContent)
character(len=:), allocatable :: fileContent
integer :: &
fileLength, &
fileUnit, &
myStat
integer(pI64) :: &
fileLength
inquire(file = fileName, size=fileLength)
open(newunit=fileUnit, file=fileName, access='stream',&
status='old', position='rewind', action='read',iostat=myStat)
if(myStat /= 0) call IO_error(100,ext_msg=trim(fileName))
if (myStat /= 0) call IO_error(100,ext_msg=trim(fileName))
allocate(character(len=fileLength)::fileContent)
if(fileLength==0) then
if (fileLength==0) then
close(fileUnit)
return
endif
read(fileUnit,iostat=myStat) fileContent
if(myStat /= 0) call IO_error(102,ext_msg=trim(fileName))
if (myStat /= 0) call IO_error(102,ext_msg=trim(fileName))
close(fileUnit)
if (scan(fileContent(:index(fileContent,LF)),CR//LF) /= 0) fileContent = CRLF2LF(fileContent)
if(fileContent(fileLength:fileLength) /= IO_EOL) fileContent = fileContent//IO_EOL ! ensure EOL@EOF
if (fileContent(fileLength:fileLength) /= IO_EOL) fileContent = fileContent//IO_EOL ! ensure EOL@EOF
end function IO_read
@ -494,6 +496,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
msg = '--- expected after YAML file header'
case (709)
msg = 'Length mismatch'
case (710)
msg = 'Closing quotation mark missing in string'
!-------------------------------------------------------------------------------------------------
! errors related to the grid solver

8
src/Marc/discretization_Marc.f90
View File

@ -216,7 +216,13 @@ subroutine inputRead(elem,node0_elem,connectivity_elem,materialAt)
mapElemSet !< list of elements in elementSet
inputFile = IO_readlines(trim(getSolverJobName())//trim(InputFileExtension))
call results_openJobFile
call results_writeDataset_str(IO_read(trim(getSolverJobName())//InputFileExtension), 'setup', &
trim(getSolverJobName())//InputFileExtension, &
'MSC.Marc input deck')
call results_closeJobFile
inputFile = IO_readlines(trim(getSolverJobName())//InputFileExtension)
call inputRead_fileFormat(fileFormatVersion, &
inputFile)
call inputRead_tableStyles(initialcondTableStyle,hypoelasticTableStyle, &

97
src/YAML_parse.f90
View File

@ -14,7 +14,7 @@ module YAML_parse
public :: &
YAML_parse_init, &
YAML_parse_file
YAML_parse_str
contains
@ -29,16 +29,16 @@ end subroutine YAML_parse_init
!--------------------------------------------------------------------------------------------------
!> @brief Parse a YAML file into a a structure of nodes.
!> @brief Parse a YAML string into a a structure of nodes.
!--------------------------------------------------------------------------------------------------
function YAML_parse_file(fname) result(node)
function YAML_parse_str(str) result(node)
character(len=*), intent(in) :: fname
character(len=*), intent(in) :: str
class (tNode), pointer :: node
node => parse_flow(to_flow(IO_read(fname)))
node => parse_flow(to_flow(str))
end function YAML_parse_file
end function YAML_parse_str
!--------------------------------------------------------------------------------------------------
@ -71,8 +71,8 @@ recursive function parse_flow(YAML_flow) result(node)
s = e
d = s + scan(flow_string(s+1:),':')
e = d + find_end(flow_string(d+1:),'}')
key = trim(adjustl(flow_string(s+1:d-1)))
if(quotedString(key)) key = key(2:len(key)-1)
myVal => parse_flow(flow_string(d+1:e-1)) ! parse items (recursively)
select type (node)
@ -97,7 +97,11 @@ recursive function parse_flow(YAML_flow) result(node)
allocate(tScalar::node)
select type (node)
class is (tScalar)
node = trim(adjustl(flow_string))
if(quotedString(flow_string)) then
node = trim(adjustl(flow_string(2:len(flow_string)-1)))
else
node = trim(adjustl(flow_string))
endif
end select
endif
@ -119,18 +123,38 @@ integer function find_end(str,e_char)
N_sq = 0
N_cu = 0
do i = 1, len_trim(str)
i = 1
do while(i<=len_trim(str))
if (scan(str(i:i),IO_QUOTES) == 1) i = i + scan(str(i+1:),str(i:i))
if (N_sq==0 .and. N_cu==0 .and. scan(str(i:i),e_char//',') == 1) exit
N_sq = N_sq + merge(1,0,str(i:i) == '[')
N_cu = N_cu + merge(1,0,str(i:i) == '{')
N_sq = N_sq - merge(1,0,str(i:i) == ']')
N_cu = N_cu - merge(1,0,str(i:i) == '}')
i = i + 1
enddo
find_end = i
end function find_end
!--------------------------------------------------------------------------------------------------
! @brief check whether a string is enclosed with single or double quotes
!--------------------------------------------------------------------------------------------------
logical function quotedString(line)
character(len=*), intent(in) :: line
quotedString = .false.
if (scan(line(:1),IO_QUOTES) == 1) then
quotedString = .true.
if(line(len(line):len(line)) /= line(:1)) call IO_error(710,ext_msg=line)
endif
end function quotedString
!--------------------------------------------------------------------------------------------------
! @brief Returns Indentation.
! @details It determines the indentation level for a given block/line.
@ -333,6 +357,36 @@ subroutine remove_line_break(blck,s_blck,e_char,flow_line)
end subroutine remove_line_break
!--------------------------------------------------------------------------------------------------
!> @brief return the scalar list item without line break
!--------------------------------------------------------------------------------------------------
subroutine list_item_inline(blck,s_blck,inline) !ToDo: SR: merge with remove_line_break eventually
character(len=*), intent(in) :: blck !< YAML in mixed style
integer, intent(inout) :: s_blck
character(len=:), allocatable, intent(out) :: inline
character(len=:), allocatable :: line
integer :: indent,indent_next
line = IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))
indent = indentDepth(blck(s_blck:))
inline = line(indent+3:)
s_blck = s_blck + index(blck(s_blck:),IO_EOL)
indent_next = indentDepth(blck(s_blck:))
do while(indent_next > indent)
inline = inline//' '//trim(adjustl(IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))))
s_blck = s_blck + index(blck(s_blck:),IO_EOL)
indent_next = indentDepth(blck(s_blck:))
enddo
if(scan(inline,",") > 0) inline = '"'//inline//'"'
end subroutine list_item_inline
!--------------------------------------------------------------------------------------------------
! @brief reads a line of YAML block which is already in flow style
! @details Dicts should be enlcosed within '{}' for it to be consistent with DAMASK YAML parser
@ -463,7 +517,7 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset)
integer, intent(inout) :: s_blck, & !< start position in blck
s_flow, & !< start position in flow
offset !< stores leading '- ' in nested lists
character(len=:), allocatable :: line,flow_line
character(len=:), allocatable :: line,flow_line,inline
integer :: e_blck,indent
indent = indentDepth(blck(s_blck:),offset)
@ -509,8 +563,8 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset)
else ! list item in the same line
line = line(indentDepth(line)+3:)
if(isScalar(line)) then
call line_toFlow(flow,s_flow,line)
s_blck = e_blck +2
call list_item_inline(blck,s_blck,inline)
call line_toFlow(flow,s_flow,inline)
offset = 0
elseif(isFlow(line)) then
s_blck = s_blck + index(blck(s_blck:),'-')
@ -723,6 +777,8 @@ subroutine selfTest
if (indentDepth('a') /= 0) error stop 'indentDepth'
if (indentDepth('x ') /= 0) error stop 'indentDepth'
if (.not. quotedString("'a'")) error stop 'quotedString'
if ( isFlow(' a')) error stop 'isFLow'
if (.not. isFlow('{')) error stop 'isFlow'
if (.not. isFlow(' [')) error stop 'isFlow'
@ -809,14 +865,14 @@ subroutine selfTest
multi_line_flow1: block
character(len=*), parameter :: flow_multi = &
"%YAML 1.1"//IO_EOL//&
"---"//IO_EOL//&
"a: [b,"//IO_EOL//&
"c: "//IO_EOL//&
"d, e]"//IO_EOL
'%YAML 1.1'//IO_EOL//&
'---'//IO_EOL//&
'a: ["b",'//IO_EOL//&
'c: '//IO_EOL//&
'"d", "e"]'//IO_EOL
character(len=*), parameter :: flow = &
"{a: [b, {c: d}, e]}"
'{a: ["b", {c: "d"}, "e"]}'
if( .not. to_flow(flow_multi) == flow) error stop 'to_flow'
end block multi_line_flow1
@ -848,14 +904,15 @@ subroutine selfTest
" "//IO_EOL//&
" "//IO_EOL//&
" param_1: [a: b, c, {d: {e: [f: g, h]}}]"//IO_EOL//&
" - c: d"//IO_EOL//&
" - c:d"//IO_EOL//&
" e.f,"//IO_EOL//&
" bb:"//IO_EOL//&
" "//IO_EOL//&
" - "//IO_EOL//&
" {param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}"//IO_EOL//&
"..."//IO_EOL
character(len=*), parameter :: mixed_flow = &
"{aa: [{param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}, {c: d}], bb: [{param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}]}"
'{aa: [{param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}, "c:d e.f,"], bb: [{param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}]}'
if(.not. to_flow(block_flow) == mixed_flow) error stop 'to_flow'
end block basic_mixed

9
src/YAML_types.f90
View File

@ -849,7 +849,7 @@ function tNode_get_byKey_as1dFloat(self,k,defaultVal,requiredSize) result(nodeAs
if (self%contains(k)) then
node => self%get(k)
select type(self)
select type(node)
class is(tList)
list => node%asList()
nodeAs1dFloat = list%as1dFloat()
@ -872,11 +872,12 @@ end function tNode_get_byKey_as1dFloat
!--------------------------------------------------------------------------------------------------
!> @brief Access by key and convert to float array (2D)
!--------------------------------------------------------------------------------------------------
function tNode_get_byKey_as2dFloat(self,k,defaultVal) result(nodeAs2dFloat)
function tNode_get_byKey_as2dFloat(self,k,defaultVal,requiredShape) result(nodeAs2dFloat)
class(tNode), intent(in), target :: self
character(len=*), intent(in) :: k
real(pReal), intent(in), dimension(:,:), optional :: defaultVal
integer, intent(in), dimension(2), optional :: requiredShape
real(pReal), dimension(:,:), allocatable :: nodeAs2dFloat
@ -898,6 +899,10 @@ function tNode_get_byKey_as2dFloat(self,k,defaultVal) result(nodeAs2dFloat)
call IO_error(143,ext_msg=k)
endif
if (present(requiredShape)) then
if (any(requiredShape /= shape(nodeAs2dFloat))) call IO_error(146,ext_msg=k)
endif
end function tNode_get_byKey_as2dFloat

6
src/commercialFEM_fileList.f90
View File

@ -7,18 +7,18 @@
#include "IO.f90"
#include "YAML_types.f90"
#include "YAML_parse.f90"
#include "HDF5_utilities.f90"
#include "results.f90"
#include "config.f90"
#include "LAPACK_interface.f90"
#include "math.f90"
#include "rotations.f90"
#include "lattice.f90"
#include "element.f90"
#include "HDF5_utilities.f90"
#include "results.f90"
#include "geometry_plastic_nonlocal.f90"
#include "discretization.f90"
#include "Marc/discretization_Marc.f90"
#include "material.f90"
#include "lattice.f90"
#include "phase.f90"
#include "phase_mechanical.f90"
#include "phase_mechanical_elastic.f90"

70
src/config.f90
View File

@ -8,7 +8,8 @@ module config
use IO
use YAML_parse
use YAML_types
use results
use parallelization
implicit none
private
@ -31,6 +32,7 @@ subroutine config_init
print'(/,a)', ' <<<+- config init -+>>>'; flush(IO_STDOUT)
call parse_material
call parse_numerics
call parse_debug
@ -41,15 +43,25 @@ end subroutine config_init
!--------------------------------------------------------------------------------------------------
!> @brief Read material.yaml or <jobname>.yaml.
!--------------------------------------------------------------------------------------------------
subroutine parse_material
subroutine parse_material()
logical :: fileExists
character(len=:), allocatable :: fileContent
inquire(file='material.yaml',exist=fileExists)
if(.not. fileExists) call IO_error(100,ext_msg='material.yaml')
print*, 'reading material.yaml'; flush(IO_STDOUT)
config_material => YAML_parse_file('material.yaml')
if (worldrank == 0) then
print*, 'reading material.yaml'; flush(IO_STDOUT)
fileContent = IO_read('material.yaml')
call results_openJobFile(parallel=.false.)
call results_writeDataset_str(fileContent,'setup','material.yaml','main configuration')
call results_closeJobFile
endif
call parallelization_bcast_str(fileContent)
config_material => YAML_parse_str(fileContent)
end subroutine parse_material
@ -57,16 +69,28 @@ end subroutine parse_material
!--------------------------------------------------------------------------------------------------
!> @brief Read numerics.yaml.
!--------------------------------------------------------------------------------------------------
subroutine parse_numerics
subroutine parse_numerics()
logical :: fexist
logical :: fileExists
character(len=:), allocatable :: fileContent
config_numerics => emptyDict
inquire(file='numerics.yaml', exist=fexist)
if (fexist) then
print*, 'reading numerics.yaml'; flush(IO_STDOUT)
config_numerics => YAML_parse_file('numerics.yaml')
inquire(file='numerics.yaml', exist=fileExists)
if (fileExists) then
if (worldrank == 0) then
print*, 'reading numerics.yaml'; flush(IO_STDOUT)
fileContent = IO_read('numerics.yaml')
call results_openJobFile(parallel=.false.)
call results_writeDataset_str(fileContent,'setup','numerics.yaml','numerics configuration')
call results_closeJobFile
endif
call parallelization_bcast_str(fileContent)
config_numerics => YAML_parse_str(fileContent)
endif
end subroutine parse_numerics
@ -75,17 +99,29 @@ end subroutine parse_numerics
!--------------------------------------------------------------------------------------------------
!> @brief Read debug.yaml.
!--------------------------------------------------------------------------------------------------
subroutine parse_debug
subroutine parse_debug()
logical :: fexist
logical :: fileExists
character(len=:), allocatable :: fileContent
config_debug => emptyDict
inquire(file='debug.yaml', exist=fexist)
fileExists: if (fexist) then
print*, 'reading debug.yaml'; flush(IO_STDOUT)
config_debug => YAML_parse_file('debug.yaml')
endif fileExists
inquire(file='debug.yaml', exist=fileExists)
if (fileExists) then
if (worldrank == 0) then
print*, 'reading debug.yaml'; flush(IO_STDOUT)
fileContent = IO_read('debug.yaml')
call results_openJobFile(parallel=.false.)
call results_writeDataset_str(fileContent,'setup','debug.yaml','debug configuration')
call results_closeJobFile
endif
call parallelization_bcast_str(fileContent)
config_debug => YAML_parse_str(fileContent)
endif
end subroutine parse_debug

1
src/element.f90
View File

@ -151,6 +151,7 @@ module element
integer, dimension(NIPNEIGHBOR(CELLTYPE(1)),NIP(1)), parameter :: IPNEIGHBOR1 = &
reshape([&
-2,-3,-1 &
! Note: This fix is for gfortran 9 only. gfortran 8 supports neither, gfortran > 9 both variants
#if !defined(__GFORTRAN__)
],shape(IPNEIGHBOR1))
#else

14
src/grid/DAMASK_grid.f90
View File

@ -107,6 +107,8 @@ program DAMASK_grid
step_bc, &
step_mech, &
step_discretization
character(len=:), allocatable :: &
fileContent, fname
!--------------------------------------------------------------------------------------------------
! init DAMASK (all modules)
@ -127,7 +129,17 @@ program DAMASK_grid
if (stagItMax < 0) call IO_error(301,ext_msg='maxStaggeredIter')
if (maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack')
config_load => YAML_parse_file(trim(interface_loadFile))
if (worldrank == 0) then
fileContent = IO_read(interface_loadFile)
fname = interface_loadFile
if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:)
call results_openJobFile(parallel=.false.)
call results_writeDataset_str(fileContent,'setup',fname,'load case definition (grid solver)')
call results_closeJobFile
endif
call parallelization_bcast_str(fileContent)
config_load => YAML_parse_str(fileContent)
solver => config_load%get('solver')
!--------------------------------------------------------------------------------------------------

32
src/grid/discretization_grid.f90
View File

@ -68,11 +68,21 @@ subroutine discretization_grid_init(restart)
devNull, z, z_offset
integer, dimension(worldsize) :: &
displs, sendcounts
character(len=:), allocatable :: &
fileContent, fname
print'(/,a)', ' <<<+- discretization_grid init -+>>>'; flush(IO_STDOUT)
if(worldrank == 0) then
call readVTI(grid,geomSize,origin,materialAt_global)
fileContent = IO_read(interface_geomFile)
call readVTI(grid,geomSize,origin,materialAt_global,fileContent)
fname = interface_geomFile
if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:)
call results_openJobFile(parallel=.false.)
call results_writeDataset_str(fileContent,'setup',fname,'geometry definition (grid solver)')
call results_closeJobFile
else
allocate(materialAt_global(0)) ! needed for IntelMPI
endif
@ -157,7 +167,8 @@ end subroutine discretization_grid_init
!> @brief Parse vtk image data (.vti)
!> @details https://vtk.org/Wiki/VTK_XML_Formats
!--------------------------------------------------------------------------------------------------
subroutine readVTI(grid,geomSize,origin,material)
subroutine readVTI(grid,geomSize,origin,material, &
fileContent)
integer, dimension(3), intent(out) :: &
grid ! grid (across all processes!)
@ -166,28 +177,19 @@ subroutine readVTI(grid,geomSize,origin,material)
origin ! origin (across all processes!)
integer, dimension(:), intent(out), allocatable :: &
material
character(len=*), intent(in) :: &
fileContent
character(len=:), allocatable :: fileContent, dataType, headerType
character(len=:), allocatable :: dataType, headerType
logical :: inFile,inImage,gotCellData,compressed
integer :: fileUnit, myStat
integer(pI64) :: &
fileLength, & !< length of the geom file (in characters)
startPos, endPos, &
s
grid = -1
geomSize = -1.0_pReal
!--------------------------------------------------------------------------------------------------
! read raw data as stream
inquire(file = trim(interface_geomFile), size=fileLength)
open(newunit=fileUnit, file=trim(interface_geomFile), access='stream',&
status='old', position='rewind', action='read',iostat=myStat)
if(myStat /= 0) call IO_error(100,ext_msg=trim(interface_geomFile))
allocate(character(len=fileLength)::fileContent)
read(fileUnit) fileContent
close(fileUnit)
inFile = .false.
inImage = .false.
gotCelldata = .false.

16
src/material.f90
View File

@ -8,6 +8,7 @@ module material
use prec
use config
use results
use math
use IO
use rotations
use discretization
@ -19,8 +20,12 @@ module material
type :: tRotationContainer
type(Rotation), dimension(:), allocatable :: data
end type
type :: tTensorContainer
real(pReal), dimension(:,:,:), allocatable :: data
end type
type(tRotationContainer), dimension(:), allocatable :: material_orientation0
type(tRotationContainer), dimension(:), allocatable :: material_O_0
integer, dimension(:), allocatable, public, protected :: &
homogenization_Nconstituents !< number of grains in each homogenization
@ -41,8 +46,9 @@ module material
integer, dimension(:,:,:), allocatable, public, protected :: & ! (constituent,IP,elem)
material_phaseMemberAt !TODO: remove
public :: &
tTensorContainer, &
tRotationContainer, &
material_orientation0, &
material_O_0, &
material_init
contains
@ -152,15 +158,15 @@ subroutine parse()
enddo
allocate(material_orientation0(materials%length))
allocate(material_O_0(materials%length))
do ma = 1, materials%length
material => materials%get(ma)
constituents => material%get('constituents')
allocate(material_orientation0(ma)%data(constituents%length))
allocate(material_O_0(ma)%data(constituents%length))
do co = 1, constituents%length
constituent => constituents%get(co)
call material_orientation0(ma)%data(co)%fromQuaternion(constituent%get_as1dFloat('O',requiredSize=4))
call material_O_0(ma)%data(co)%fromQuaternion(constituent%get_as1dFloat('O',requiredSize=4))
enddo
enddo

87
src/math.f90
View File

@ -233,7 +233,7 @@ end function math_range
!--------------------------------------------------------------------------------------------------
!> @brief second rank identity tensor of specified dimension
!> @brief Rank two identity tensor of specified dimension.
!--------------------------------------------------------------------------------------------------
pure function math_eye(d)
@ -250,21 +250,25 @@ end function math_eye
!--------------------------------------------------------------------------------------------------
!> @brief symmetric fourth rank identity tensor of specified dimension
!> @brief Symmetric rank four identity tensor.
! from http://en.wikipedia.org/wiki/Tensor_derivative_(continuum_mechanics)#Derivative_of_a_second-order_tensor_with_respect_to_itself
!--------------------------------------------------------------------------------------------------
pure function math_identity4th(d)
pure function math_identity4th()
real(pReal), dimension(3,3,3,3) :: math_identity4th
integer, intent(in) :: d !< tensor dimension
integer :: i,j,k,l
real(pReal), dimension(d,d,d,d) :: math_identity4th
real(pReal), dimension(d,d) :: identity2nd
identity2nd = math_eye(d)
do i=1,d; do j=1,d; do k=1,d; do l=1,d
math_identity4th(i,j,k,l) = 0.5_pReal &
*(identity2nd(i,k)*identity2nd(j,l)+identity2nd(i,l)*identity2nd(j,k))
#ifndef __INTEL_COMPILER
do concurrent(i=1:3, j=1:3, k=1:3, l=1:3)
math_identity4th(i,j,k,l) = 0.5_pReal*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
enddo
#else
do i=1,3; do j=1,3; do k=1,3; do l=1,3
math_identity4th(i,j,k,l) = 0.5_pReal*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
enddo; enddo; enddo; enddo
#endif
end function math_identity4th
@ -331,9 +335,16 @@ pure function math_outer(A,B)
real(pReal), dimension(size(A,1),size(B,1)) :: math_outer
integer :: i,j
#ifndef __INTEL_COMPILER
do concurrent(i=1:size(A,1), j=1:size(B,1))
math_outer(i,j) = A(i)*B(j)
enddo
#else
do i=1,size(A,1); do j=1,size(B,1)
math_outer(i,j) = A(i)*B(j)
enddo; enddo
#endif
end function math_outer
@ -373,9 +384,16 @@ pure function math_mul3333xx33(A,B)
real(pReal), dimension(3,3) :: math_mul3333xx33
integer :: i,j
#ifndef __INTEL_COMPILER
do concurrent(i=1:3, j=1:3)
math_mul3333xx33(i,j) = sum(A(i,j,1:3,1:3)*B(1:3,1:3))
enddo
#else
do i=1,3; do j=1,3
math_mul3333xx33(i,j) = sum(A(i,j,1:3,1:3)*B(1:3,1:3))
enddo; enddo
#endif
end function math_mul3333xx33
@ -390,9 +408,16 @@ pure function math_mul3333xx3333(A,B)
real(pReal), dimension(3,3,3,3), intent(in) :: B
real(pReal), dimension(3,3,3,3) :: math_mul3333xx3333
#ifndef __INTEL_COMPILER
do concurrent(i=1:3, j=1:3, k=1:3, l=1:3)
math_mul3333xx3333(i,j,k,l) = sum(A(i,j,1:3,1:3)*B(1:3,1:3,k,l))
enddo
#else
do i=1,3; do j=1,3; do k=1,3; do l=1,3
math_mul3333xx3333(i,j,k,l) = sum(A(i,j,1:3,1:3)*B(1:3,1:3,k,l))
enddo; enddo; enddo; enddo
#endif
end function math_mul3333xx3333
@ -545,19 +570,6 @@ pure function math_symmetric33(m)
end function math_symmetric33
!--------------------------------------------------------------------------------------------------
!> @brief symmetrize a 6x6 matrix
!--------------------------------------------------------------------------------------------------
pure function math_symmetric66(m)
real(pReal), dimension(6,6) :: math_symmetric66
real(pReal), dimension(6,6), intent(in) :: m
math_symmetric66 = 0.5_pReal * (m + transpose(m))
end function math_symmetric66
!--------------------------------------------------------------------------------------------------
!> @brief skew part of a 3x3 matrix
!--------------------------------------------------------------------------------------------------
@ -712,6 +724,7 @@ pure function math_6toSym33(v6,weighted)
real(pReal), dimension(6) :: w
integer :: i
if(present(weighted)) then
w = merge(INVNRMMANDEL,1.0_pReal,weighted)
else
@ -736,9 +749,16 @@ pure function math_3333to99(m3333)
integer :: i,j
#ifndef __INTEL_COMPILER
do concurrent(i=1:9, j=1:9)
math_3333to99(i,j) = m3333(MAPPLAIN(1,i),MAPPLAIN(2,i),MAPPLAIN(1,j),MAPPLAIN(2,j))
enddo
#else
do i=1,9; do j=1,9
math_3333to99(i,j) = m3333(MAPPLAIN(1,i),MAPPLAIN(2,i),MAPPLAIN(1,j),MAPPLAIN(2,j))
enddo; enddo
#endif
end function math_3333to99
@ -753,9 +773,15 @@ pure function math_99to3333(m99)
integer :: i,j
#ifndef __INTEL_COMPILER
do concurrent(i=1:9, j=1:9)
math_99to3333(MAPPLAIN(1,i),MAPPLAIN(2,i),MAPPLAIN(1,j),MAPPLAIN(2,j)) = m99(i,j)
enddo
#else
do i=1,9; do j=1,9
math_99to3333(MAPPLAIN(1,i),MAPPLAIN(2,i),MAPPLAIN(1,j),MAPPLAIN(2,j)) = m99(i,j)
enddo; enddo
#endif
end function math_99to3333
@ -775,15 +801,22 @@ pure function math_sym3333to66(m3333,weighted)
real(pReal), dimension(6) :: w
integer :: i,j
if(present(weighted)) then
w = merge(NRMMANDEL,1.0_pReal,weighted)
else
w = NRMMANDEL
endif
#ifndef __INTEL_COMPILER
do concurrent(i=1:6, j=1:6)
math_sym3333to66(i,j) = w(i)*w(j)*m3333(MAPNYE(1,i),MAPNYE(2,i),MAPNYE(1,j),MAPNYE(2,j))
enddo
#else
do i=1,6; do j=1,6
math_sym3333to66(i,j) = w(i)*w(j)*m3333(MAPNYE(1,i),MAPNYE(2,i),MAPNYE(1,j),MAPNYE(2,j))
enddo; enddo
#endif
end function math_sym3333to66
@ -803,6 +836,7 @@ pure function math_66toSym3333(m66,weighted)
real(pReal), dimension(6) :: w
integer :: i,j
if(present(weighted)) then
w = merge(INVNRMMANDEL,1.0_pReal,weighted)
else
@ -828,6 +862,7 @@ pure function math_Voigt66to3333(m66)
real(pReal), dimension(6,6), intent(in) :: m66 !< 6x6 matrix
integer :: i,j
do i=1,6; do j=1, 6
math_Voigt66to3333(MAPVOIGT(1,i),MAPVOIGT(2,i),MAPVOIGT(1,j),MAPVOIGT(2,j)) = m66(i,j)
math_Voigt66to3333(MAPVOIGT(2,i),MAPVOIGT(1,i),MAPVOIGT(1,j),MAPVOIGT(2,j)) = m66(i,j)
@ -885,6 +920,7 @@ subroutine math_eigh(w,v,error,m)
integer :: ierr
real(pReal), dimension(size(m,1)**2) :: work
v = m ! copy matrix to input (doubles as output) array
call dsyev('V','U',size(m,1),v,size(m,1),w,work,size(work,1),ierr)
error = (ierr /= 0)
@ -1222,7 +1258,7 @@ subroutine selfTest
error stop 'math_sym33to6/math_6toSym33'
call random_number(t66)
if(any(dNeq(math_sym3333to66(math_66toSym3333(t66)),t66))) &
if(any(dNeq(math_sym3333to66(math_66toSym3333(t66)),t66,1.0e-15_pReal))) &
error stop 'math_sym3333to66/math_66toSym3333'
call random_number(v6)
@ -1242,6 +1278,9 @@ subroutine selfTest
if(dNeq(math_det33(math_symmetric33(t33)),math_detSym33(math_symmetric33(t33)),tol=1.0e-12_pReal)) &
error stop 'math_det33/math_detSym33'
if(any(dNeq(t33+transpose(t33),math_mul3333xx33(math_identity4th(),t33+transpose(t33))))) &
error stop 'math_mul3333xx33/math_identity4th'
if(any(dNeq0(math_eye(3),math_inv33(math_I3)))) &
error stop 'math_inv33(math_I3)'

178
src/mesh/DAMASK_mesh.f90
View File

@ -22,6 +22,15 @@ program DAMASK_mesh
implicit none
type :: tLoadCase
real(pReal) :: time = 0.0_pReal !< length of increment
integer :: incs = 0, & !< number of increments
outputfrequency = 1 !< frequency of result writes
logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase
integer, allocatable, dimension(:) :: faceID
type(tFieldBC), allocatable, dimension(:) :: fieldBC
end type tLoadCase
!--------------------------------------------------------------------------------------------------
! variables related to information from load case and geom file
integer, allocatable, dimension(:) :: chunkPos ! this is longer than needed for geometry parsing
@ -68,7 +77,7 @@ program DAMASK_mesh
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
type(tSolutionState), allocatable, dimension(:) :: solres
PetscInt :: faceSet, currentFaceSet, field, dimPlex
PetscInt :: faceSet, currentFaceSet, dimPlex
PetscErrorCode :: ierr
integer(kind(COMPONENT_UNDEFINED_ID)) :: ID
external :: &
@ -91,8 +100,7 @@ program DAMASK_mesh
! reading basic information from load case file and allocate data structure containing load cases
call DMGetDimension(geomMesh,dimPlex,ierr) !< dimension of mesh (2D or 3D)
CHKERRA(ierr)
nActiveFields = 1
allocate(solres(nActiveFields))
allocate(solres(1))
!--------------------------------------------------------------------------------------------------
! reading basic information from load case file and allocate data structure containing load cases
@ -103,8 +111,8 @@ program DAMASK_mesh
chunkPos = IO_stringPos(line)
do i = 1, chunkPos(1) ! reading compulsory parameters for loadcase
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
case('$loadcase')
select case (IO_stringValue(line,chunkPos,i))
case('$Loadcase')
N_def = N_def + 1
end select
enddo ! count all identifiers to allocate memory and do sanity check
@ -114,32 +122,26 @@ program DAMASK_mesh
allocate(loadCases(N_def))
do i = 1, size(loadCases)
allocate(loadCases(i)%fieldBC(nActiveFields))
field = 1
loadCases(i)%fieldBC(field)%ID = FIELD_MECH_ID
allocate(loadCases(i)%fieldBC(1))
loadCases(i)%fieldBC(1)%ID = FIELD_MECH_ID
enddo
do i = 1, size(loadCases)
do field = 1, nActiveFields
select case (loadCases(i)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
loadCases(i)%fieldBC(field)%nComponents = dimPlex !< X, Y (, Z) displacements
allocate(loadCases(i)%fieldBC(field)%componentBC(loadCases(i)%fieldBC(field)%nComponents))
do component = 1, loadCases(i)%fieldBC(field)%nComponents
select case (component)
case (1)
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_X_ID
case (2)
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_Y_ID
case (3)
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_Z_ID
end select
enddo
loadCases(i)%fieldBC(1)%nComponents = dimPlex !< X, Y (, Z) displacements
allocate(loadCases(i)%fieldBC(1)%componentBC(loadCases(i)%fieldBC(1)%nComponents))
do component = 1, loadCases(i)%fieldBC(1)%nComponents
select case (component)
case (1)
loadCases(i)%fieldBC(1)%componentBC(component)%ID = COMPONENT_MECH_X_ID
case (2)
loadCases(i)%fieldBC(1)%componentBC(component)%ID = COMPONENT_MECH_Y_ID
case (3)
loadCases(i)%fieldBC(1)%componentBC(component)%ID = COMPONENT_MECH_Z_ID
end select
do component = 1, loadCases(i)%fieldBC(field)%nComponents
allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pReal)
allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.)
enddo
enddo
do component = 1, loadCases(i)%fieldBC(1)%nComponents
allocate(loadCases(i)%fieldBC(1)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pReal)
allocate(loadCases(i)%fieldBC(1)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.)
enddo
enddo
@ -151,52 +153,45 @@ program DAMASK_mesh
chunkPos = IO_stringPos(line)
do i = 1, chunkPos(1)
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
select case (IO_stringValue(line,chunkPos,i))
!--------------------------------------------------------------------------------------------------
! loadcase information
case('$loadcase')
case('$Loadcase')
currentLoadCase = IO_intValue(line,chunkPos,i+1)
case('face')
case('Face')
currentFace = IO_intValue(line,chunkPos,i+1)
currentFaceSet = -1
do faceSet = 1, mesh_Nboundaries
if (mesh_boundaries(faceSet) == currentFace) currentFaceSet = faceSet
enddo
if (currentFaceSet < 0) call IO_error(error_ID = 837, ext_msg = 'invalid BC')
case('t','time','delta') ! increment time
case('t')
loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1)
case('n','incs','increments','steps') ! number of increments
case('N')
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1)
case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling)
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1)
loadCases(currentLoadCase)%logscale = 1
case('freq','frequency','outputfreq') ! frequency of result writings
case('f_out')
loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1)
case('guessreset','dropguessing')
case('estimate_rate')
loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
!--------------------------------------------------------------------------------------------------
! boundary condition information
case('x','y','z')
select case(IO_lc(IO_stringValue(line,chunkPos,i)))
case('x')
case('X','Y','Z')
select case(IO_stringValue(line,chunkPos,i))
case('X')
ID = COMPONENT_MECH_X_ID
case('y')
case('Y')
ID = COMPONENT_MECH_Y_ID
case('z')
case('Z')
ID = COMPONENT_MECH_Z_ID
end select
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1)
endif
enddo
do component = 1, loadcases(currentLoadCase)%fieldBC(1)%nComponents
if (loadCases(currentLoadCase)%fieldBC(1)%componentBC(component)%ID == ID) then
loadCases(currentLoadCase)%fieldBC(1)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(1)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1)
endif
enddo
end select
@ -212,21 +207,16 @@ program DAMASK_mesh
print'(a,i0)', ' load case: ', currentLoadCase
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
print'(a)', ' drop guessing along trajectory'
do field = 1, nActiveFields
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
print'(a)', ' Field '//trim(FIELD_MECH_label)
print'(a)', ' Field '//trim(FIELD_MECH_label)
end select
do faceSet = 1, mesh_Nboundaries
do component = 1, loadCases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) &
print'(a,i2,a,i2,a,f12.7)', ' Face ', mesh_boundaries(faceSet), &
' Component ', component, &
' Value ', loadCases(currentLoadCase)%fieldBC(field)% &
componentBC(component)%Value(faceSet)
enddo
enddo
do faceSet = 1, mesh_Nboundaries
do component = 1, loadCases(currentLoadCase)%fieldBC(1)%nComponents
if (loadCases(currentLoadCase)%fieldBC(1)%componentBC(component)%Mask(faceSet)) &
print'(a,i2,a,i2,a,f12.7)', ' Face ', mesh_boundaries(faceSet), &
' Component ', component, &
' Value ', loadCases(currentLoadCase)%fieldBC(1)% &
componentBC(component)%Value(faceSet)
enddo
enddo
print'(a,f12.6)', ' time: ', loadCases(currentLoadCase)%time
if (loadCases(currentLoadCase)%incs < 1) errorID = 835 ! non-positive incs count
@ -240,12 +230,7 @@ program DAMASK_mesh
!--------------------------------------------------------------------------------------------------
! doing initialization depending on active solvers
call FEM_Utilities_init
do field = 1, nActiveFields
select case (loadCases(1)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
call FEM_mechanical_init(loadCases(1)%fieldBC(field))
end select
enddo
call FEM_mechanical_init(loadCases(1)%fieldBC(1))
if (worldrank == 0) then
open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE')
@ -266,32 +251,14 @@ program DAMASK_mesh
!--------------------------------------------------------------------------------------------------
! forwarding time
timeIncOld = timeinc ! last timeinc that brought former inc to an end
if (loadCases(currentLoadCase)%logscale == 0) then ! linear scale
timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal)
else
if (currentLoadCase == 1) then ! 1st load case of logarithmic scale
if (inc == 1) then ! 1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real( 1-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
else ! not-1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1-loadCases(1)%incs ,pReal))
endif
else ! not-1st load case of logarithmic scale
timeinc = time0 * &
( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc,pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal))&
-(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1 ,pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal)))
endif
endif
timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal)
timeinc = timeinc * real(subStepFactor,pReal)**real(-cutBackLevel,pReal) ! depending on cut back level, decrease time step
stepFraction = 0 ! fraction scaled by stepFactor**cutLevel
stepFraction = 0 ! fraction scaled by stepFactor**cutLevel
subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel)
remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time
time = time + timeinc ! forward target time
stepFraction = stepFraction + 1 ! count step
time = time + timeinc ! forward target time
stepFraction = stepFraction + 1 ! count step
!--------------------------------------------------------------------------------------------------
! report begin of new step
@ -306,33 +273,16 @@ program DAMASK_mesh
'-',stepFraction, '/', subStepFactor**cutBackLevel
flush(IO_STDOUT)
!--------------------------------------------------------------------------------------------------
! forward fields
do field = 1, nActiveFields
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
call FEM_mechanical_forward (&
guess,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field))
end select
enddo
call FEM_mechanical_forward(guess,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(1))
!--------------------------------------------------------------------------------------------------
! solve fields
stagIter = 0
stagIterate = .true.
do while (stagIterate)
do field = 1, nActiveFields
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
solres(field) = FEM_mechanical_solution (&
incInfo,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field))
solres(1) = FEM_mechanical_solution(incInfo,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(1))
if(.not. solres(1)%converged) exit
end select
if(.not. solres(field)%converged) exit ! no solution found
enddo
stagIter = stagIter + 1
stagIterate = stagIter < stagItMax &
.and. all(solres(:)%converged) &

340
src/mesh/FEM_quadrature.f90
View File

@ -9,7 +9,7 @@ module FEM_quadrature
private
integer, parameter :: &
maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary)
maxOrder = 5 !< maximum integration order
real(pReal), dimension(2,3), parameter :: &
triangle = reshape([-1.0_pReal, -1.0_pReal, &
1.0_pReal, -1.0_pReal, &
@ -20,8 +20,12 @@ module FEM_quadrature
-1.0_pReal, 1.0_pReal, -1.0_pReal, &
-1.0_pReal, -1.0_pReal, 1.0_pReal], shape=[3,4])
type :: group_float !< variable length datatype
real(pReal), dimension(:), allocatable :: p
end type group_float
integer, dimension(2:3,maxOrder), public, protected :: &
FEM_nQuadrature !< number of quadrature points for a given spatial dimension(2-3) and interpolation order(1-maxOrder)
FEM_nQuadrature !< number of quadrature points for spatial dimension(2-3) and interpolation order (1-maxOrder)
type(group_float), dimension(2:3,maxOrder), public, protected :: &
FEM_quadrature_weights, & !< quadrature weights for each quadrature rule
FEM_quadrature_points !< quadrature point coordinates (in simplical system) for each quadrature rule
@ -35,145 +39,146 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief initializes FEM interpolation data
!--------------------------------------------------------------------------------------------------
subroutine FEM_quadrature_init
subroutine FEM_quadrature_init()
print'(/,a)', ' <<<+- FEM_quadrature init -+>>>'; flush(6)
print*, 'L. Zhang et al., Journal of Computational Mathematics 27(1):89-96, 2009'
print*, 'https://www.jstor.org/stable/43693493'
!--------------------------------------------------------------------------------------------------
! 2D linear
FEM_nQuadrature(2,1) = 1
allocate(FEM_quadrature_weights(2,1)%p(1))
FEM_quadrature_weights(2,1)%p(1) = 1.0_pReal
allocate(FEM_quadrature_weights(2,1)%p(FEM_nQuadrature(2,1)))
FEM_quadrature_weights(2,1)%p(1) = 1._pReal
allocate(FEM_quadrature_points (2,1)%p(2))
FEM_quadrature_points (2,1)%p(1:2) = permutationStar3([1.0_pReal/3.0_pReal])
FEM_quadrature_points (2,1)%p = permutationStar3([1._pReal/3._pReal])
!--------------------------------------------------------------------------------------------------
! 2D quadratic
FEM_nQuadrature(2,2) = 3
allocate(FEM_quadrature_weights(2,2)%p(3))
FEM_quadrature_weights(2,2)%p(1:3) = 1.0_pReal/3.0_pReal
allocate(FEM_quadrature_weights(2,2)%p(FEM_nQuadrature(2,2)))
FEM_quadrature_weights(2,2)%p(1:3) = 1._pReal/3._pReal
allocate(FEM_quadrature_points (2,2)%p(6))
FEM_quadrature_points (2,2)%p(1:6) = permutationStar21([1.0_pReal/6.0_pReal])
FEM_quadrature_points (2,2)%p = permutationStar21([1._pReal/6._pReal])
!--------------------------------------------------------------------------------------------------
! 2D cubic
FEM_nQuadrature(2,3) = 6
allocate(FEM_quadrature_weights(2,3)%p(6))
FEM_quadrature_weights(2,3)%p(1:3) = 0.22338158967801146570_pReal
FEM_quadrature_weights(2,3)%p(4:6) = 0.10995174365532186764_pReal
allocate(FEM_quadrature_weights(2,3)%p(FEM_nQuadrature(2,3)))
FEM_quadrature_weights(2,3)%p(1:3) = 2.2338158967801147e-1_pReal
FEM_quadrature_weights(2,3)%p(4:6) = 1.0995174365532187e-1_pReal
allocate(FEM_quadrature_points (2,3)%p(12))
FEM_quadrature_points (2,3)%p(1:6) = permutationStar21([0.44594849091596488632_pReal])
FEM_quadrature_points (2,3)%p(7:12)= permutationStar21([0.091576213509770743460_pReal])
FEM_quadrature_points (2,3)%p = [ &
permutationStar21([4.4594849091596489e-1_pReal]), &
permutationStar21([9.157621350977074e-2_pReal]) ]
!--------------------------------------------------------------------------------------------------
! 2D quartic
FEM_nQuadrature(2,4) = 12
allocate(FEM_quadrature_weights(2,4)%p(12))
FEM_quadrature_weights(2,4)%p(1:3) = 0.11678627572638_pReal
FEM_quadrature_weights(2,4)%p(4:6) = 0.05084490637021_pReal
FEM_quadrature_weights(2,4)%p(7:12) = 0.08285107561837_pReal
allocate(FEM_quadrature_weights(2,4)%p(FEM_nQuadrature(2,4)))
FEM_quadrature_weights(2,4)%p(1:3) = 1.1678627572637937e-1_pReal
FEM_quadrature_weights(2,4)%p(4:6) = 5.0844906370206817e-2_pReal
FEM_quadrature_weights(2,4)%p(7:12) = 8.285107561837358e-2_pReal
allocate(FEM_quadrature_points (2,4)%p(24))
FEM_quadrature_points (2,4)%p(1:6) = permutationStar21([0.24928674517091_pReal])
FEM_quadrature_points (2,4)%p(7:12) = permutationStar21([0.06308901449150_pReal])
FEM_quadrature_points (2,4)%p(13:24)= permutationStar111([0.31035245103378_pReal, 0.63650249912140_pReal])
FEM_quadrature_points (2,4)%p = [ &
permutationStar21([2.4928674517091042e-1_pReal]), &
permutationStar21([6.308901449150223e-2_pReal]), &
permutationStar111([3.1035245103378440e-1_pReal, 5.3145049844816947e-2_pReal]) ]
!--------------------------------------------------------------------------------------------------
! 2D quintic
FEM_nQuadrature(2,5) = 16
allocate(FEM_quadrature_weights(2,5)%p(16))
FEM_quadrature_weights(2,5)%p(1 ) = 0.14431560767779_pReal
FEM_quadrature_weights(2,5)%p(2:4) = 0.09509163426728_pReal
FEM_quadrature_weights(2,5)%p(5:7) = 0.10321737053472_pReal
FEM_quadrature_weights(2,5)%p(8:10) = 0.03245849762320_pReal
FEM_quadrature_weights(2,5)%p(11:16)= 0.02723031417443_pReal
allocate(FEM_quadrature_weights(2,5)%p(FEM_nQuadrature(2,5)))
FEM_quadrature_weights(2,5)%p(1:1) = 1.4431560767778717e-1_pReal
FEM_quadrature_weights(2,5)%p(2:4) = 9.509163426728463e-2_pReal
FEM_quadrature_weights(2,5)%p(5:7) = 1.0321737053471825e-1_pReal
FEM_quadrature_weights(2,5)%p(8:10) = 3.2458497623198080e-2_pReal
FEM_quadrature_weights(2,5)%p(11:16) = 2.7230314174434994e-2_pReal
allocate(FEM_quadrature_points (2,5)%p(32))
FEM_quadrature_points (2,5)%p(1:2) = permutationStar3([0.33333333333333_pReal])
FEM_quadrature_points (2,5)%p(3:8) = permutationStar21([0.45929258829272_pReal])
FEM_quadrature_points (2,5)%p(9:14) = permutationStar21([0.17056930775176_pReal])
FEM_quadrature_points (2,5)%p(15:20)= permutationStar21([0.05054722831703_pReal])
FEM_quadrature_points (2,5)%p(21:32)= permutationStar111([0.26311282963464_pReal, 0.72849239295540_pReal])
FEM_quadrature_points (2,5)%p = [ &
permutationStar3([1._pReal/3._pReal]), &
permutationStar21([4.5929258829272316e-1_pReal]), &
permutationStar21([1.705693077517602e-1_pReal]), &
permutationStar21([5.0547228317030975e-2_pReal]), &
permutationStar111([2.631128296346381e-1_pReal, 8.3947774099576053e-2_pReal]) ]
!--------------------------------------------------------------------------------------------------
! 3D linear
FEM_nQuadrature(3,1) = 1
allocate(FEM_quadrature_weights(3,1)%p(1))
FEM_quadrature_weights(3,1)%p(1) = 1.0_pReal
allocate(FEM_quadrature_weights(3,1)%p(FEM_nQuadrature(3,1)))
FEM_quadrature_weights(3,1)%p(1) = 1.0_pReal
allocate(FEM_quadrature_points (3,1)%p(3))
FEM_quadrature_points (3,1)%p(1:3)= permutationStar4([0.25_pReal])
FEM_quadrature_points (3,1)%p = permutationStar4([0.25_pReal])
!--------------------------------------------------------------------------------------------------
! 3D quadratic
FEM_nQuadrature(3,2) = 4
allocate(FEM_quadrature_weights(3,2)%p(4))
allocate(FEM_quadrature_weights(3,2)%p(FEM_nQuadrature(3,2)))
FEM_quadrature_weights(3,2)%p(1:4) = 0.25_pReal
allocate(FEM_quadrature_points (3,2)%p(12))
FEM_quadrature_points (3,2)%p(1:12)= permutationStar31([0.13819660112501051518_pReal])
FEM_quadrature_points (3,2)%p = permutationStar31([1.3819660112501052e-1_pReal])
!--------------------------------------------------------------------------------------------------
! 3D cubic
FEM_nQuadrature(3,3) = 14
allocate(FEM_quadrature_weights(3,3)%p(14))
FEM_quadrature_weights(3,3)%p(5:8) = 0.11268792571801585080_pReal
FEM_quadrature_weights(3,3)%p(1:4) = 0.073493043116361949544_pReal
FEM_quadrature_weights(3,3)%p(9:14) = 0.042546020777081466438_pReal
allocate(FEM_quadrature_weights(3,3)%p(FEM_nQuadrature(3,3)))
FEM_quadrature_weights(3,3)%p(1:4) = 7.3493043116361949e-2_pReal
FEM_quadrature_weights(3,3)%p(5:8) = 1.1268792571801585e-1_pReal
FEM_quadrature_weights(3,3)%p(9:14) = 4.2546020777081467e-2_pReal
allocate(FEM_quadrature_points (3,3)%p(42))
FEM_quadrature_points (3,3)%p(1:12) = permutationStar31([0.092735250310891226402_pReal])
FEM_quadrature_points (3,3)%p(13:24)= permutationStar31([0.31088591926330060980_pReal])
FEM_quadrature_points (3,3)%p(25:42)= permutationStar22([0.045503704125649649492_pReal])
FEM_quadrature_points (3,3)%p = [ &
permutationStar31([9.273525031089123e-2_pReal]), &
permutationStar31([3.108859192633006e-1_pReal]), &
permutationStar22([4.5503704125649649e-2_pReal]) ]
!--------------------------------------------------------------------------------------------------
! 3D quartic
! 3D quartic (lower precision/unknown source)
FEM_nQuadrature(3,4) = 35
allocate(FEM_quadrature_weights(3,4)%p(35))
FEM_quadrature_weights(3,4)%p(1:4) = 0.0021900463965388_pReal
FEM_quadrature_weights(3,4)%p(5:16) = 0.0143395670177665_pReal
FEM_quadrature_weights(3,4)%p(17:22) = 0.0250305395686746_pReal
FEM_quadrature_weights(3,4)%p(23:34) = 0.0479839333057554_pReal
FEM_quadrature_weights(3,4)%p(35) = 0.0931745731195340_pReal
allocate(FEM_quadrature_weights(3,4)%p(FEM_nQuadrature(3,4)))
FEM_quadrature_weights(3,4)%p(1:4) = 0.0021900463965388_pReal
FEM_quadrature_weights(3,4)%p(5:16) = 0.0143395670177665_pReal
FEM_quadrature_weights(3,4)%p(17:22) = 0.0250305395686746_pReal
FEM_quadrature_weights(3,4)%p(23:34) = 0.0479839333057554_pReal
FEM_quadrature_weights(3,4)%p(35) = 0.0931745731195340_pReal
allocate(FEM_quadrature_points (3,4)%p(105))
FEM_quadrature_points (3,4)%p(1:12) = permutationStar31([0.0267367755543735_pReal])
FEM_quadrature_points (3,4)%p(13:48) = permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal])
FEM_quadrature_points (3,4)%p(49:66) = permutationStar22([0.4547545999844830_pReal])
FEM_quadrature_points (3,4)%p(67:102) = permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal])
FEM_quadrature_points (3,4)%p(103:105)= permutationStar4([0.25_pReal])
FEM_quadrature_points (3,4)%p = [ &
permutationStar31([0.0267367755543735_pReal]), &
permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal]), &
permutationStar22([0.4547545999844830_pReal]), &
permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal]), &
permutationStar4([0.25_pReal]) ]
!--------------------------------------------------------------------------------------------------
! 3D quintic
! 3D quintic (lower precision/unknown source)
FEM_nQuadrature(3,5) = 56
allocate(FEM_quadrature_weights(3,5)%p(56))
FEM_quadrature_weights(3,5)%p(1:4) = 0.0010373112336140_pReal
FEM_quadrature_weights(3,5)%p(5:16) = 0.0096016645399480_pReal
FEM_quadrature_weights(3,5)%p(17:28) = 0.0164493976798232_pReal
FEM_quadrature_weights(3,5)%p(29:40) = 0.0153747766513310_pReal
FEM_quadrature_weights(3,5)%p(41:52) = 0.0293520118375230_pReal
FEM_quadrature_weights(3,5)%p(53:56) = 0.0366291366405108_pReal
allocate(FEM_quadrature_weights(3,5)%p(FEM_nQuadrature(3,5)))
FEM_quadrature_weights(3,5)%p(1:4) = 0.0010373112336140_pReal
FEM_quadrature_weights(3,5)%p(5:16) = 0.0096016645399480_pReal
FEM_quadrature_weights(3,5)%p(17:28) = 0.0164493976798232_pReal
FEM_quadrature_weights(3,5)%p(29:40) = 0.0153747766513310_pReal
FEM_quadrature_weights(3,5)%p(41:52) = 0.0293520118375230_pReal
FEM_quadrature_weights(3,5)%p(53:56) = 0.0366291366405108_pReal
allocate(FEM_quadrature_points (3,5)%p(168))
FEM_quadrature_points (3,5)%p(1:12) = permutationStar31([0.0149520651530592_pReal])
FEM_quadrature_points (3,5)%p(13:48) = permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal])
FEM_quadrature_points (3,5)%p(49:84) = permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal])
FEM_quadrature_points (3,5)%p(85:120) = permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal])
FEM_quadrature_points (3,5)%p(121:156)= permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal])
FEM_quadrature_points (3,5)%p(157:168)= permutationStar31([0.1344783347929940_pReal])
FEM_quadrature_points (3,5)%p = [ &
permutationStar31([0.0149520651530592_pReal]), &
permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal]), &
permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal]), &
permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal]), &
permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal]), &
permutationStar31([0.1344783347929940_pReal]) ]
call selfTest
end subroutine FEM_quadrature_init
@ -186,11 +191,9 @@ pure function permutationStar3(point) result(qPt)
real(pReal), dimension(2) :: qPt
real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(3,1) :: temp
temp(:,1) = [point(1), point(1), point(1)]
qPt = reshape(matmul(triangle, temp),[2])
qPt = pack(matmul(triangle,reshape([ &
point(1), point(1), point(1)],[3,1])),.true.)
end function permutationStar3
@ -203,13 +206,11 @@ pure function permutationStar21(point) result(qPt)
real(pReal), dimension(6) :: qPt
real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(3,3) :: temp
temp(:,1) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1)]
temp(:,2) = [point(1), 1.0_pReal - 2.0_pReal*point(1), point(1)]
temp(:,3) = [1.0_pReal - 2.0_pReal*point(1), point(1), point(1)]
qPt = reshape(matmul(triangle, temp),[6])
qPt = pack(matmul(triangle,reshape([ &
point(1), point(1), 1.0_pReal - 2.0_pReal*point(1), &
point(1), 1.0_pReal - 2.0_pReal*point(1), point(1), &
1.0_pReal - 2.0_pReal*point(1), point(1), point(1)],[3,3])),.true.)
end function permutationStar21
@ -222,16 +223,14 @@ pure function permutationStar111(point) result(qPt)
real(pReal), dimension(12) :: qPt
real(pReal), dimension(2), intent(in) :: point
real(pReal), dimension(3,6) :: temp
temp(:,1) = [point(1), point(2), 1.0_pReal - point(1) - point(2)]
temp(:,2) = [point(1), 1.0_pReal - point(1) - point(2), point(2)]
temp(:,3) = [point(2), point(1), 1.0_pReal - point(1) - point(2)]
temp(:,4) = [point(2), 1.0_pReal - point(1) - point(2), point(1)]
temp(:,5) = [1.0_pReal - point(1) - point(2), point(2), point(1)]
temp(:,6) = [1.0_pReal - point(1) - point(2), point(1), point(2)]
qPt = reshape(matmul(triangle, temp),[12])
qPt = pack(matmul(triangle,reshape([ &
point(1), point(2), 1.0_pReal - point(1) - point(2), &
point(1), 1.0_pReal - point(1) - point(2), point(2), &
point(2), point(1), 1.0_pReal - point(1) - point(2), &
point(2), 1.0_pReal - point(1) - point(2), point(1), &
1.0_pReal - point(1) - point(2), point(2), point(1), &
1.0_pReal - point(1) - point(2), point(1), point(2)],[3,6])),.true.)
end function permutationStar111
@ -244,11 +243,9 @@ pure function permutationStar4(point) result(qPt)
real(pReal), dimension(3) :: qPt
real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(4,1) :: temp
temp(:,1) = [point(1), point(1), point(1), point(1)]
qPt = reshape(matmul(tetrahedron, temp),[3])
qPt = pack(matmul(tetrahedron,reshape([ &
point(1), point(1), point(1), point(1)],[4,1])),.true.)
end function permutationStar4
@ -261,14 +258,12 @@ pure function permutationStar31(point) result(qPt)
real(pReal), dimension(12) :: qPt
real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(4,4) :: temp
temp(:,1) = [point(1), point(1), point(1), 1.0_pReal - 3.0_pReal*point(1)]
temp(:,2) = [point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), point(1)]
temp(:,3) = [point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), point(1)]
temp(:,4) = [1.0_pReal - 3.0_pReal*point(1), point(1), point(1), point(1)]
qPt = reshape(matmul(tetrahedron, temp),[12])
qPt = pack(matmul(tetrahedron,reshape([ &
point(1), point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), &
point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), &
point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), point(1), &
1.0_pReal - 3.0_pReal*point(1), point(1), point(1), point(1)],[4,4])),.true.)
end function permutationStar31
@ -276,21 +271,19 @@ end function permutationStar31
!--------------------------------------------------------------------------------------------------
!> @brief star 22 permutation of input
!--------------------------------------------------------------------------------------------------
pure function permutationStar22(point) result(qPt)
function permutationStar22(point) result(qPt)
real(pReal), dimension(18) :: qPt
real(pReal), dimension(1), intent(in) :: point
real(pReal), dimension(4,6) :: temp
temp(:,1) = [point(1), point(1), 0.5_pReal - point(1), 0.5_pReal - point(1)]
temp(:,2) = [point(1), 0.5_pReal - point(1), point(1), 0.5_pReal - point(1)]
temp(:,3) = [0.5_pReal - point(1), point(1), point(1), 0.5_pReal - point(1)]
temp(:,4) = [0.5_pReal - point(1), point(1), 0.5_pReal - point(1), point(1)]
temp(:,5) = [0.5_pReal - point(1), 0.5_pReal - point(1), point(1), point(1)]
temp(:,6) = [point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), point(1)]
qPt = reshape(matmul(tetrahedron, temp),[18])
qPt = pack(matmul(tetrahedron,reshape([ &
point(1), point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), &
point(1), 0.5_pReal - point(1), point(1), 0.5_pReal - point(1), &
0.5_pReal - point(1), point(1), point(1), 0.5_pReal - point(1), &
0.5_pReal - point(1), point(1), 0.5_pReal - point(1), point(1), &
0.5_pReal - point(1), 0.5_pReal - point(1), point(1), point(1), &
point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), point(1)],[4,6])),.true.)
end function permutationStar22
@ -303,22 +296,20 @@ pure function permutationStar211(point) result(qPt)
real(pReal), dimension(36) :: qPt
real(pReal), dimension(2), intent(in) :: point
real(pReal), dimension(4,12) :: temp
temp(:,1 ) = [point(1), point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
temp(:,2 ) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2)]
temp(:,3 ) = [point(1), point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
temp(:,4 ) = [point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)]
temp(:,5 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2)]
temp(:,6 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1)]
temp(:,7 ) = [point(2), point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
temp(:,8 ) = [point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)]
temp(:,9 ) = [point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1)]
temp(:,10) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), point(2)]
temp(:,11) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), point(1)]
temp(:,12) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), point(1)]
qPt = reshape(matmul(tetrahedron, temp),[36])
qPt = pack(matmul(tetrahedron,reshape([ &
point(1), point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), &
point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), &
point(1), point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), &
point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), &
point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), &
point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), &
point(2), point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), &
point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), &
point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), &
1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), point(2), &
1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), point(1), &
1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), point(1)],[4,12])),.true.)
end function permutationStar211
@ -331,35 +322,60 @@ pure function permutationStar1111(point) result(qPt)
real(pReal), dimension(72) :: qPt
real(pReal), dimension(3), intent(in) :: point
real(pReal), dimension(4,24) :: temp
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])
qPt = pack(matmul(tetrahedron,reshape([ &
point(1), point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3), &
point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3), &
point(1), point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3), &
point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2), &
point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), &
point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), &
point(2), point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3), &
point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3), &
point(2), point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3), &
point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1), &
point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(3), &
point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), &
point(3), point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), &
point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2), &
point(3), point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3), &
point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1), &
point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(2), &
point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(1), &
1.0_pReal - point(1) - point(2)- point(3), point(1), point(2), point(3), &
1.0_pReal - point(1) - point(2)- point(3), point(1), point(3), point(2), &
1.0_pReal - point(1) - point(2)- point(3), point(2), point(1), point(3), &
1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), point(1), &
1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), point(2), &
1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), point(1)],[4,24])),.true.)
end function permutationStar1111
!--------------------------------------------------------------------------------------------------
!> @brief Check correctness of quadrature weights and points.
!--------------------------------------------------------------------------------------------------
subroutine selfTest
integer :: o, d, n
real(pReal), dimension(2:3), parameter :: w = [3.0_pReal,2.0_pReal]
do d = lbound(FEM_quadrature_weights,1), ubound(FEM_quadrature_weights,1)
do o = lbound(FEM_quadrature_weights(d,:),1), ubound(FEM_quadrature_weights(d,:),1)
if (dNeq(sum(FEM_quadrature_weights(d,o)%p),1.0_pReal,5e-15_pReal)) &
error stop 'quadrature weights'
enddo
enddo
do d = lbound(FEM_quadrature_points,1), ubound(FEM_quadrature_points,1)
do o = lbound(FEM_quadrature_points(d,:),1), ubound(FEM_quadrature_points(d,:),1)
n = size(FEM_quadrature_points(d,o)%p,1)/d
if (any(dNeq(sum(reshape(FEM_quadrature_points(d,o)%p,[d,n]),2),-real(n,pReal)/w(d),1.e-14_pReal))) &
error stop 'quadrature points'
enddo
enddo
end subroutine selfTest
end module FEM_quadrature

35
src/mesh/FEM_utilities.f90
View File

@ -23,14 +23,8 @@ module FEM_utilities
implicit none
private
!--------------------------------------------------------------------------------------------------
logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
integer, public, parameter :: maxFields = 6
integer, public :: nActiveFields = 0
!--------------------------------------------------------------------------------------------------
! grid related information information
real(pReal), public :: wgt !< weighting factor 1/Nelems
logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
real(pReal), public, protected :: wgt !< weighting factor 1/Nelems
!--------------------------------------------------------------------------------------------------
@ -49,10 +43,6 @@ module FEM_utilities
COMPONENT_MECH_Z_ID
end enum
!--------------------------------------------------------------------------------------------------
! variables controlling debugging
logical :: &
debugPETSc !< use some in debug defined options for more verbose PETSc solution
!--------------------------------------------------------------------------------------------------
! derived types
@ -63,27 +53,17 @@ module FEM_utilities
end type tSolutionState
type, public :: tComponentBC
integer(kind(COMPONENT_UNDEFINED_ID)) :: ID
real(pReal), allocatable, dimension(:) :: Value
logical, allocatable, dimension(:) :: Mask
integer(kind(COMPONENT_UNDEFINED_ID)) :: ID
real(pReal), allocatable, dimension(:) :: Value
logical, allocatable, dimension(:) :: Mask
end type tComponentBC
type, public :: tFieldBC
integer(kind(FIELD_UNDEFINED_ID)) :: ID
integer :: nComponents = 0
type(tComponentBC), allocatable :: componentBC(:)
type(tComponentBC), allocatable, dimension(:) :: 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
logscale = 0 !< linear/logarithmic time inc flag
logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase
integer, allocatable, dimension(:) :: faceID
type(tFieldBC), allocatable, dimension(:) :: fieldBC
end type tLoadCase
public :: &
FEM_utilities_init, &
utilities_constitutiveResponse, &
@ -109,8 +89,9 @@ subroutine FEM_utilities_init
integer :: structOrder !< order of displacement shape functions
character(len=*), parameter :: &
PETSCDEBUG = ' -snes_view -snes_monitor '
PetscErrorCode :: ierr
logical :: debugPETSc !< use some in debug defined options for more verbose PETSc solution
print'(/,a)', ' <<<+- FEM_utilities init -+>>>'

16
src/mesh/discretization_mesh.f90
View File

@ -40,6 +40,11 @@ module discretization_mesh
mesh_maxNips !< max number of IPs in any CP element
!!!! BEGIN DEPRECATED !!!!!
DM, public :: geomMesh
PetscInt, dimension(:), allocatable, public, protected :: &
mesh_boundaries
real(pReal), dimension(:,:), allocatable :: &
mesh_ipVolume, & !< volume associated with IP (initially!)
mesh_node0 !< node x,y,z coordinates (initially!)
@ -50,11 +55,6 @@ module discretization_mesh
real(pReal), dimension(:,:,:), allocatable :: &
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!)
DM, public :: geomMesh
PetscInt, dimension(:), allocatable, public, protected :: &
mesh_boundaries
public :: &
discretization_mesh_init, &
mesh_FEM_build_ipVolumes, &
@ -71,16 +71,14 @@ subroutine discretization_mesh_init(restart)
logical, intent(in) :: restart
integer, allocatable, dimension(:) :: chunkPos
integer :: dimPlex, &
mesh_Nnodes, & !< total number of nodes in mesh
j, l, &
j, &
debug_element, debug_ip
PetscSF :: sf
DM :: globalMesh
PetscInt :: nFaceSets
PetscInt, pointer, dimension(:) :: pFaceSets
character(len=pStringLen), dimension(:), allocatable :: fileContent
IS :: faceSetIS
PetscErrorCode :: ierr
integer, dimension(:), allocatable :: &
@ -88,7 +86,7 @@ subroutine discretization_mesh_init(restart)
class(tNode), pointer :: &
num_mesh
integer :: integrationOrder !< order of quadrature rule required
type(tvec) :: coords_node0
type(tvec) :: coords_node0
print'(/,a)', ' <<<+- discretization_mesh init -+>>>'

54
src/mesh/mesh_mech_FEM.f90
View File

@ -109,7 +109,7 @@ subroutine FEM_mechanical_init(fieldBC)
character(len=*), parameter :: prefix = 'mechFE_'
PetscErrorCode :: ierr
real(pReal), dimension(3,3) :: devNull
class(tNode), pointer :: &
num_mesh
@ -258,6 +258,7 @@ subroutine FEM_mechanical_init(fieldBC)
call DMPlexVecSetClosure(mechanical_mesh,section,solution_local,cell,px_scal,5,ierr)
CHKERRQ(ierr)
enddo
call utilities_constitutiveResponse(0.0_pReal,devNull,.true.)
end subroutine FEM_mechanical_init
@ -288,8 +289,8 @@ type(tSolutionState) function FEM_mechanical_solution( &
params%timeinc = timeinc
params%fieldBC = fieldBC
call SNESSolve(mechanical_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) ! solve mechanical_snes based on solution guess (result in solution)
call SNESGetConvergedReason(mechanical_snes,reason,ierr); CHKERRQ(ierr) ! solution converged?
call SNESSolve(mechanical_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) ! solve mechanical_snes based on solution guess (result in solution)
call SNESGetConvergedReason(mechanical_snes,reason,ierr); CHKERRQ(ierr) ! solution converged?
terminallyIll = .false.
if (reason < 1) then ! 0: still iterating (will not occur), negative -> convergence error
@ -397,7 +398,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,ierr)
!--------------------------------------------------------------------------------------------------
! evaluate constitutive response
call Utilities_constitutiveResponse(params%timeinc,P_av,ForwardData)
call utilities_constitutiveResponse(params%timeinc,P_av,ForwardData)
call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,ierr)
ForwardData = .false.
@ -670,7 +671,7 @@ end subroutine FEM_mechanical_converged
!--------------------------------------------------------------------------------------------------
!> @brief Calculate current coordinates (FEM nodal coordinates only at the moment)
!> @brief Calculate current coordinates (both nodal and ip coordinates)
!--------------------------------------------------------------------------------------------------
subroutine FEM_mechanical_updateCoords()
@ -678,21 +679,35 @@ subroutine FEM_mechanical_updateCoords()
nodeCoords_linear !< nodal coordinates (dimPlex*Nnodes)
real(pReal), pointer, dimension(:,:) :: &
nodeCoords !< nodal coordinates (3,Nnodes)
real(pReal), pointer, dimension(:,:,:) :: &
ipCoords !< ip coordinates (3,nQuadrature,mesh_NcpElems)
integer :: &
qPt, &
comp, &
qOffset, &
nOffset
DM :: dm_local
Vec :: x_local
PetscErrorCode :: ierr
PetscInt :: dimPlex, pStart, pEnd, p, s, e
PetscInt :: pStart, pEnd, p, s, e, q, &
cellStart, cellEnd, c, n
PetscSection :: section
PetscQuadrature :: mechQuad
PetscReal, dimension(:), pointer :: basisField, basisFieldDer
PetscScalar, dimension(:), pointer :: x_scal
call SNESGetDM(mechanical_snes,dm_local,ierr); CHKERRQ(ierr)
call DMGetDS(dm_local,mechQuad,ierr); CHKERRQ(ierr)
call DMGetLocalSection(dm_local,section,ierr); CHKERRQ(ierr)
call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr)
call DMGetDimension(dm_local,dimPlex,ierr); CHKERRQ(ierr)
! write cell vertex displacements
call DMPlexGetDepthStratum(dm_local,0,pStart,pEnd,ierr); CHKERRQ(ierr)
allocate(nodeCoords(3,pStart:pEnd-1),source=0.0_pReal)
call VecGetArrayF90(x_local,nodeCoords_linear,ierr); CHKERRQ(ierr)
do p=pStart, pEnd-1
call DMPlexGetPointLocal(dm_local, p, s, e, ierr); CHKERRQ(ierr)
nodeCoords(1:dimPlex,p)=nodeCoords_linear(s+1:e)
@ -700,6 +715,31 @@ subroutine FEM_mechanical_updateCoords()
call discretization_setNodeCoords(nodeCoords)
call VecRestoreArrayF90(x_local,nodeCoords_linear,ierr); CHKERRQ(ierr)
! write ip displacements
call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr); CHKERRQ(ierr)
call PetscDSGetTabulation(mechQuad,0,basisField,basisFieldDer,ierr); CHKERRQ(ierr)
allocate(ipCoords(3,nQuadrature,mesh_NcpElems),source=0.0_pReal)
do c=cellStart,cellEnd-1
qOffset=0
call DMPlexVecGetClosure(dm_local,section,x_local,c,x_scal,ierr); CHKERRQ(ierr) !< get nodal coordinates of each element
do qPt=0,nQuadrature-1
qOffset= qPt * (size(basisField)/nQuadrature)
do comp=0,dimPlex-1 !< loop over components
nOffset=0
q = comp
do n=0,nBasis-1
ipCoords(comp+1,qPt+1,c+1)=ipCoords(comp+1,qPt+1,c+1)+&
sum(basisField(qOffset+(q*dimPlex)+1:qOffset+(q*dimPlex)+dimPlex)*&
x_scal(nOffset+1:nOffset+dimPlex))
q = q+dimPlex
nOffset = nOffset+dimPlex
enddo
enddo
enddo
call DMPlexVecRestoreClosure(dm_local,section,x_local,c,x_scal,ierr); CHKERRQ(ierr)
end do
call discretization_setIPcoords(reshape(ipCoords,[3,mesh_NcpElems*nQuadrature]))
call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr)
end subroutine FEM_mechanical_updateCoords

34
src/parallelization.f90
View File

@ -24,9 +24,18 @@ module parallelization
worldrank = 0, & !< MPI worldrank (/=0 for MPI simulations only)
worldsize = 1 !< MPI worldsize (/=1 for MPI simulations only)
#ifdef PETSC
#ifndef PETSC
public :: parallelization_bcast_str
contains
subroutine parallelization_bcast_str(string)
character(len=:), allocatable, intent(inout) :: string
end subroutine parallelization_bcast_str
#else
public :: &
parallelization_init
parallelization_init, &
parallelization_bcast_str
contains
@ -101,6 +110,27 @@ subroutine parallelization_init
!$ call omp_set_num_threads(OMP_NUM_THREADS)
end subroutine parallelization_init
!--------------------------------------------------------------------------------------------------
!> @brief Broadcast a string from process 0.
!--------------------------------------------------------------------------------------------------
subroutine parallelization_bcast_str(string)
character(len=:), allocatable, intent(inout) :: string
integer :: strlen, ierr ! pI64 for strlen not supported by MPI
if (worldrank == 0) strlen = len(string)
call MPI_Bcast(strlen,1,MPI_INTEGER,0,MPI_COMM_WORLD, ierr)
if (worldrank /= 0) allocate(character(len=strlen)::string)
call MPI_Bcast(string,strlen,MPI_CHARACTER,0,MPI_COMM_WORLD, ierr)
end subroutine parallelization_bcast_str
#endif
end module parallelization

24
src/phase.f90
View File

@ -26,12 +26,8 @@ module phase
real(pReal), allocatable, dimension(:) :: phase_rho
type(tRotationContainer), dimension(:), allocatable :: &
phase_orientation0, &
phase_orientation
type :: tTensorContainer
real(pReal), dimension(:,:,:), allocatable :: data
end type
phase_O_0, &
phase_O
type :: tNumerics
integer :: &
@ -364,7 +360,7 @@ subroutine phase_init
allocate(phase_lattice(phases%length))
allocate(phase_cOverA(phases%length),source=-1.0_pReal)
allocate(phase_rho(phases%length))
allocate(phase_orientation0(phases%length))
allocate(phase_O_0(phases%length))
do ph = 1,phases%length
phase => phases%get(ph)
@ -374,20 +370,20 @@ subroutine phase_init
if (any(phase_lattice(ph) == ['hP','tI'])) &
phase_cOverA(ph) = phase%get_asFloat('c/a')
phase_rho(ph) = phase%get_asFloat('rho',defaultVal=0.0_pReal)
allocate(phase_orientation0(ph)%data(count(material_phaseID==ph)))
allocate(phase_O_0(ph)%data(count(material_phaseID==ph)))
enddo
do ce = 1, size(material_phaseID,2)
ma = discretization_materialAt((ce-1)/discretization_nIPs+1)
do co = 1,homogenization_Nconstituents(material_homogenizationID(ce))
ph = material_phaseID(co,ce)
phase_orientation0(ph)%data(material_phaseEntry(co,ce)) = material_orientation0(ma)%data(co)
phase_O_0(ph)%data(material_phaseEntry(co,ce)) = material_O_0(ma)%data(co)
enddo
enddo
allocate(phase_orientation(phases%length))
allocate(phase_O(phases%length))
do ph = 1,phases%length
phase_orientation(ph)%data = phase_orientation0(ph)%data
phase_O(ph)%data = phase_O_0(ph)%data
enddo
call mechanical_init(materials,phases)
@ -577,10 +573,10 @@ subroutine crystallite_orientations(co,ip,el)
ph = material_phaseID(co,(el-1)*discretization_nIPs + ip)
en = material_phaseEntry(co,(el-1)*discretization_nIPs + ip)
call phase_orientation(ph)%data(en)%fromMatrix(transpose(math_rotationalPart(mechanical_F_e(ph,en))))
call phase_O(ph)%data(en)%fromMatrix(transpose(math_rotationalPart(mechanical_F_e(ph,en))))
if (plasticState(material_phaseAt(1,el))%nonlocal) &
call plastic_nonlocal_updateCompatibility(phase_orientation,material_phaseAt(1,el),ip,el)
call plastic_nonlocal_updateCompatibility(phase_O,material_phaseAt(1,el),ip,el)
end subroutine crystallite_orientations
@ -602,7 +598,7 @@ function crystallite_push33ToRef(co,ce, tensor33)
ph = material_phaseID(co,ce)
en = material_phaseEntry(co,ce)
T = matmul(phase_orientation0(ph)%data(en)%asMatrix(),transpose(math_inv33(phase_F(co,ce)))) ! ToDo: initial orientation correct?
T = matmul(phase_O_0(ph)%data(en)%asMatrix(),transpose(math_inv33(phase_F(co,ce)))) ! ToDo: initial orientation correct?
crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T))

54
src/phase_mechanical.f90
View File

@ -229,8 +229,8 @@ module subroutine mechanical_init(materials,phases)
allocate(phase_mechanical_F0(phases%length))
allocate(phase_mechanical_Li(phases%length))
allocate(phase_mechanical_Li0(phases%length))
allocate(phase_mechanical_Lp0(phases%length))
allocate(phase_mechanical_Lp(phases%length))
allocate(phase_mechanical_Lp0(phases%length))
allocate(phase_mechanical_S(phases%length))
allocate(phase_mechanical_P(phases%length))
allocate(phase_mechanical_S0(phases%length))
@ -238,20 +238,20 @@ module subroutine mechanical_init(materials,phases)
do ph = 1, phases%length
Nmembers = count(material_phaseID == ph)
allocate(phase_mechanical_Fi(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_Fe(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_Fi(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_Fi0(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_Fp(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_Fp0(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_Li(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_Li0(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_Lp0(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_Lp(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_F(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_F0(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_Li(ph)%data(3,3,Nmembers),source=0.0_pReal)
allocate(phase_mechanical_Li0(ph)%data(3,3,Nmembers),source=0.0_pReal)
allocate(phase_mechanical_Lp(ph)%data(3,3,Nmembers),source=0.0_pReal)
allocate(phase_mechanical_Lp0(ph)%data(3,3,Nmembers),source=0.0_pReal)
allocate(phase_mechanical_S(ph)%data(3,3,Nmembers),source=0.0_pReal)
allocate(phase_mechanical_P(ph)%data(3,3,Nmembers),source=0.0_pReal)
allocate(phase_mechanical_S0(ph)%data(3,3,Nmembers),source=0.0_pReal)
allocate(phase_mechanical_F(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_F0(ph)%data(3,3,Nmembers))
phase => phases%get(ph)
mech => phase%get('mechanical')
@ -265,7 +265,7 @@ module subroutine mechanical_init(materials,phases)
do ph = 1, phases%length
do en = 1, count(material_phaseID == ph)
phase_mechanical_Fp0(ph)%data(1:3,1:3,en) = phase_orientation0(ph)%data(en)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005)
phase_mechanical_Fp0(ph)%data(1:3,1:3,en) = phase_O_0(ph)%data(en)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005)
phase_mechanical_Fp0(ph)%data(1:3,1:3,en) = phase_mechanical_Fp0(ph)%data(1:3,1:3,en) &
/ math_det33(phase_mechanical_Fp0(ph)%data(1:3,1:3,en))**(1.0_pReal/3.0_pReal)
phase_mechanical_Fi0(ph)%data(1:3,1:3,en) = math_I3
@ -508,7 +508,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken)
enddo LpLoop
call phase_LiAndItsTangents(Li_constitutive, dLi_dS, dLi_dFi, &
S, Fi_new, ph,en)
S, Fi_new, ph,en)
!* update current residuum and check for convergence of loop
atol_Li = max(num%rtol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error
@ -902,7 +902,6 @@ subroutine crystallite_results(group,ph)
integer, intent(in) :: ph
integer :: ou
real(pReal), allocatable, dimension(:,:) :: selected_rotations
call results_closeGroup(results_addGroup(group//'/mechanical'))
@ -935,8 +934,7 @@ subroutine crystallite_results(group,ph)
call results_writeDataset(phase_mechanical_S(ph)%data,group//'/mechanical/','S', &
'second Piola-Kirchhoff stress','Pa')
case('O')
selected_rotations = select_rotations(phase_orientation(ph)%data)
call results_writeDataset(selected_rotations,group//'/mechanical',output_constituent(ph)%label(ou),&
call results_writeDataset(to_quaternion(phase_O(ph)%data),group//'/mechanical',output_constituent(ph)%label(ou),&
'crystal orientation as quaternion','q_0 (q_1 q_2 q_3)')
call results_addAttribute('lattice',phase_lattice(ph),group//'/mechanical/'//output_constituent(ph)%label(ou))
if (any(phase_lattice(ph) == ['hP', 'tI'])) &
@ -948,19 +946,21 @@ subroutine crystallite_results(group,ph)
contains
!--------------------------------------------------------------------------------------------------
!> @brief Convert orientation for output: ToDo: implement in HDF5/results
!> @brief Convert orientation array to quaternion array
!--------------------------------------------------------------------------------------------------
function select_rotations(dataset)
function to_quaternion(dataset)
type(rotation), dimension(:), intent(in) :: dataset
real(pReal), dimension(4,size(dataset,1)) :: select_rotations
integer :: en
real(pReal), dimension(4,size(dataset,1)) :: to_quaternion
do en = 1, size(dataset,1)
select_rotations(:,en) = dataset(en)%asQuaternion()
enddo
integer :: i
end function select_rotations
do i = 1, size(dataset,1)
to_quaternion(:,i) = dataset(i)%asQuaternion()
enddo
end function to_quaternion
end subroutine crystallite_results
@ -1021,7 +1021,7 @@ module function phase_mechanical_constitutive(Delta_t,co,ip,el) result(converged
subLi0 = phase_mechanical_Li0(ph)%data(1:3,1:3,en)
subLp0 = phase_mechanical_Lp0(ph)%data(1:3,1:3,en)
subState0 = plasticState(ph)%State0(:,en)
allocate(subState0,source=plasticState(ph)%State0(:,en))
subFp0 = phase_mechanical_Fp0(ph)%data(1:3,1:3,en)
subFi0 = phase_mechanical_Fi0(ph)%data(1:3,1:3,en)
subF0 = phase_mechanical_F0(ph)%data(1:3,1:3,en)
@ -1144,12 +1144,12 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
en = material_phaseEntry(co,ce)
call phase_hooke_SandItsTangents(devNull,dSdFe,dSdFi, &
phase_mechanical_Fe(ph)%data(1:3,1:3,en), &
phase_mechanical_Fi(ph)%data(1:3,1:3,en),ph,en)
phase_mechanical_Fe(ph)%data(1:3,1:3,en), &
phase_mechanical_Fi(ph)%data(1:3,1:3,en),ph,en)
call phase_LiAndItsTangents(devNull,dLidS,dLidFi, &
phase_mechanical_S(ph)%data(1:3,1:3,en), &
phase_mechanical_Fi(ph)%data(1:3,1:3,en), &
ph,en)
phase_mechanical_S(ph)%data(1:3,1:3,en), &
phase_mechanical_Fi(ph)%data(1:3,1:3,en), &
ph,en)
invFp = math_inv33(phase_mechanical_Fp(ph)%data(1:3,1:3,en))
invFi = math_inv33(phase_mechanical_Fi(ph)%data(1:3,1:3,en))

77
src/phase_mechanical_plastic_dislotungsten.f90
View File

@ -18,7 +18,7 @@ submodule(phase:plastic) dislotungsten
Q_cl = 1.0_pReal !< activation energy for dislocation climb
real(pReal), allocatable, dimension(:) :: &
b_sl, & !< magnitude of Burgers vector [m]
D_a, &
d_caron, & !< distance of spontaneous annhihilation
i_sl, & !< Adj. parameter for distance between 2 forest dislocations
f_at, & !< factor to calculate atomic volume
tau_Peierls, & !< Peierls stress
@ -56,7 +56,7 @@ submodule(phase:plastic) dislotungsten
type :: tDisloTungstendependentState
real(pReal), dimension(:,:), allocatable :: &
Lambda_sl, &
threshold_stress
tau_pass
end type tDisloTungstendependentState
!--------------------------------------------------------------------------------------------------
@ -172,7 +172,6 @@ module function plastic_dislotungsten_init() result(myPlasticity)
prm%D_0 = pl%get_asFloat('D_0')
prm%Q_cl = pl%get_asFloat('Q_cl')
prm%f_at = pl%get_asFloat('f_at') * prm%b_sl**3.0_pReal
prm%D_a = pl%get_asFloat('D_a') * prm%b_sl
prm%dipoleformation = .not. pl%get_asBool('no_dipole_formation', defaultVal = .false.)
@ -191,7 +190,7 @@ module function plastic_dislotungsten_init() result(myPlasticity)
prm%B = math_expand(prm%B, N_sl)
prm%i_sl = math_expand(prm%i_sl, N_sl)
prm%f_at = math_expand(prm%f_at, N_sl)
prm%D_a = math_expand(prm%D_a, N_sl)
prm%d_caron = pl%get_asFloat('D_a') * prm%b_sl
! sanity checks
if ( prm%D_0 <= 0.0_pReal) extmsg = trim(extmsg)//' D_0'
@ -202,12 +201,13 @@ module function plastic_dislotungsten_init() result(myPlasticity)
if (any(prm%b_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' b_sl'
if (any(prm%Q_s <= 0.0_pReal)) extmsg = trim(extmsg)//' Q_s'
if (any(prm%tau_Peierls < 0.0_pReal)) extmsg = trim(extmsg)//' tau_Peierls'
if (any(prm%D_a <= 0.0_pReal)) extmsg = trim(extmsg)//' D_a or b_sl'
if (any(prm%B < 0.0_pReal)) extmsg = trim(extmsg)//' B'
if (any(prm%d_caron < 0.0_pReal)) extmsg = trim(extmsg)//' d_caron(D_a,b_sl)'
if (any(prm%f_at <= 0.0_pReal)) extmsg = trim(extmsg)//' f_at or b_sl'
else slipActive
rho_mob_0= emptyRealArray; rho_dip_0 = emptyRealArray
allocate(prm%b_sl,prm%D_a,prm%i_sl,prm%f_at,prm%tau_Peierls, &
allocate(prm%b_sl,prm%d_caron,prm%i_sl,prm%f_at,prm%tau_Peierls, &
prm%Q_s,prm%v_0,prm%p,prm%q,prm%B,prm%h,prm%w,prm%omega, &
source = emptyRealArray)
allocate(prm%forestProjection(0,0))
@ -246,8 +246,8 @@ module function plastic_dislotungsten_init() result(myPlasticity)
plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal)
if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers), source=0.0_pReal)
allocate(dst%threshold_stress(prm%sum_N_sl,Nmembers), source=0.0_pReal)
allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers), source=0.0_pReal)
allocate(dst%tau_pass(prm%sum_N_sl,Nmembers), source=0.0_pReal)
end associate
@ -316,8 +316,6 @@ module subroutine dislotungsten_dotState(Mp,T,ph,en)
ph, &
en
real(pReal) :: &
VacancyDiffusion
real(pReal), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos, dot_gamma_neg,&
tau_pos,&
@ -325,38 +323,36 @@ module subroutine dislotungsten_dotState(Mp,T,ph,en)
v_cl, &
dot_rho_dip_formation, &
dot_rho_dip_climb, &
dip_distance
d_hat
associate(prm => param(ph), stt => state(ph),&
dot => dotState(ph), dst => dependentState(ph))
associate(prm => param(ph), stt => state(ph), dot => dotState(ph), dst => dependentState(ph))
call kinetics(Mp,T,ph,en,&
dot_gamma_pos,dot_gamma_neg, &
tau_pos_out = tau_pos,tau_neg_out = tau_neg)
dot%gamma_sl(:,en) = (dot_gamma_pos+dot_gamma_neg) ! ToDo: needs to be abs
VacancyDiffusion = prm%D_0*exp(-prm%Q_cl/(kB*T))
dot%gamma_sl(:,en) = abs(dot_gamma_pos+dot_gamma_neg)
where(dEq0(tau_pos)) ! ToDo: use avg of pos and neg
where(dEq0(tau_pos)) ! ToDo: use avg of +/-
dot_rho_dip_formation = 0.0_pReal
dot_rho_dip_climb = 0.0_pReal
else where
dip_distance = math_clip(3.0_pReal*prm%mu*prm%b_sl/(16.0_pReal*PI*abs(tau_pos)), &
prm%D_a, & ! lower limit
dst%Lambda_sl(:,en)) ! upper limit
dot_rho_dip_formation = merge(2.0_pReal*dip_distance* stt%rho_mob(:,en)*abs(dot%gamma_sl(:,en))/prm%b_sl, & ! ToDo: ignore region of spontaneous annihilation
d_hat = math_clip(3.0_pReal*prm%mu*prm%b_sl/(16.0_pReal*PI*abs(tau_pos)), & ! ToDo: use avg of +/-
prm%d_caron, & ! lower limit
dst%Lambda_sl(:,en)) ! upper limit
dot_rho_dip_formation = merge(2.0_pReal*(d_hat-prm%d_caron)*stt%rho_mob(:,en)*dot%gamma_sl(:,en)/prm%b_sl, &
0.0_pReal, &
prm%dipoleformation)
v_cl = (3.0_pReal*prm%mu*VacancyDiffusion*prm%f_at/(2.0_pReal*pi*kB*T)) &
* (1.0_pReal/(dip_distance+prm%D_a))
dot_rho_dip_climb = (4.0_pReal*v_cl*stt%rho_dip(:,en))/(dip_distance-prm%D_a) ! ToDo: Discuss with Franz: Stress dependency?
v_cl = (3.0_pReal*prm%mu*prm%D_0*exp(-prm%Q_cl/(kB*T))*prm%f_at/(2.0_pReal*PI*kB*T)) &
* (1.0_pReal/(d_hat+prm%d_caron))
dot_rho_dip_climb = (4.0_pReal*v_cl*stt%rho_dip(:,en))/(d_hat-prm%d_caron) ! ToDo: Discuss with Franz: Stress dependency?
end where
dot%rho_mob(:,en) = abs(dot%gamma_sl(:,en))/(prm%b_sl*dst%Lambda_sl(:,en)) & ! multiplication
dot%rho_mob(:,en) = dot%gamma_sl(:,en)/(prm%b_sl*dst%Lambda_sl(:,en)) & ! multiplication
- dot_rho_dip_formation &
- (2.0_pReal*prm%D_a)/prm%b_sl*stt%rho_mob(:,en)*abs(dot%gamma_sl(:,en)) ! Spontaneous annihilation of 2 single edge dislocations
- (2.0_pReal*prm%d_caron)/prm%b_sl*stt%rho_mob(:,en)*dot%gamma_sl(:,en) ! Spontaneous annihilation of 2 edges
dot%rho_dip(:,en) = dot_rho_dip_formation &
- (2.0_pReal*prm%D_a)/prm%b_sl*stt%rho_dip(:,en)*abs(dot%gamma_sl(:,en)) & ! Spontaneous annihilation of a single edge dislocation with a dipole constituent
- (2.0_pReal*prm%d_caron)/prm%b_sl*stt%rho_dip(:,en)*dot%gamma_sl(:,en) & ! Spontaneous annihilation of an edge with a dipole
- dot_rho_dip_climb
end associate
@ -377,11 +373,11 @@ module subroutine dislotungsten_dependentState(ph,en)
dislocationSpacing
associate(prm => param(ph), stt => state(ph),dst => dependentState(ph))
associate(prm => param(ph), stt => state(ph), dst => dependentState(ph))
dislocationSpacing = sqrt(matmul(prm%forestProjection,stt%rho_mob(:,en)+stt%rho_dip(:,en)))
dst%threshold_stress(:,en) = prm%mu*prm%b_sl &
* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,en)+stt%rho_dip(:,en)))
dst%tau_pass(:,en) = prm%mu*prm%b_sl &
* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,en)+stt%rho_dip(:,en)))
dst%Lambda_sl(:,en) = prm%D/(1.0_pReal+prm%D*dislocationSpacing/prm%i_sl)
@ -416,7 +412,7 @@ module subroutine plastic_dislotungsten_results(ph,group)
if(prm%sum_N_sl>0) call results_writeDataset(dst%Lambda_sl,group,trim(prm%output(o)), &
'mean free path for slip','m')
case('tau_pass')
if(prm%sum_N_sl>0) call results_writeDataset(dst%threshold_stress,group,trim(prm%output(o)), &
if(prm%sum_N_sl>0) call results_writeDataset(dst%tau_pass,group,trim(prm%output(o)), &
'threshold stress for slip','Pa')
end select
enddo outputsLoop
@ -456,8 +452,7 @@ pure subroutine kinetics(Mp,T,ph,en, &
StressRatio_p,StressRatio_pminus1, &
dvel, vel, &
tau_pos,tau_neg, &
t_n, t_k, dtk,dtn, &
needsGoodName ! ToDo: @Karo: any idea?
t_n, t_k, dtk,dtn
integer :: j
associate(prm => param(ph), stt => state(ph), dst => dependentState(ph))
@ -475,13 +470,12 @@ pure subroutine kinetics(Mp,T,ph,en, &
dot_gamma_0 => stt%rho_mob(:,en)*prm%b_sl*prm%v_0, &
effectiveLength => dst%Lambda_sl(:,en) - prm%w)
significantPositiveTau: where(abs(tau_pos)-dst%threshold_stress(:,en) > tol_math_check)
StressRatio = (abs(tau_pos)-dst%threshold_stress(:,en))/prm%tau_Peierls
significantPositiveTau: where(abs(tau_pos)-dst%tau_pass(:,en) > tol_math_check)
StressRatio = (abs(tau_pos)-dst%tau_pass(:,en))/prm%tau_Peierls
StressRatio_p = StressRatio** prm%p
StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal)
needsGoodName = exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q)
t_n = prm%b_sl/(needsGoodName*prm%omega*effectiveLength)
t_n = prm%b_sl/(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q)*prm%omega*effectiveLength)
t_k = effectiveLength * prm%B /(2.0_pReal*prm%b_sl*tau_pos)
vel = prm%h/(t_n + t_k)
@ -492,7 +486,7 @@ pure subroutine kinetics(Mp,T,ph,en, &
end where significantPositiveTau
if (present(ddot_gamma_dtau_pos)) then
significantPositiveTau2: where(abs(tau_pos)-dst%threshold_stress(:,en) > tol_math_check)
significantPositiveTau2: where(abs(tau_pos)-dst%tau_pass(:,en) > tol_math_check)
dtn = -1.0_pReal * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pReal-StressRatio_p)**(prm%q - 1.0_pReal) &
* (StressRatio)**(prm%p - 1.0_pReal) / prm%tau_Peierls
dtk = -1.0_pReal * t_k / tau_pos
@ -505,13 +499,12 @@ pure subroutine kinetics(Mp,T,ph,en, &
end where significantPositiveTau2
endif
significantNegativeTau: where(abs(tau_neg)-dst%threshold_stress(:,en) > tol_math_check)
StressRatio = (abs(tau_neg)-dst%threshold_stress(:,en))/prm%tau_Peierls
significantNegativeTau: where(abs(tau_neg)-dst%tau_pass(:,en) > tol_math_check)
StressRatio = (abs(tau_neg)-dst%tau_pass(:,en))/prm%tau_Peierls
StressRatio_p = StressRatio** prm%p
StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal)
needsGoodName = exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q)
t_n = prm%b_sl/(needsGoodName*prm%omega*effectiveLength)
t_n = prm%b_sl/(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q)*prm%omega*effectiveLength)
t_k = effectiveLength * prm%B /(2.0_pReal*prm%b_sl*tau_pos)
vel = prm%h/(t_n + t_k)
@ -522,7 +515,7 @@ pure subroutine kinetics(Mp,T,ph,en, &
end where significantNegativeTau
if (present(ddot_gamma_dtau_neg)) then
significantNegativeTau2: where(abs(tau_neg)-dst%threshold_stress(:,en) > tol_math_check)
significantNegativeTau2: where(abs(tau_neg)-dst%tau_pass(:,en) > tol_math_check)
dtn = -1.0_pReal * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pReal-StressRatio_p)**(prm%q - 1.0_pReal) &
* (StressRatio)**(prm%p - 1.0_pReal) / prm%tau_Peierls
dtk = -1.0_pReal * t_k / tau_neg

286
src/phase_mechanical_plastic_dislotwin.f90
View File

@ -16,13 +16,11 @@ submodule(phase:plastic) dislotwin
real(pReal) :: &
mu = 1.0_pReal, & !< equivalent shear modulus
nu = 1.0_pReal, & !< equivalent shear Poisson's ratio
D_0 = 1.0_pReal, & !< prefactor for self-diffusion coefficient
Q_cl = 1.0_pReal, & !< activation energy for dislocation climb
omega = 1.0_pReal, & !< frequency factor for dislocation climb
D = 1.0_pReal, & !< grain size
p_sb = 1.0_pReal, & !< p-exponent in shear band velocity
q_sb = 1.0_pReal, & !< q-exponent in shear band velocity
D_a = 1.0_pReal, & !< adjustment parameter to calculate minimum dipole distance
i_tw = 1.0_pReal, & !< adjustment parameter to calculate MFP for twinning
L_tw = 1.0_pReal, & !< Length of twin nuclei in Burgers vectors
L_tr = 1.0_pReal, & !< Length of trans nuclei in Burgers vectors
@ -42,7 +40,7 @@ submodule(phase:plastic) dislotwin
b_sl, & !< absolute length of Burgers vector [m] for each slip system
b_tw, & !< absolute length of Burgers vector [m] for each twin system
b_tr, & !< absolute length of Burgers vector [m] for each transformation system
Q_s,& !< activation energy for glide [J] for each slip system
Q_sl,& !< activation energy for glide [J] for each slip system
v_0, & !< dislocation velocity prefactor [m/s] for each slip system
dot_N_0_tw, & !< twin nucleation rate [1/m³s] for each twin system
dot_N_0_tr, & !< trans nucleation rate [1/m³s] for each trans system
@ -55,7 +53,8 @@ submodule(phase:plastic) dislotwin
s, & !< s-exponent in trans nucleation rate
tau_0, & !< strength due to elements in solid solution
gamma_char, & !< characteristic shear for twins
B !< drag coefficient
B, & !< drag coefficient
d_caron !< distance of spontaneous annhihilation
real(pReal), allocatable, dimension(:,:) :: &
h_sl_sl, & !< components of slip-slip interaction matrix
h_sl_tw, & !< components of slip-twin interaction matrix
@ -206,7 +205,7 @@ module function plastic_dislotwin_init() result(myPlasticity)
rho_dip_0 = pl%get_as1dFloat('rho_dip_0', requiredSize=size(N_sl))
prm%v_0 = pl%get_as1dFloat('v_0', requiredSize=size(N_sl))
prm%b_sl = pl%get_as1dFloat('b_sl', requiredSize=size(N_sl))
prm%Q_s = pl%get_as1dFloat('Q_s', requiredSize=size(N_sl))
prm%Q_sl = pl%get_as1dFloat('Q_sl', requiredSize=size(N_sl))
prm%i_sl = pl%get_as1dFloat('i_sl', requiredSize=size(N_sl))
prm%p = pl%get_as1dFloat('p_sl', requiredSize=size(N_sl))
prm%q = pl%get_as1dFloat('q_sl', requiredSize=size(N_sl))
@ -214,9 +213,7 @@ module function plastic_dislotwin_init() result(myPlasticity)
prm%B = pl%get_as1dFloat('B', requiredSize=size(N_sl), &
defaultVal=[(0.0_pReal, i=1,size(N_sl))])
prm%D_a = pl%get_asFloat('D_a')
prm%D_0 = pl%get_asFloat('D_0')
prm%Q_cl = pl%get_asFloat('Q_cl')
prm%Q_cl = pl%get_asFloat('Q_cl')
prm%ExtendedDislocations = pl%get_asBool('extend_dislocations',defaultVal = .false.)
prm%omitDipoles = pl%get_asBool('omit_dipoles',defaultVal = .false.)
@ -231,28 +228,29 @@ module function plastic_dislotwin_init() result(myPlasticity)
rho_dip_0 = math_expand(rho_dip_0, N_sl)
prm%v_0 = math_expand(prm%v_0, N_sl)
prm%b_sl = math_expand(prm%b_sl, N_sl)
prm%Q_s = math_expand(prm%Q_s, N_sl)
prm%Q_sl = math_expand(prm%Q_sl, N_sl)
prm%i_sl = math_expand(prm%i_sl, N_sl)
prm%p = math_expand(prm%p, N_sl)
prm%q = math_expand(prm%q, N_sl)
prm%tau_0 = math_expand(prm%tau_0, N_sl)
prm%B = math_expand(prm%B, N_sl)
prm%d_caron = pl%get_asFloat('D_a') * prm%b_sl
! sanity checks
if ( prm%D_0 <= 0.0_pReal) extmsg = trim(extmsg)//' D_0'
if ( prm%Q_cl <= 0.0_pReal) extmsg = trim(extmsg)//' Q_cl'
if (any(rho_mob_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_mob_0'
if (any(rho_dip_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_dip_0'
if (any(prm%v_0 < 0.0_pReal)) extmsg = trim(extmsg)//' v_0'
if (any(prm%b_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' b_sl'
if (any(prm%Q_s <= 0.0_pReal)) extmsg = trim(extmsg)//' Q_s'
if (any(prm%Q_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' Q_sl'
if (any(prm%i_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' i_sl'
if (any(prm%B < 0.0_pReal)) extmsg = trim(extmsg)//' B'
if (any(prm%d_caron < 0.0_pReal)) extmsg = trim(extmsg)//' d_caron(D_a,b_sl)'
if (any(prm%p<=0.0_pReal .or. prm%p>1.0_pReal)) extmsg = trim(extmsg)//' p_sl'
if (any(prm%q< 1.0_pReal .or. prm%q>2.0_pReal)) extmsg = trim(extmsg)//' q_sl'
else slipActive
rho_mob_0 = emptyRealArray; rho_dip_0 = emptyRealArray
allocate(prm%b_sl,prm%Q_s,prm%v_0,prm%i_sl,prm%p,prm%q,prm%B,source=emptyRealArray)
allocate(prm%b_sl,prm%Q_sl,prm%v_0,prm%i_sl,prm%p,prm%q,prm%B,source=emptyRealArray)
allocate(prm%forestProjection(0,0),prm%h_sl_sl(0,0))
endif slipActive
@ -516,7 +514,7 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,ph,en)
integer :: i,k,l,m,n
real(pReal) :: &
f_unrotated,StressRatio_p,&
BoltzmannRatio, &
E_kB_T, &
ddot_gamma_dtau, &
tau
real(pReal), dimension(param(ph)%sum_N_sl) :: &
@ -586,7 +584,7 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,ph,en)
shearBandingContribution: if(dNeq0(prm%v_sb)) then
BoltzmannRatio = prm%E_sb/(kB*T)
E_kB_T = prm%E_sb/(kB*T)
call math_eigh33(eigValues,eigVectors,Mp) ! is Mp symmetric by design?
do i = 1,6
@ -596,8 +594,8 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,ph,en)
significantShearBandStress: if (abs(tau) > tol_math_check) then
StressRatio_p = (abs(tau)/prm%xi_sb)**prm%p_sb
dot_gamma_sb = sign(prm%v_sb*exp(-BoltzmannRatio*(1-StressRatio_p)**prm%q_sb), tau)
ddot_gamma_dtau = abs(dot_gamma_sb)*BoltzmannRatio* prm%p_sb*prm%q_sb/ prm%xi_sb &
dot_gamma_sb = sign(prm%v_sb*exp(-E_kB_T*(1-StressRatio_p)**prm%q_sb), tau)
ddot_gamma_dtau = abs(dot_gamma_sb)*E_kB_T*prm%p_sb*prm%q_sb/prm%xi_sb &
* (abs(tau)/prm%xi_sb)**(prm%p_sb-1.0_pReal) &
* (1.0_pReal-StressRatio_p)**(prm%q_sb-1.0_pReal)
@ -631,7 +629,7 @@ module subroutine dislotwin_dotState(Mp,T,ph,en)
integer :: i
real(pReal) :: &
f_unrotated, &
rho_dip_distance, &
d_hat, &
v_cl, & !< climb velocity
tau, &
sigma_cl, & !< climb stress
@ -639,70 +637,67 @@ module subroutine dislotwin_dotState(Mp,T,ph,en)
real(pReal), dimension(param(ph)%sum_N_sl) :: &
dot_rho_dip_formation, &
dot_rho_dip_climb, &
rho_dip_distance_min, &
dot_gamma_sl
real(pReal), dimension(param(ph)%sum_N_tw) :: &
dot_gamma_tw
real(pReal), dimension(param(ph)%sum_N_tr) :: &
dot_gamma_tr
associate(prm => param(ph), stt => state(ph), &
dot => dotState(ph), dst => dependentState(ph))
f_unrotated = 1.0_pReal &
- sum(stt%f_tw(1:prm%sum_N_tw,en)) &
- sum(stt%f_tr(1:prm%sum_N_tr,en))
associate(prm => param(ph), stt => state(ph), dot => dotState(ph), dst => dependentState(ph))
call kinetics_sl(Mp,T,ph,en,dot_gamma_sl)
dot%gamma_sl(:,en) = abs(dot_gamma_sl)
f_unrotated = 1.0_pReal &
- sum(stt%f_tw(1:prm%sum_N_tw,en)) &
- sum(stt%f_tr(1:prm%sum_N_tr,en))
rho_dip_distance_min = prm%D_a*prm%b_sl
call kinetics_sl(Mp,T,ph,en,dot_gamma_sl)
dot%gamma_sl(:,en) = abs(dot_gamma_sl)
slipState: do i = 1, prm%sum_N_sl
tau = math_tensordot(Mp,prm%P_sl(1:3,1:3,i))
slipState: do i = 1, prm%sum_N_sl
tau = math_tensordot(Mp,prm%P_sl(1:3,1:3,i))
significantSlipStress: if (dEq0(tau) .or. prm%omitDipoles) then
dot_rho_dip_formation(i) = 0.0_pReal
dot_rho_dip_climb(i) = 0.0_pReal
else significantSlipStress
rho_dip_distance = 3.0_pReal*prm%mu*prm%b_sl(i)/(16.0_pReal*PI*abs(tau))
rho_dip_distance = math_clip(rho_dip_distance, right = dst%Lambda_sl(i,en))
rho_dip_distance = math_clip(rho_dip_distance, left = rho_dip_distance_min(i))
dot_rho_dip_formation(i) = 2.0_pReal*(rho_dip_distance-rho_dip_distance_min(i))/prm%b_sl(i) &
* stt%rho_mob(i,en)*abs(dot_gamma_sl(i))
if (dEq(rho_dip_distance,rho_dip_distance_min(i))) then
significantSlipStress: if (dEq0(tau) .or. prm%omitDipoles) then
dot_rho_dip_formation(i) = 0.0_pReal
dot_rho_dip_climb(i) = 0.0_pReal
else
! Argon & Moffat, Acta Metallurgica, Vol. 29, pg 293 to 299, 1981
sigma_cl = dot_product(prm%n0_sl(1:3,i),matmul(Mp,prm%n0_sl(1:3,i)))
b_d = merge(24.0_pReal*PI*(1.0_pReal - prm%nu)/(2.0_pReal + prm%nu) &
* (prm%Gamma_sf(1) + prm%Gamma_sf(2) * T) / (prm%mu*prm%b_sl(i)), &
1.0_pReal, &
prm%ExtendedDislocations)
v_cl = 2.0_pReal*prm%omega*b_d**2.0_pReal*exp(-prm%Q_cl/(kB*T)) &
* (exp(abs(sigma_cl)*prm%b_sl(i)**3.0_pReal/(kB*T)) - 1.0_pReal)
else significantSlipStress
d_hat = 3.0_pReal*prm%mu*prm%b_sl(i)/(16.0_pReal*PI*abs(tau))
d_hat = math_clip(d_hat, right = dst%Lambda_sl(i,en))
d_hat = math_clip(d_hat, left = prm%d_caron(i))
dot_rho_dip_climb(i) = 4.0_pReal*v_cl*stt%rho_dip(i,en) &
/ (rho_dip_distance-rho_dip_distance_min(i))
endif
endif significantSlipStress
enddo slipState
dot_rho_dip_formation(i) = 2.0_pReal*(d_hat-prm%d_caron(i))/prm%b_sl(i) &
* stt%rho_mob(i,en)*abs(dot_gamma_sl(i))
dot%rho_mob(:,en) = abs(dot_gamma_sl)/(prm%b_sl*dst%Lambda_sl(:,en)) &
- dot_rho_dip_formation &
- 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_mob(:,en)*abs(dot_gamma_sl)
if (dEq(d_hat,prm%d_caron(i))) then
dot_rho_dip_climb(i) = 0.0_pReal
else
! Argon & Moffat, Acta Metallurgica, Vol. 29, pg 293 to 299, 1981
sigma_cl = dot_product(prm%n0_sl(1:3,i),matmul(Mp,prm%n0_sl(1:3,i)))
b_d = merge(24.0_pReal*PI*(1.0_pReal - prm%nu)/(2.0_pReal + prm%nu) &
* (prm%Gamma_sf(1) + prm%Gamma_sf(2) * T) / (prm%mu*prm%b_sl(i)), &
1.0_pReal, &
prm%ExtendedDislocations)
v_cl = 2.0_pReal*prm%omega*b_d**2.0_pReal*exp(-prm%Q_cl/(kB*T)) &
* (exp(abs(sigma_cl)*prm%b_sl(i)**3.0_pReal/(kB*T)) - 1.0_pReal)
dot%rho_dip(:,en) = dot_rho_dip_formation &
- 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_dip(:,en)*abs(dot_gamma_sl) &
- dot_rho_dip_climb
dot_rho_dip_climb(i) = 4.0_pReal*v_cl*stt%rho_dip(i,en) &
/ (d_hat-prm%d_caron(i))
endif
endif significantSlipStress
enddo slipState
call kinetics_tw(Mp,T,dot_gamma_sl,ph,en,dot_gamma_tw)
dot%f_tw(:,en) = f_unrotated*dot_gamma_tw/prm%gamma_char
dot%rho_mob(:,en) = abs(dot_gamma_sl)/(prm%b_sl*dst%Lambda_sl(:,en)) &
- dot_rho_dip_formation &
- 2.0_pReal*prm%d_caron/prm%b_sl * stt%rho_mob(:,en)*abs(dot_gamma_sl)
call kinetics_tr(Mp,T,dot_gamma_sl,ph,en,dot_gamma_tr)
dot%f_tr(:,en) = f_unrotated*dot_gamma_tr
dot%rho_dip(:,en) = dot_rho_dip_formation &
- 2.0_pReal*prm%d_caron/prm%b_sl * stt%rho_dip(:,en)*abs(dot_gamma_sl) &
- dot_rho_dip_climb
call kinetics_tw(Mp,T,dot_gamma_sl,ph,en,dot_gamma_tw)
dot%f_tw(:,en) = f_unrotated*dot_gamma_tw/prm%gamma_char
call kinetics_tr(Mp,T,dot_gamma_sl,ph,en,dot_gamma_tr)
dot%f_tr(:,en) = f_unrotated*dot_gamma_tr
end associate
@ -763,19 +758,17 @@ module subroutine dislotwin_dependentState(T,ph,en)
dst%tau_pass(:,en) = prm%mu*prm%b_sl* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,en)+stt%rho_dip(:,en)))
!* threshold stress for growing twin/martensite
if(prm%sum_N_tw == prm%sum_N_sl) &
dst%tau_hat_tw(:,en) = Gamma/(3.0_pReal*prm%b_tw) &
+ 3.0_pReal*prm%b_tw*prm%mu/(prm%L_tw*prm%b_sl) ! slip Burgers here correct?
if(prm%sum_N_tr == prm%sum_N_sl) &
dst%tau_hat_tr(:,en) = Gamma/(3.0_pReal*prm%b_tr) &
+ 3.0_pReal*prm%b_tr*prm%mu/(prm%L_tr*prm%b_sl) & ! slip Burgers here correct?
+ prm%h*prm%delta_G/ (3.0_pReal*prm%b_tr)
dst%tau_hat_tw(:,en) = Gamma/(3.0_pReal*prm%b_tw) &
+ 3.0_pReal*prm%b_tw*prm%mu/(prm%L_tw*prm%b_tw)
dst%tau_hat_tr(:,en) = Gamma/(3.0_pReal*prm%b_tr) &
+ 3.0_pReal*prm%b_tr*prm%mu/(prm%L_tr*prm%b_tr) &
+ prm%h*prm%delta_G/(3.0_pReal*prm%b_tr)
dst%V_tw(:,en) = (PI/4.0_pReal)*prm%t_tw*dst%Lambda_tw(:,en)**2.0_pReal
dst%V_tr(:,en) = (PI/4.0_pReal)*prm%t_tr*dst%Lambda_tr(:,en)**2.0_pReal
x0 = prm%mu*prm%b_tw**2.0_pReal/(Gamma*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) ! ToDo: In the paper, this is the Burgers vector for slip and is the same for twin and trans
x0 = prm%mu*prm%b_tw**2.0_pReal/(Gamma*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) ! ToDo: In the paper, this is the Burgers vector for slip
dst%tau_r_tw(:,en) = prm%mu*prm%b_tw/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tw)+cos(pi/3.0_pReal)/x0)
x0 = prm%mu*prm%b_tr**2.0_pReal/(Gamma*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) ! ToDo: In the paper, this is the Burgers vector for slip
@ -867,7 +860,7 @@ pure subroutine kinetics_sl(Mp,T,ph,en, &
tau, &
stressRatio, &
StressRatio_p, &
BoltzmannRatio, &
Q_kB_T, &
v_wait_inverse, & !< inverse of the effective velocity of a dislocation waiting at obstacles (unsigned)
v_run_inverse, & !< inverse of the velocity of a free moving dislocation (unsigned)
dV_wait_inverse_dTau, &
@ -876,33 +869,34 @@ pure subroutine kinetics_sl(Mp,T,ph,en, &
tau_eff !< effective resolved stress
integer :: i
associate(prm => param(ph), stt => state(ph), dst => dependentState(ph))
tau = [(math_tensordot(Mp,prm%P_sl(1:3,1:3,i)),i = 1, prm%sum_N_sl)]
tau = [(math_tensordot(Mp,prm%P_sl(1:3,1:3,i)),i = 1, prm%sum_N_sl)]
tau_eff = abs(tau)-dst%tau_pass(:,en)
tau_eff = abs(tau)-dst%tau_pass(:,en)
significantStress: where(tau_eff > tol_math_check)
stressRatio = tau_eff/prm%tau_0
StressRatio_p = stressRatio** prm%p
BoltzmannRatio = prm%Q_s/(kB*T)
v_wait_inverse = prm%v_0**(-1.0_pReal) * exp(BoltzmannRatio*(1.0_pReal-StressRatio_p)** prm%q)
v_run_inverse = prm%B/(tau_eff*prm%b_sl)
significantStress: where(tau_eff > tol_math_check)
stressRatio = tau_eff/prm%tau_0
StressRatio_p = stressRatio** prm%p
Q_kB_T = prm%Q_sl/(kB*T)
v_wait_inverse = prm%v_0**(-1.0_pReal) * exp(Q_kB_T*(1.0_pReal-StressRatio_p)** prm%q)
v_run_inverse = prm%B/(tau_eff*prm%b_sl)
dot_gamma_sl = sign(stt%rho_mob(:,en)*prm%b_sl/(v_wait_inverse+v_run_inverse),tau)
dot_gamma_sl = sign(stt%rho_mob(:,en)*prm%b_sl/(v_wait_inverse+v_run_inverse),tau)
dV_wait_inverse_dTau = -1.0_pReal * v_wait_inverse * prm%p * prm%q * BoltzmannRatio &
* (stressRatio**(prm%p-1.0_pReal)) &
* (1.0_pReal-StressRatio_p)**(prm%q-1.0_pReal) &
/ prm%tau_0
dV_run_inverse_dTau = -1.0_pReal * v_run_inverse/tau_eff
dV_dTau = -1.0_pReal * (dV_wait_inverse_dTau+dV_run_inverse_dTau) &
/ (v_wait_inverse+v_run_inverse)**2.0_pReal
ddot_gamma_dtau = dV_dTau*stt%rho_mob(:,en)*prm%b_sl
else where significantStress
dot_gamma_sl = 0.0_pReal
ddot_gamma_dtau = 0.0_pReal
end where significantStress
dV_wait_inverse_dTau = -1.0_pReal * v_wait_inverse * prm%p * prm%q * Q_kB_T &
* (stressRatio**(prm%p-1.0_pReal)) &
* (1.0_pReal-StressRatio_p)**(prm%q-1.0_pReal) &
/ prm%tau_0
dV_run_inverse_dTau = -1.0_pReal * v_run_inverse/tau_eff
dV_dTau = -1.0_pReal * (dV_wait_inverse_dTau+dV_run_inverse_dTau) &
/ (v_wait_inverse+v_run_inverse)**2.0_pReal
ddot_gamma_dtau = dV_dTau*stt%rho_mob(:,en)*prm%b_sl
else where significantStress
dot_gamma_sl = 0.0_pReal
ddot_gamma_dtau = 0.0_pReal
end where significantStress
end associate
@ -945,34 +939,35 @@ pure subroutine kinetics_tw(Mp,T,dot_gamma_sl,ph,en,&
integer :: i,s1,s2
associate(prm => param(ph), stt => state(ph), dst => dependentState(ph))
do i = 1, prm%sum_N_tw
tau(i) = math_tensordot(Mp,prm%P_tw(1:3,1:3,i))
isFCC: if (prm%fccTwinTransNucleation) then
s1=prm%fcc_twinNucleationSlipPair(1,i)
s2=prm%fcc_twinNucleationSlipPair(2,i)
if (tau(i) < dst%tau_r_tw(i,en)) then ! ToDo: correct?
Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,en)+stt%rho_dip(s2,en))+&
abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,en)+stt%rho_dip(s1,en)))/& ! ToDo: MD: it would be more consistent to use shearrates from state
(prm%L_tw*prm%b_sl(i))*&
(1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tw(i,en)-tau(i)))) ! P_ncs
else
Ndot0=0.0_pReal
end if
else isFCC
Ndot0=prm%dot_N_0_tw(i)
endif isFCC
enddo
do i = 1, prm%sum_N_tw
tau(i) = math_tensordot(Mp,prm%P_tw(1:3,1:3,i))
isFCC: if (prm%fccTwinTransNucleation) then
s1=prm%fcc_twinNucleationSlipPair(1,i)
s2=prm%fcc_twinNucleationSlipPair(2,i)
if (tau(i) < dst%tau_r_tw(i,en)) then ! ToDo: correct?
Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,en)+stt%rho_dip(s2,en))+&
abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,en)+stt%rho_dip(s1,en)))/&
(prm%L_tw*prm%b_sl(i))*&
(1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tw(i,en)-tau(i))))
else
Ndot0=0.0_pReal
end if
else isFCC
Ndot0=prm%dot_N_0_tw(i)
endif isFCC
enddo
significantStress: where(tau > tol_math_check)
StressRatio_r = (dst%tau_hat_tw(:,en)/tau)**prm%r
dot_gamma_tw = prm%gamma_char * dst%V_tw(:,en) * Ndot0*exp(-StressRatio_r)
ddot_gamma_dtau = (dot_gamma_tw*prm%r/tau)*StressRatio_r
else where significantStress
dot_gamma_tw = 0.0_pReal
ddot_gamma_dtau = 0.0_pReal
end where significantStress
significantStress: where(tau > tol_math_check)
StressRatio_r = (dst%tau_hat_tw(:,en)/tau)**prm%r
dot_gamma_tw = prm%gamma_char * dst%V_tw(:,en) * Ndot0*exp(-StressRatio_r)
ddot_gamma_dtau = (dot_gamma_tw*prm%r/tau)*StressRatio_r
else where significantStress
dot_gamma_tw = 0.0_pReal
ddot_gamma_dtau = 0.0_pReal
end where significantStress
end associate
@ -1011,36 +1006,37 @@ pure subroutine kinetics_tr(Mp,T,dot_gamma_sl,ph,en,&
Ndot0, &
stressRatio_s, &
ddot_gamma_dtau
integer :: i,s1,s2
associate(prm => param(ph), stt => state(ph), dst => dependentState(ph))
do i = 1, prm%sum_N_tr
tau(i) = math_tensordot(Mp,prm%P_tr(1:3,1:3,i))
isFCC: if (prm%fccTwinTransNucleation) then
s1=prm%fcc_twinNucleationSlipPair(1,i)
s2=prm%fcc_twinNucleationSlipPair(2,i)
if (tau(i) < dst%tau_r_tr(i,en)) then ! ToDo: correct?
Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,en)+stt%rho_dip(s2,en))+&
abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,en)+stt%rho_dip(s1,en)))/& ! ToDo: MD: it would be more consistent to use shearrates from state
(prm%L_tr*prm%b_sl(i))*&
(1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tr(i,en)-tau(i)))) ! P_ncs
else
Ndot0=0.0_pReal
end if
else isFCC
Ndot0=prm%dot_N_0_tr(i)
endif isFCC
enddo
do i = 1, prm%sum_N_tr
tau(i) = math_tensordot(Mp,prm%P_tr(1:3,1:3,i))
isFCC: if (prm%fccTwinTransNucleation) then
s1=prm%fcc_twinNucleationSlipPair(1,i)
s2=prm%fcc_twinNucleationSlipPair(2,i)
if (tau(i) < dst%tau_r_tr(i,en)) then ! ToDo: correct?
Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,en)+stt%rho_dip(s2,en))+&
abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,en)+stt%rho_dip(s1,en)))/&
(prm%L_tr*prm%b_sl(i))*&
(1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tr(i,en)-tau(i))))
else
Ndot0=0.0_pReal
end if
else isFCC
Ndot0=prm%dot_N_0_tr(i)
endif isFCC
enddo
significantStress: where(tau > tol_math_check)
StressRatio_s = (dst%tau_hat_tr(:,en)/tau)**prm%s
dot_gamma_tr = dst%V_tr(:,en) * Ndot0*exp(-StressRatio_s)
ddot_gamma_dtau = (dot_gamma_tr*prm%s/tau)*StressRatio_s
else where significantStress
dot_gamma_tr = 0.0_pReal
ddot_gamma_dtau = 0.0_pReal
end where significantStress
significantStress: where(tau > tol_math_check)
StressRatio_s = (dst%tau_hat_tr(:,en)/tau)**prm%s
dot_gamma_tr = dst%V_tr(:,en) * Ndot0*exp(-StressRatio_s)
ddot_gamma_dtau = (dot_gamma_tr*prm%s/tau)*StressRatio_s
else where significantStress
dot_gamma_tr = 0.0_pReal
ddot_gamma_dtau = 0.0_pReal
end where significantStress
end associate

4
src/phase_mechanical_plastic_kinehardening.f90
View File

@ -359,11 +359,11 @@ module subroutine plastic_kinehardening_results(ph,group)
case ('xi')
if(prm%sum_N_sl>0) call results_writeDataset(stt%xi,group,trim(prm%output(o)), &
'resistance against plastic slip','Pa')
case ('tau_b') !ToDo: chi
case ('chi')
if(prm%sum_N_sl>0) call results_writeDataset(stt%chi,group,trim(prm%output(o)), &
'back stress','Pa')
case ('sgn(gamma)')
if(prm%sum_N_sl>0) call results_writeDataset(stt%sgn_gamma,group,trim(prm%output(o)), & ! ToDo: could be int
if(prm%sum_N_sl>0) call results_writeDataset(int(stt%sgn_gamma),group,trim(prm%output(o)), &
'sense of shear','1')
case ('chi_0')
if(prm%sum_N_sl>0) call results_writeDataset(stt%chi_0,group,trim(prm%output(o)), &

4
src/phase_mechanical_plastic_nonlocal.f90
View File

@ -1402,8 +1402,8 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,i,e)
forall(s1 = 1:ns) my_compatibility(:,s1,s1,n) = 0.0_pReal
elseif (prm%chi_GB >= 0.0_pReal) then
!* GRAIN BOUNDARY
if (any(dNeq(phase_orientation0(ph)%data(en)%asQuaternion(), &
phase_orientation0(neighbor_phase)%data(neighbor_me)%asQuaternion())) .and. &
if (any(dNeq(phase_O_0(ph)%data(en)%asQuaternion(), &
phase_O_0(neighbor_phase)%data(neighbor_me)%asQuaternion())) .and. &
plasticState(neighbor_phase)%nonlocal) &
forall(s1 = 1:ns) my_compatibility(:,s1,s1,n) = sqrt(prm%chi_GB)
else

6
src/prec.f90
View File

@ -27,11 +27,6 @@ module prec
real(pReal), parameter :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation)
type :: group_float !< variable length datatype used for storage of state
real(pReal), dimension(:), pointer :: p
end type group_float
type :: tState
integer :: &
sizeState = 0, & !< size of state
@ -94,6 +89,7 @@ end subroutine prec_init
! replaces "==" but for certain (relative) tolerance. Counterpart to dNeq
! https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/
! AlmostEqualRelative
! ToDo: Use 'spacing': https://gcc.gnu.org/onlinedocs/gfortran/SPACING.html#SPACING
!--------------------------------------------------------------------------------------------------
logical elemental pure function dEq(a,b,tol)

5
src/quit.f90
View File

@ -6,7 +6,10 @@
!--------------------------------------------------------------------------------------------------
subroutine quit(stop_id)
#include <petsc/finclude/petscsys.h>
use PetscSys
use PETScSys
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY)
use MPI_f08
#endif
use HDF5
implicit none

50
src/results.f90
View File

@ -52,6 +52,7 @@ module results
results_openGroup, &
results_closeGroup, &
results_writeDataset, &
results_writeDataset_str, &
results_setLink, &
results_addAttribute, &
results_removeLink, &
@ -64,16 +65,20 @@ subroutine results_init(restart)
logical, intent(in) :: restart
character(len=pPathLen) :: commandLine
integer :: hdferr
integer(HID_T) :: group_id
character(len=:), allocatable :: date
print'(/,a)', ' <<<+- results init -+>>>'; flush(IO_STDOUT)
print*, 'M. Diehl et al., Integrating Materials and Manufacturing Innovation 6(1):83–91, 2017'
print*, 'https://doi.org/10.1007/s40192-017-0084-5'//IO_EOL
if(.not. restart) then
if (.not. restart) then
resultsFile = HDF5_openFile(getSolverJobName()//'.hdf5','w')
call results_addAttribute('DADF5_version_major',0)
call results_addAttribute('DADF5_version_minor',13)
call results_addAttribute('DADF5_version_minor',14)
call get_command_argument(0,commandLine)
call results_addAttribute('creator',trim(commandLine)//' '//DAMASKVERSION)
call results_addAttribute('created',now())
@ -81,18 +86,34 @@ subroutine results_init(restart)
call results_addAttribute('call',trim(commandLine))
call results_closeGroup(results_addGroup('cell_to'))
call results_addAttribute('description','mappings to place data in space','cell_to')
call results_closeJobFile
call results_closeGroup(results_addGroup('setup'))
call results_addAttribute('description','input data used to run the simulation','setup')
else
date = now()
call results_openJobFile
call get_command(commandLine)
call results_addAttribute('call (restart at '//date//')',trim(commandLine))
call h5gmove_f(resultsFile,'setup','tmp',hdferr)
call results_addAttribute('description','input data used to run the simulation up to restart at '//date,'tmp')
call results_closeGroup(results_addGroup('setup'))
call results_addAttribute('description','input data used to run the simulation','setup')
call h5gmove_f(resultsFile,'tmp','setup/previous',hdferr)
endif
call results_closeJobFile
end subroutine results_init
!--------------------------------------------------------------------------------------------------
!> @brief opens the results file to append data
!--------------------------------------------------------------------------------------------------
subroutine results_openJobFile
subroutine results_openJobFile(parallel)
resultsFile = HDF5_openFile(getSolverJobName()//'.hdf5','a')
logical, intent(in), optional :: parallel
resultsFile = HDF5_openFile(getSolverJobName()//'.hdf5','a',parallel)
end subroutine results_openJobFile
@ -297,6 +318,25 @@ subroutine results_removeLink(link)
end subroutine results_removeLink
!--------------------------------------------------------------------------------------------------
!> @brief Store string dataset.
!> @details Not collective, must be called by one process at at time.
!--------------------------------------------------------------------------------------------------
subroutine results_writeDataset_str(dataset,group,label,description)
character(len=*), intent(in) :: label,group,description,dataset
integer(HID_T) :: groupHandle
groupHandle = results_openGroup(group)
call HDF5_write_str(dataset,groupHandle,label)
call executionStamp(group//'/'//label,description)
call HDF5_closeGroup(groupHandle)
end subroutine results_writeDataset_str
!--------------------------------------------------------------------------------------------------
!> @brief Store real scalar dataset with associated metadata.
!--------------------------------------------------------------------------------------------------