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

Merge branch 'development' into export_DAMASK_to_DREAM3D

This commit is contained in:
Vitesh Shah 2023-09-29 08:00:23 +02:00
parent 2729e3f4a0 77675e5890
commit 5ba83fd05b
123 changed files with 6096 additions and 3184 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
.gitlab-ci.yml
View File

@ -47,7 +47,7 @@ variables:
PETSC_INTELLLVM: "Libraries/PETSc/3.16.3/oneAPI-2022.0.1-IntelMPI-2021.5.0"
PETSC_INTEL: "Libraries/PETSc/3.16.5/Intel-2022.0.1-IntelMPI-2021.5.0"
# ++++++++++++ MSC Marc +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
MSC: "FEM/MSC/2022.4"
MSC: "FEM/MSC/2023.1"
IntelMarc: "Compiler/Intel/19.1.2 Libraries/IMKL/2020"
HDF5Marc: "HDF5/1.12.2/Intel-19.1.2"
@ -85,6 +85,40 @@ mypy:
###################################################################################################
unittest_GNU_DEBUG:
stage: compile
script:
- module load ${COMPILER_GNU} ${MPI_GNU} ${PETSC_GNU}
- TMPDIR=$(mktemp -d)
- cmake -B ${TMPDIR} -DDAMASK_SOLVER=test -DCMAKE_INSTALL_PREFIX=${TMPDIR} -DCMAKE_BUILD_TYPE=RELEASE -DBUILDCMD_POST=-coverage
- cmake --build ${TMPDIR} --target install
- cd ${TMPDIR}
- ./bin/DAMASK_test
- find -name \*.gcda -not -path "**/test/*" | xargs gcov
unittest_GNU_RELEASE:
stage: compile
script:
- module load ${COMPILER_GNU} ${MPI_GNU} ${PETSC_GNU}
- TMPDIR=$(mktemp -d)
- cmake -B ${TMPDIR} -DDAMASK_SOLVER=test -DCMAKE_INSTALL_PREFIX=${TMPDIR} -DCMAKE_BUILD_TYPE=RELEASE -DBUILDCMD_POST=-coverage
- cmake --build ${TMPDIR} --target install
- cd ${TMPDIR}
- ./bin/DAMASK_test
- find -name \*.gcda -not -path "**/test/*" | xargs gcov
unittest_GNU_PERFORMANCE:
stage: compile
script:
- module load ${COMPILER_GNU} ${MPI_GNU} ${PETSC_GNU}
- TMPDIR=$(mktemp -d)
- cmake -B ${TMPDIR} -DDAMASK_SOLVER=test -DCMAKE_INSTALL_PREFIX=${TMPDIR} -DCMAKE_BUILD_TYPE=PERFORMANCE -DBUILDCMD_POST=-coverage
- cmake --build ${TMPDIR} --target install
- cd ${TMPDIR}
- ./bin/DAMASK_test
- find -name \*.gcda -not -path "**/test/*" | xargs gcov
grid_GNU:
stage: compile
script:
@ -196,7 +230,7 @@ Marc:
###################################################################################################
grid_runtime:
grid_performance:
stage: statistics
before_script:
- ${LOCAL_HOME}/bin/queue ${CI_JOB_ID} --blocking
@ -209,28 +243,33 @@ grid_runtime:
- make -j2 all install
- export PATH=${PWD}/bin:${PATH}
- cd $(mktemp -d)
- git clone -q git@git.damask.mpie.de:damask/performance.git .
- git clone -q git@git.damask.mpie.de:damask/statistics.git .
- ./measure_performance.py --input_dir ${CI_PROJECT_DIR}/examples/grid --tag ${CI_COMMIT_SHA}
- >
${CI_PROJECT_DIR}/PRIVATE/testing/runtime.py
--input_dir ${CI_PROJECT_DIR}/examples/grid
--output_dir ./
--tag ${CI_COMMIT_SHA}
- if [ ${CI_COMMIT_BRANCH} == development ]; then git commit -am ${CI_PIPELINE_ID}_${CI_COMMIT_SHA}; git push; fi
commit_history:
stage: statistics
script:
- cd $(mktemp -d)
- ${CI_PROJECT_DIR}/PRIVATE/testing/plot_commithistory.py --color green -n 5 -N 100
- ${CI_PROJECT_DIR}/PRIVATE/testing/plot_commithistory.py --color green -n 5 -N 1000
- ${CI_PROJECT_DIR}/PRIVATE/testing/plot_commithistory.py --color green -n 5 -N 10000
- scp -r ./commits_*.html damask3.mpie.de:~/
- ssh damask3.mpie.de "./update_statistics.sh"
only:
- development
if [ ${CI_COMMIT_BRANCH} == development ]; then
git add performance.txt
git commit -m ${CI_PIPELINE_ID}_${CI_COMMIT_SHA}
git push
fi
###################################################################################################
update_plots:
stage: finalize
script:
- cd $(mktemp -d)
- git clone -q git@git.damask.mpie.de:damask/statistics.git .
- ./plot_commithistory.py --color green -n 5 -N 100
- ./plot_commithistory.py --color green -n 5 -N 1000
- ./plot_commithistory.py --color green -n 5 -N 10000
- scp -r ./commits_*.html damask.mpie.de:~/
- ssh damask.mpie.de "./update_statistics_commits.sh"
- ./plot_performance.py --template=xgridoff
- scp -r ./runtime.html ./memory.html damask.mpie.de:~/
- ssh damask.mpie.de "./update_statistics_performance.sh"
only:
- development
update_revision:
stage: finalize
before_script:
@ -245,6 +284,6 @@ update_revision:
- >
git diff-index --quiet HEAD ||
git commit VERSION -m "[skip ci] updated version information after successful test of $VERSION"
- if [ ${CI_COMMIT_SHA} == $(git rev-parse HEAD^) ]; then git push origin HEAD:master HEAD:development; fi
- if [ ${CI_COMMIT_SHA} == $(git rev-parse HEAD^) ]; then git push --atomic --no-verify origin HEAD:development HEAD:master; fi
only:
- development

2
PRIVATE

@ -1 +1 @@
Subproject commit 9f4ffce8b2df951191a14dc3229de1aee6e544e6
Subproject commit 9d2a98d72d9bf547dd697124cb795cf6a9668d30

2
VERSION
View File

@ -1 +1 @@
3.0.0-alpha7-604-g65fa62b3f
3.0.0-alpha7-864-g9cf37c493

7
cmake/Compiler-GNU.cmake
View File

@ -29,8 +29,8 @@ set (COMPILE_FLAGS "${COMPILE_FLAGS} -cpp")
set (COMPILE_FLAGS "${COMPILE_FLAGS} -fPIE")
# position independent code
set (COMPILE_FLAGS "${COMPILE_FLAGS} -ffree-line-length-132")
# restrict line length to the standard 132 characters (lattice.f90 require more characters)
set (COMPILE_FLAGS "${COMPILE_FLAGS} -ffree-line-length-none")
# PETSc macros are long, line length is enforced in pre-receive hook
set (COMPILE_FLAGS "${COMPILE_FLAGS} -fimplicit-none")
# assume "implicit none" even if not present in source
@ -131,6 +131,9 @@ set (DEBUG_FLAGS "${DEBUG_FLAGS} -fcheck=all")
set (DEBUG_FLAGS "${DEBUG_FLAGS} -fstack-protector-all")
# Inserts a guard variable onto the stack frame for all functions
set (DEBUG_FLAGS "${DEBUG_FLAGS} -finit-real=snan -finit-integer=-2147483648")
# "strange" values to simplify debugging
set (DEBUG_FLAGS "${DEBUG_FLAGS} -fsanitize=undefined")
# detect undefined behavior
# Additional options

2
cmake/Compiler-Intel.cmake
View File

@ -35,7 +35,7 @@ set (COMPILE_FLAGS "${COMPILE_FLAGS} -no-ftz")
set (COMPILE_FLAGS "${COMPILE_FLAGS} -diag-disable")
# disables warnings ...
set (COMPILE_FLAGS "${COMPILE_FLAGS} 5268")
# ... the text exceeds right hand column allowed on the line (we have only comments there)
# ... the text exceeds right hand column allowed on the line (enforced by pre-receive hook)
set (COMPILE_FLAGS "${COMPILE_FLAGS},7624")
# ... about deprecated forall (has nice syntax and most likely a performance advantage)

5
cmake/Compiler-IntelLLVM.cmake
View File

@ -37,7 +37,7 @@ set (COMPILE_FLAGS "${COMPILE_FLAGS} -no-ftz")
set (COMPILE_FLAGS "${COMPILE_FLAGS} -diag-disable")
# disables warnings ...
set (COMPILE_FLAGS "${COMPILE_FLAGS} 5268")
# ... the text exceeds right hand column allowed on the line (we have only comments there)
# ... the text exceeds right hand column allowed on the line (enforced by pre-receive hook)
set (COMPILE_FLAGS "${COMPILE_FLAGS},7624")
# ... about deprecated forall (has nice syntax and most likely a performance advantage)
@ -98,6 +98,9 @@ set (DEBUG_FLAGS "${DEBUG_FLAGS},uninit")
set (DEBUG_FLAGS "${DEBUG_FLAGS} -fpe-all=0 -ftz")
# ... capture all floating-point exceptions, need to overwrite -no-ftz
set (DEBUG_FLAGS "${DEBUG_FLAGS} -init=arrays,zero,minus_huge,snan")
# ... initialize logical to false, integer to -huge, float+complex to signaling NaN
# disable due to compiler bug https://community.intel.com/t5/Intel-Fortran-Compiler/false-positive-stand-f18-and-IEEE-SELECTED-REAL-KIND/m-p/1227336
#set (DEBUG_FLAGS "${DEBUG_FLAGS} -warn")
# enables warnings ...

8
examples/Marc/material.yaml
View File

@ -13,12 +13,12 @@ phase:
plastic:
type: phenopowerlaw
N_sl: [12]
a_sl: 2.25
a_sl: [2.25]
atol_xi: 1.0
dot_gamma_0_sl: 0.001
h_0_sl-sl: 75.e+6
dot_gamma_0_sl: [0.001]
h_0_sl-sl: [75.e+6]
h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4]
n_sl: 20
n_sl: [20]
output: [xi_sl]
xi_0_sl: [31.e+6]
xi_inf_sl: [63.e+6]

165
examples/config/numerics.yaml
View File

@ -1,83 +1,100 @@
# Available numerical parameters
# Case sensitive keys
# Default values of all available numerical parameters
# Please note that keys are case sensitive
solver:
grid:
N_staggered_iter_max: 10 # max number of field-level staggered iterations
N_cutback_max: 3 # maximum cutback level (0: 1, 1: 0.5, 2: 0.25, etc)
damage:
N_iter_max: 100 # maximum iteration number
eps_abs_phi: 1.0e-2 # absolute tolerance for damage evolution
eps_rel_phi: 1.0e-6 # relative tolerance for damage evolution
phi_min: 1.0e-6 # residual integrity
thermal:
N_iter_max: 100 # maximum iteration number
eps_abs_T: 1.0e-2 # absolute tolerance for thermal equilibrium
eps_rel_T: 1.0e-6 # relative tolerance for thermal equilibrium
mechanical:
N_iter_min: 1 # minimum iteration number
N_iter_max: 100 # maximum iteration number
eps_abs_div(P): 1.0e-4 # absolute tolerance for fulfillment of stress equilibrium
eps_rel_div(P): 5.0e-4 # relative tolerance for fulfillment of stress equilibrium
eps_abs_P: 1.0e3 # absolute tolerance for fulfillment of stress BC
eps_rel_P: 1.0e-3 # relative tolerance for fulfillment of stress BC
update_gamma: false # update Gamma-operator with current dPdF (not possible if FFT: memory_efficient == true)
FFT:
memory_efficient: true # precalculate Gamma-operator (81 doubles per point)
divergence_correction: size+grid # use size-independent divergence criterion {none, size, size+grid}
derivative: continuous # approximation used for derivatives in Fourier space {continuous, central_difference, FWBW_difference}
FFTW_plan_mode: FFTW_MEASURE # planning-rigor flags, see manual at https://www.fftw.org/fftw3_doc/Planner-Flags.html
FFTW_timelimit: -1.0 # time limit of plan creation for FFTW, see manual on www.fftw.org. (-1.0: disable time limit)
PETSc_options: -snes_type ngmres -snes_ngmres_anderson # PETSc solver options
alpha: 1.0 # polarization scheme parameter 0.0 < alpha < 2.0 (1.0: AL scheme, 2.0: accelerated scheme)
beta: 1.0 # polarization scheme parameter 0.0 < beta < 2.0 (1.0: AL scheme, 2.0: accelerated scheme)
eps_abs_curl(F): 1.0e-10 # absolute tolerance for fulfillment of strain compatibility
eps_rel_curl(F): 5.0e-4 # relative tolerance for fulfillment of strain compatibility
mesh:
N_cutback_max: 3 # maximum cut back level (0: 1, 1: 0.5, 2: 0.25, etc)
N_staggered_iter_max: 10 # max number of field level staggered iterations
p_s: 2 # order of displacement shape functions
p_i: 2 # order of quadrature rule required
bbarstabilization: false
mechanical:
N_iter_max: 250 # Maximum iteration number
eps_abs_div(P): 1.0e-10 # absolute tolerance for mechanical equilibrium
eps_rel_div(P): 1.0e-4 # relative tolerance for mechanical equilibrium
Marc:
unit_length: 1.0 # physical length of one computational length unit
homogenization:
mech:
mechanical:
RGC:
atol: 1.0e+4 # absolute tolerance of RGC residuum (in Pa)
rtol: 1.0e-3 # relative ...
amax: 1.0e+10 # absolute upper-limit of RGC residuum (in Pa)
rmax: 1.0e+2 # relative ...
perturbpenalty: 1.0e-7 # perturbation for computing penalty tangent
relevantmismatch: 1.0e-5 # minimum threshold of mismatch
viscositypower: 1.0e+0 # power (sensitivity rate) of numerical viscosity in RGC scheme
viscositymodulus: 0.0e+0 # stress modulus of RGC numerical viscosity (zero = without numerical viscosity)
# suggestion: larger than the aTol_RGC but still far below the expected flow stress of material
refrelaxationrate: 1.0e-3 # reference rate of relaxation (about the same magnitude as straining rate, possibly a bit higher)
maxrelaxationrate: 1.0e+0 # threshold of maximum relaxation vector increment (if exceed this then cutback)
maxvoldiscrepancy: 1.0e-5 # maximum allowable relative volume discrepancy
voldiscrepancymod: 1.0e+12
discrepancypower: 5.0
eps_abs_P: 1.0e+4 # absolute tolerance of RGC residuum (in Pa)
eps_rel_P: 1.0e-3 # relative ...
eps_abs_max: 1.0e+10 # absolute upper-limit of RGC residuum (in Pa)
eps_rel_max: 1.0e+2 # relative ...
Delta_a: 1.0e-7 # perturbation for computing penalty tangent
relevant_mismatch: 1.0e-5 # minimum threshold of mismatch
viscosity_exponent: 1.0e+0 # power (sensitivity rate) of numerical viscosity in RGC scheme
viscosity_modulus: 0.0e+0 # stress modulus of RGC numerical viscosity (0: without numerical viscosity)
# suggestion: larger than the aTol_RGC but still far below the expected flow stress of material
dot_a_ref: 1.0e-3 # reference rate of relaxation (about the same magnitude as straining rate, possibly a bit higher)
dot_a_max: 1.0e+0 # threshold of maximum relaxation vector increment (if exceed this then cutback)
Delta_V_max: 1.0e-5 # maximum allowable relative volume discrepancy
Delta_V_modulus: 1.0e+12
Delta_V_exponent: 5.0
generic:
subStepMin: 1.0e-3 # minimum (relative) size of sub-step allowed during cutback in homogenization
subStepSize: 0.25 # size of substep when cutback introduced in homogenization (value between 0 and 1)
stepIncrease: 1.5 # increase of next substep size when previous substep converged in homogenization (value higher than 1)
nMPstate: 10 # materialpoint state loop limit
grid:
eps_div_atol: 1.0e-3 # absolute tolerance for fulfillment of stress equilibrium
eps_div_rtol: 5.0e-4 # relative tolerance for fulfillment of stress equilibrium
eps_curl_atol: 1.0e-12 # absolute tolerance for fulfillment of strain compatibility
eps_curl_rtol: 5.0e-4 # relative tolerance for fulfillment of strain compatibility
eps_stress_atol: 1.0e+3 # absolute tolerance for fulfillment of stress BC
eps_stress_rtol: 0.01 # relative tolerance for fulfillment of stress BC
eps_damage_atol: 1.0e-2 # absolute tolerance for damage evolution
eps_damage_rtol: 1.0e-6 # relative tolerance for damage evolution
eps_thermal_atol: 1.0e-2 # absolute tolerance for thermal equilibrium
eps_thermal_rtol: 1.0e-6 # relative tolerance for thermal equilibrium
itmax: 250 # Maximum iteration number
itmin: 2 # Minimum iteration number
fftw_timelimit: -1.0 # timelimit of plan creation for FFTW, see manual on www.fftw.org, Default -1.0: disable timelimit
fftw_plan_mode: FFTW_PATIENT # reads the planing-rigor flag, see manual on www.fftw.org, Default FFTW_PATIENT: use patient planner flag
maxCutBack: 3 # maximum cut back level (0: 1, 1: 0.5, 2: 0.25, etc)
maxStaggeredIter: 10 # max number of field level staggered iterations
memory_efficient: 1 # Precalculate Gamma-operator (81 double per point)
update_gamma: false # Update Gamma-operator with current dPdF (not possible if memory_efficient=1)
divergence_correction: 2 # Use size-independent divergence criterion
derivative: continuous # Approximation used for derivatives in Fourier space
petsc_options: -snes_type ngmres -snes_ngmres_anderson # PetSc solver options
alpha: 1.0 # polarization scheme parameter 0.0 < alpha < 2.0. alpha = 1.0 ==> AL scheme, alpha = 2.0 ==> accelerated scheme
beta: 1.0 # polarization scheme parameter 0.0 < beta < 2.0. beta = 1.0 ==> AL scheme, beta = 2.0 ==> accelerated scheme
phase:
mechanical:
r_cutback_min: 1.0e-3 # minimum (relative) size of step allowed during cutback in phase state calculation
r_cutback: 0.25 # factor to decrease size of step when cutback introduced in phase state calculation (value between 0 and 1)
r_increase: 1.5 # factor to increase size of next step when previous step converged in phase state calculation
eps_rel_state: 1.0e-6 # relative tolerance in phase state loop (abs tol provided by constitutive law)
N_iter_state_max: 10 # state loop limit
mesh:
maxCutBack: 3 # maximum cut back level (0: 1, 1: 0.5, 2: 0.25, etc)
maxStaggeredIter: 10 # max number of field level staggered iterations
structorder: 2 # order of displacement shape functions (when mesh is defined)
bbarstabilisation: false
integrationorder: 2 # order of quadrature rule required (when mesh is defined)
itmax: 250 # Maximum iteration number
itmin: 2 # Minimum iteration number
eps_struct_atol: 1.0e-10 # absolute tolerance for mechanical equilibrium
eps_struct_rtol: 1.0e-4 # relative tolerance for mechanical equilibrium
plastic:
r_linesearch_Lp: 0.5 # factor to decrease the step if Lp calculation fails to converge
eps_rel_Lp: 1.0e-6 # relative tolerance in Lp residuum
eps_abs_Lp: 1.0e-8 # absolute tolerance in Lp residuum
N_iter_Lp_max: 40 # stress loop limit for Lp
f_update_jacobi_Lp: 1 # frequency of Jacobian update of residuum in Lp
integrator_state: FPI # integration method (FPI = Fixed Point Iteration, Euler = Euler, AdaptiveEuler = Adaptive Euler, RK4 = classical 4th order Runge-Kutta, RKCK45 = 5th order Runge-Kutta Cash-Karp)
crystallite:
subStepMin: 1.0e-3 # minimum (relative) size of sub-step allowed during cutback in crystallite
subStepSize: 0.25 # size of substep when cutback introduced in crystallite (value between 0 and 1)
stepIncrease: 1.5 # increase of next substep size when previous substep converged in crystallite (value higher than 1)
subStepSizeLp: 0.5 # size of first substep when cutback in Lp calculation
subStepSizeLi: 0.5 # size of first substep when cutback in Li calculation
nState: 10 # state loop limit
nStress: 40 # stress loop limit
rtol_State: 1.0e-6 # relative tolerance in crystallite state loop (abs tol provided by constitutive law)
rtol_Stress: 1.0e-6 # relative tolerance in crystallite stress loop (Lp residuum)
atol_Stress: 1.0e-8 # absolute tolerance in crystallite stress loop (Lp residuum!)
integrator: FPI # integration method (FPI = Fixed Point Iteration, Euler = Euler, AdaptiveEuler = Adaptive Euler, RK4 = classical 4th order Runge-Kutta, RKCK45 = 5th order Runge-Kutta Cash-Karp)
iJacoLpresiduum: 1 # frequency of Jacobian update of residuum in Lp
commercialFEM:
unitlength: 1 # physical length of one computational length unit
eigen:
r_linesearch_Li: 0.5 # factor to decrease the step if Li calculation fails to converge
eps_rel_Li: 1.0e-6 # relative tolerance in Li residuum
eps_abs_Li: 1.0e-8 # absolute tolerance in Li residuum
N_iter_Li_max: 40 # stress loop limit for Li
f_update_jacobi_Li: 1 # frequency of updating the Jacobian of residuum in Li
generic:
random_seed: 0 # fixed seeding for pseudo-random number generator, Default 0: use random seed.
phi_min: 1.0e-6 # non-zero residual damage.
random_seed: 0 # fixed seeding for pseudo-random number generator (0: use random seed)

2
examples/config/phase/mechanical/plastic/dislotungsten_W.yaml
View File

@ -26,7 +26,7 @@ h_sl-sl: [0.009, 0.72, 0.009, 0.05, 0.05, 0.06, 0.09]
w: [2.992e-09] # 11b
# values in Cereceda et al. are high, using parameters from Gröger et al.
a_nonSchmid: [0.0, 0.56, 0.75] # Tab. 2
a_nonSchmid_110: [0.0, 0.56, 0.75] # Tab. 2
# (almost) no annhilation, adjustment needed for simulations beyond the yield point
i_sl: [1] # c, eq. (25)

4
examples/config/phase/mechanical/plastic/kinehardening_317L.yaml
View File

@ -18,6 +18,6 @@ chi_inf: [0.027e+9] # τ_1,bs
h_0_chi: [55e+9] # θ_0,bs
h_inf_chi: [1.3e+9] # θ_1,bs
n: 20 # not mentioned in the reference
dot_gamma_0: 1e-4 # not mentioned in the reference
n: [20] # not mentioned in the reference
dot_gamma_0: [1e-4] # not mentioned in the reference
h_sl-sl: [1, 1, 1, 1, 1, 1, 1]

8
examples/config/phase/mechanical/plastic/phenopowerlaw_AA6022-T4.yaml
View File

@ -10,10 +10,10 @@ output: [xi_sl, gamma_sl]
N_sl: [12]
n_sl: 20
a_sl: 3.7
h_0_sl-sl: 1.02e+9
dot_gamma_0_sl: [0.001]
n_sl: [20]
a_sl: [3.7]
xi_0_sl: [76.e+6]
xi_inf_sl: [266.e+6]
h_0_sl-sl: [1.02e+9]
h_sl-sl: [1, 1, 5.123, 0.574, 1.123, 1.123, 1]
dot_gamma_0_sl: 0.001

8
examples/config/phase/mechanical/plastic/phenopowerlaw_Al.yaml
View File

@ -10,10 +10,10 @@ output: [xi_sl, gamma_sl]
N_sl: [12]
n_sl: 20
a_sl: 5.4
h_0_sl-sl: 281.5e+6
dot_gamma_0_sl: [7.5e-5]
n_sl: [20]
a_sl: [5.4]
xi_0_sl: [2.69e+6]
xi_inf_sl: [67.5e+6]
h_0_sl-sl: [0.2815e+9]
h_sl-sl: [1, 1, 5.123, 0.574, 1.123, 1.123, 1]
dot_gamma_0_sl: 7.5e-5

8
examples/config/phase/mechanical/plastic/phenopowerlaw_Au.yaml
View File

@ -15,10 +15,10 @@ output: [xi_sl, gamma_sl]
N_sl: [12]
n_sl: 83.3
a_sl: 1.0
h_0_sl-sl: 75.0e+6
dot_gamma_0_sl: [0.001]
n_sl: [83.3]
a_sl: [1.0]
xi_0_sl: [26.25e+6]
xi_inf_sl: [53.0e+6]
h_0_sl-sl: [75.0e+6]
h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4]
dot_gamma_0_sl: 0.001

8
examples/config/phase/mechanical/plastic/phenopowerlaw_Cu.yaml
View File

@ -10,10 +10,10 @@ output: [xi_sl, gamma_sl]
N_sl: [12]
n_sl: 20
a_sl: 0.6
h_0_sl-sl: 3.5e+8
dot_gamma_0_sl: [3.e-3]
n_sl: [20]
a_sl: [0.6]
xi_0_sl: [1.6e+6]
xi_inf_sl: [96.4e+6]
h_0_sl-sl: [0.35e+9]
h_sl-sl: [1, 1, 5.123, 0.574, 1.123, 1.123, 1]
dot_gamma_0_sl: 3.e-3

8
examples/config/phase/mechanical/plastic/phenopowerlaw_DP-steel-ferrite.yaml
View File

@ -12,10 +12,10 @@ output: [xi_sl, gamma_sl]
N_sl: [12, 12]
n_sl: 20
a_sl: 2.25
h_0_sl-sl: 1.0e+9
dot_gamma_0_sl: [0.001, 0.001]
n_sl: [20, 20]
a_sl: [2.25, 2.25]
xi_0_sl: [95.e+6, 96.e+6]
xi_inf_sl: [222.e+6, 412.e+6]
h_0_sl-sl: [1.0e+9, 1.0e+9]
h_sl-sl: [1, 1.4, 1, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4]
dot_gamma_0_sl: 0.001

18
examples/config/phase/mechanical/plastic/phenopowerlaw_Mg.yaml
View File

@ -14,16 +14,16 @@ xi_0_sl: [10.e+6, 55.e+6, 60.e+6, 0., 60.e+6]
xi_inf_sl: [40.e+6, 135.e+6, 150.e+6, 0., 150.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
a_sl: [2.25, 2.25, 2.25, 1, 2.25]
dot_gamma_0_sl: [0.001, 0.001, 0.001, 0, 0.001]
dot_gamma_0_tw: [0.001, 0, 0.001]
n_sl: [20, 20, 20, 1, 20]
n_tw: [20, 1, 20]
f_sat_sl-tw: [10.0, 10.0, 10.0, 0, 10.0]
h_0_sl-sl: 500.0e+6
h_0_tw-tw: 50.0e+6
h_0_tw-sl: 150.0e+6
h_0_sl-sl: [0.5e+9, 0.5e+9, 0.5e+9, 0, 0.5e+9]
h_0_tw-tw: [50.0e+6, 0, 50.0e+6]
h_0_tw-sl: [0.15e+9, 0, 0.15e+9]
h_sl-sl: [+1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0,
+1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, -1.0,
-1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0,

12
examples/config/phase/mechanical/plastic/phenopowerlaw_Pt-5%Cu.yaml
View File

@ -10,10 +10,10 @@ output: [xi_sl, gamma_sl]
N_sl: [12]
n_sl: 20
a_sl: 0.9
h_0_sl-sl: 781.2e+6
xi_0_sl: [114.e+6]
xi_inf_sl: [207.e+6]
dot_gamma_0_sl: [0.001]
n_sl: [20]
a_sl: [0.9]
xi_0_sl: [0.114e+9]
xi_inf_sl: [0.207e+9]
h_0_sl-sl: [0.7812e+9]
h_sl-sl: [1, 1, 5.123, 0.574, 1.123, 1.123, 1]
dot_gamma_0_sl: 0.001

8
examples/config/phase/mechanical/plastic/phenopowerlaw_Sn-beta.yaml
View File

@ -9,9 +9,9 @@ output: [xi_sl, gamma_sl]
N_sl: [2, 2, 2, 4, 2, 4, 2, 2, 4, 0, 0, 8]
n_sl: 6.0
a_sl: 2.0
h_0_sl-sl: 20.0e+6
n_sl: [6.0, 6.0, 6.0, 6.0, 6.0, 6.0, 6.0, 6.0, 6.0, 1, 1, 6.0]
a_sl: [2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 1.0, 1.0, 2.0]
h_0_sl-sl: [20e+6, 20e+6, 20e+6, 20e+6, 20e+6, 20e+6, 20e+6, 20e+6, 20e+6, 0.0, 0.0, 20e+6]
xi_0_sl: [8.5e+6, 4.3e+6, 10.4e+6, 4.5e+6, 5.6e+6, 5.1e+6, 7.4e+6, 15.0e+6, 6.6e+6, 0.0, 0.0, 12.0e+6]
xi_inf_sl: [11.0e+6, 9.0e+6, 11.0e+6, 9.0e+6, 10.0e+6, 10.0e+6, 10.0e+6, 10.0e+6, 9.0e+6, 0.0, 0.0, 13.0e+6]
h_sl-sl: [+1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0,
@ -30,4 +30,4 @@ h_sl-sl: [+1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0,
-1.0, -1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0,
+1.0, -1.0, -1.0, 1.0, 1.0, -1.0, -1.0, 1.0, 1.0, 1.0, # 150
+1.0, 1.0, 1.0, 1.0, 1.0, 1.0] # unused entries are indicated by -1.0
dot_gamma_0_sl: 2.6e-8
dot_gamma_0_sl: [2.6e-8, 2.6e-8, 2.6e-8, 2.6e-8, 2.6e-8, 2.6e-8, 2.6e-8, 2.6e-8, 2.6e-8, 1.0, 1.0, 2.6e-8]

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

@ -12,17 +12,17 @@ output: [gamma_sl]
N_sl: [3, 3, 0, 12] # basal, prism, -, 1. pyr<c+a>
n_sl: 20
a_sl: 2.0
dot_gamma_0_sl: 0.001
h_0_sl-sl: 200.e+6
dot_gamma_0_sl: [0.001, 0.001, 0.0, 0.001]
n_sl: [20, 20, 1, 20]
a_sl: [2.0, 2.0, 1.0, 2.0]
# C. Zambaldi et al.:
xi_0_sl: [349.e+6, 150.e+6, 0.0, 1107.e+6]
xi_inf_sl: [568.e+6, 150.e+7, 0.0, 3420.e+6]
xi_0_sl: [0.349e+9, 0.15e+9, 0.0, 1.107e+9]
xi_inf_sl: [0.568e+9, 1.50e+9, 0.0, 3.420e+9]
# L. Wang et al. :
# xi_0_sl: [127.e+6, 96.e+6, 0.0, 240.e+6]
h_0_sl-sl: [0.2e+9, 0.2e+9, 0.0, 0.2e+9]
h_sl-sl: [+1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, -1.0, -1.0,
-1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, 1.0,
+1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0,

14
examples/config/Phase_Phenopowerlaw_BCC-Martensite.yaml → examples/config/phase/mechanical/plastic/phenopowerlaw_bcc_martensite.yaml
View File

@ -1,12 +1,14 @@
# Tasan et.al. 2015 Acta Materalia
# Tasan et.al. 2015 International Journal of Plasticity
# Diehl et.al. 2015 Meccanica
N_sl: [12, 12]
a_sl: 2.0
dot_gamma_0_sl: 0.001
h_0_sl-sl: 563.0e+9
h_sl-sl: [1, 1.4, 1, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4]
n_sl: 20
type: phenopowerlaw
N_sl: [12, 12]
dot_gamma_0_sl: [0.001, 0.001]
n_sl: [20, 20]
a_sl: [2.0, 2.0]
xi_0_sl: [405.8e+6, 456.7e+6]
xi_inf_sl: [872.9e+6, 971.2e+6]
h_0_sl-sl: [563.0e+9, 563.0e+9]
h_sl-sl: [1, 1.4, 1, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4, 1.4]

8
examples/grid/material.yaml
View File

@ -13,12 +13,12 @@ phase:
plastic:
type: phenopowerlaw
N_sl: [12]
a_sl: 2.25
a_sl: [2.25]
atol_xi: 1.0
dot_gamma_0_sl: 0.001
h_0_sl-sl: 75.e+6
dot_gamma_0_sl: [0.001]
h_0_sl-sl: [75.e+6]
h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4]
n_sl: 20
n_sl: [20]
output: [xi_sl]
xi_0_sl: [31.e+6]
xi_inf_sl: [63.e+6]

8
examples/grid/numerics.yaml
View File

@ -1,3 +1,5 @@
grid:
itmin: 4
itmax: 40
solver:
grid:
mechanical:
N_iter_min: 4
N_iter_max: 40

8
examples/mesh/material.yaml
View File

@ -12,12 +12,12 @@ phase:
plastic:
type: phenopowerlaw
N_sl: [12]
a_sl: 2.25
a_sl: [2.25]
atol_xi: 1.0
dot_gamma_0_sl: 0.001
h_0_sl-sl: 75.e+6
dot_gamma_0_sl: [0.001]
h_0_sl-sl: [75.e+6]
h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4]
n_sl: 20
n_sl: [20]
output: [xi_sl]
xi_0_sl: [31.e+6]
xi_inf_sl: [63.e+6]

49
install/MarcMentat/2023.1/Marc_tools/comp_damask_hmp.patch vendored Normal file
View File

@ -0,0 +1,49 @@
---
+++
@@ -6,18 +6,27 @@
DIR=$1
user=$3
program=$4
+usernoext=$user
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
+
+# add BLAS options for linking
+ BLAS="%BLAS%"
+
. $DIR/tools/include
DIRJOB=$2
cd $DIRJOB
-echo "Compiling and linking user subroutine $user.f on host `hostname`"
+echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
- $FORTRAN $user.f || \
+ $DFORTHIGHMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
- userobj=$user.o
+ userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
@@ -33,9 +42,13 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $BLAS \
$SYSLIBS || \
{
- echo "$0: link failed for $user.o on host `hostname`"
+ echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
+ /bin/rm $DIRJOB/*.mod
+ /bin/rm $DIRJOB/*.smod
+ /bin/rm $DIRJOB/*_genmod.f90

49
install/MarcMentat/2023.1/Marc_tools/comp_damask_lmp.patch vendored Normal file
View File

@ -0,0 +1,49 @@
---
+++
@@ -6,18 +6,27 @@
DIR=$1
user=$3
program=$4
+usernoext=$user
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
+
+# add BLAS options for linking
+ BLAS="%BLAS%"
+
. $DIR/tools/include
DIRJOB=$2
cd $DIRJOB
-echo "Compiling and linking user subroutine $user.f on host `hostname`"
+echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
- $FORTRAN $user.f || \
+ $DFORTRANLOWMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
- userobj=$user.o
+ userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
@@ -33,9 +42,13 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $BLAS \
$SYSLIBS || \
{
- echo "$0: link failed for $user.o on host `hostname`"
+ echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
+ /bin/rm $DIRJOB/*.mod
+ /bin/rm $DIRJOB/*.smod
+ /bin/rm $DIRJOB/*_genmod.f90

49
install/MarcMentat/2023.1/Marc_tools/comp_damask_mp.patch vendored Normal file
View File

@ -0,0 +1,49 @@
---
+++
@@ -6,18 +6,27 @@
DIR=$1
user=$3
program=$4
+usernoext=$user
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
+usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
+
+# add BLAS options for linking
+ BLAS="%BLAS%"
+
. $DIR/tools/include
DIRJOB=$2
cd $DIRJOB
-echo "Compiling and linking user subroutine $user.f on host `hostname`"
+echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
- $FORTRAN $user.f || \
+ $DFORTRANMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
- userobj=$user.o
+ userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
@@ -33,9 +42,13 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $BLAS \
$SYSLIBS || \
{
- echo "$0: link failed for $user.o on host `hostname`"
+ echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
+ /bin/rm $DIRJOB/*.mod
+ /bin/rm $DIRJOB/*.smod
+ /bin/rm $DIRJOB/*_genmod.f90

75
install/MarcMentat/2023.1/Marc_tools/include_linux64.patch vendored Normal file
View File

@ -0,0 +1,75 @@
---
+++
@@ -172,6 +178,15 @@
MARC_COSIM_LIB="$MSCCOSIM_HOME/CoSim$MSCCOSIM_VERSION/Dcosim$MSCCOSIM_VERSION/lib"
fi
+# DAMASK uses the HDF5 compiler wrapper around the Intel compiler
+H5FC=$(h5fc -shlib -show)
+if [[ "$H5FC" == *"$dir is"* ]]; then
+ H5FC=$(echo $(echo "$H5FC" | tail -n1) | sed -e "s/\-shlib/-fPIC -qopenmp/g")
+ H5FC=${H5FC%-lmpifort*}
+fi
+HDF5_LIB=${H5FC//*ifort/}
+FCOMP="$H5FC"
+
# AEM
if test "$MARCDLLOUTDIR" = ""; then
DLLOUTDIR="$MARC_LIB"
@@ -604,7 +613,7 @@
PROFILE=" $PROFILE -pg"
fi
-FORT_OPT="-c -assume byterecl -safe-cray-ptr -mp1 -WB -fp-model source"
+FORT_OPT="-c -implicitnone -stand f18 -standard-semantics -assume nostd_mod_proc_name -safe-cray-ptr -mp1 -WB -fp-model source"
if test "$MTHREAD" = "OPENMP"
then
FORT_OPT=" $FORT_OPT -qopenmp"
@@ -617,7 +626,7 @@
FORT_OPT=" $FORT_OPT -save -zero"
fi
if test "$MARCHDF_HDF" = "HDF"; then
- FORT_OPT="$FORT_OPT -DMARCHDF_HDF=$MARCHDF_HDF $HDF_INCLUDE"
+ FORT_OPT="$FORT_OPT -DMARCHDF=$MARCHDF_HDF"
fi
FORTLOW="$FCOMP $FORT_OPT $PROFILE -O0 $I8FFLAGS -I$MARC_SOURCE/common \
@@ -631,6 +640,29 @@
# for compiling free form f90 files. high opt, integer(4)
FORTF90="$FCOMP -c -O3"
+# determine DAMASK version
+if test -n "$DAMASK_USER"; then
+ DAMASKROOT=`dirname $DAMASK_USER`/../..
+ read DAMASKVERSION < $DAMASKROOT/VERSION
+ DAMASKVERSION="'"$DAMASKVERSION"'"
+else
+ DAMASKVERSION="'N/A'"
+fi
+
+# DAMASK compiler calls
+DFORTLOWMP="$FCOMP -c -O0 -qno-offload -implicitnone -stand f18 -standard-semantics -assume nostd_mod_proc_name -safe-cray-ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
+ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMARC4DAMASK=2023.1 -DDAMASKVERSION=$DAMASKVERSION \
+ -qopenmp -qopenmp-threadprivate=compat\
+ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD -I$MARC_MOD"
+DFORTRANMP="$FCOMP -c -O1 -qno-offload -implicitnone -stand f18 -standard-semantics -assume nostd_mod_proc_name -safe-cray-ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
+ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMARC4DAMASK=2023.1 -DDAMASKVERSION=$DAMASKVERSION \
+ -qopenmp -qopenmp-threadprivate=compat\
+ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD -I$MARC_MOD"
+DFORTHIGHMP="$FCOMP -c -O3 -qno-offload -implicitnone -stand f18 -standard-semantics -assume nostd_mod_proc_name -safe-cray-ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
+ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMARC4DAMASK=2023.1 -DDAMASKVERSION=$DAMASKVERSION \
+ -qopenmp -qopenmp-threadprivate=compat\
+ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD -I$MARC_MOD"
+
if test "$MARCDEBUG" = "ON"
then
FORTLOW="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
@@ -788,7 +820,7 @@
SOLVERLIBS="${BCSSOLVERLIBS} ${VKISOLVERLIBS} ${CASISOLVERLIBS} ${MF2SOLVERLIBS} \
-L$MARC_MKL \
- $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/libkdtree2.a $MARC_LIB/libtetmeshinterface.a $MARC_LIB/libcaefatigueinterface.a -L$MARC_LIB -lmkl_blacs_intelmpi_ilp64 -lmkl_scalapack_ilp64 -lmkl_intel_ilp64 -lmkl_intel_thread -lmkl_core -liomp5 -ltetmesh -lmeshgems -lmg-tetra -lmeshgems_stubs -lmg-hybrid -lmg-cadsurf -lmg-hexa $HDF_LIBS $SOLVER2LIBS"
+ $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/libkdtree2.a $MARC_LIB/libtetmeshinterface.a $MARC_LIB/libcaefatigueinterface.a -L$MARC_LIB -lmkl_blacs_intelmpi_ilp64 -lmkl_scalapack_ilp64 -lmkl_intel_ilp64 -lmkl_intel_thread -lmkl_core -liomp5 -ltetmesh -lmeshgems -lmg-tetra -lmeshgems_stubs -lmg-hybrid -lmg-cadsurf -lmg-hexa $HDF5_LIB $SOLVER2LIBS"
SOLVERLIBS_DLL=${SOLVERLIBS}
if test "$AEM_DLL" -eq 1

517
install/MarcMentat/2023.1/Marc_tools/run_damask_hmp.patch vendored Normal file
View File

@ -0,0 +1,517 @@
---
+++
@@ -136,6 +136,11 @@
# is created. For job running in the background, the log #
# file is always created. Default is "yes" #
##############################################################################
+# remove all Mentat paths from LD_LIBRARY_PATH
+LD_LIBRARY_PATH=:$LD_LIBRARY_PATH:
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([!(:)])mentat2023.1+([!(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH#:}; LD_LIBRARY_PATH=${LD_LIBRARY_PATH%:}
# set DIR to the directory in which this script is
REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`"
DIR=`dirname $REALCOM`
@@ -302,7 +307,23 @@
. "$DIR/getarch"
+
+# getting user subroutine file name
+found=0
+for i in "$@"; do
+ if test $found = 1; then
+ DAMASK_USER=$i
+ found=0
+ fi
+ case $i in
+ -u* | -U*)
+ found=1
+ ;;
+ esac
+done
+# sourcing include_linux64 (needs DAMASK_USER to be set)
. $MARC_INCLUDE
+
#
#
@@ -405,7 +426,7 @@
did=
vid=
user=
-usersubname=
+usernoext=
objs=
qid=background
cpu=
@@ -676,50 +697,19 @@
esac
;;
-u* | -U*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ usernoext=$user
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
;;
-obj | -OBJ)
objs="$value"
@@ -1207,12 +1197,12 @@
fi
fi
fi
- if test "$usersubname"
+ if test "$user"
then
- if test ! -f $usersubname
+ if test ! -f $user
then
error="$error
-user subroutine file $usersubname not accessible"
+user subroutine file $user not accessible"
fi
fi
if test "$objs"
@@ -1531,7 +1521,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1564,7 +1554,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1687,7 +1677,7 @@
;;
esac
fi
- $ECHO "User subroutine name ($usersubname)? $ECHOTXT"
+ $ECHO "User subroutine name ($user)? $ECHOTXT"
read value
if test "$value"
then
@@ -1696,50 +1686,19 @@
user=
;;
*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ usernoext=$user
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
;;
esac
fi
@@ -2274,11 +2233,12 @@
#
# user subroutine used
#
+# add DAMASK options for linking
+ DAMASK="-lstdc++"
if test "$user"
then
-# program=$user.marc
- program=$DIRJOB/`$BASENAME $user .f`.marc
+ program=$usernoext.marc
case $program in
\/* | \.\/*)
bd=
@@ -2391,7 +2351,7 @@
fi
if test "$user"
then
- execpath=$DIRJOB/`$BASENAME $user .f`.marc
+ execpath=$usernoext.marc
usersub=1
fi
export execpath
@@ -3274,44 +3234,27 @@
echo
if test "$user"
then
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
- fi
-
+ userobj=$usernoext.o
fi
cat > $jid.runmarcscript << END4
if test "$user"
then
- if test ${basefile##*.} = f
- then
- ln -sf "$user.f" "$usersub"
- fi
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTHIGHMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTHIGHMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi
@@ -3330,6 +3273,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3343,6 +3287,9 @@
prgsav=yes
fi
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3389,7 +3336,7 @@
fi
else
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes
@@ -3555,7 +3502,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3568,21 +3515,21 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_hmp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
echo " $PRODUCT Exit number 3"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3592,39 +3539,27 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTHIGHMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTHIGHMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3643,6 +3578,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3684,6 +3620,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3777,7 +3716,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then
@@ -3902,7 +3841,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3915,20 +3854,20 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_hmp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3938,37 +3877,25 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTHIGHMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTHIGHMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3987,6 +3914,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -4027,7 +3955,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
-
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
# done if no job id given
if test -z "$jid"
then
@@ -4146,7 +4076,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then

517
install/MarcMentat/2023.1/Marc_tools/run_damask_lmp.patch vendored Normal file
View File

@ -0,0 +1,517 @@
---
+++
@@ -136,6 +136,11 @@
# is created. For job running in the background, the log #
# file is always created. Default is "yes" #
##############################################################################
+# remove all Mentat paths from LD_LIBRARY_PATH
+LD_LIBRARY_PATH=:$LD_LIBRARY_PATH:
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([!(:)])mentat2023.1+([!(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH#:}; LD_LIBRARY_PATH=${LD_LIBRARY_PATH%:}
# set DIR to the directory in which this script is
REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`"
DIR=`dirname $REALCOM`
@@ -302,7 +307,23 @@
. "$DIR/getarch"
+
+# getting user subroutine file name
+found=0
+for i in "$@"; do
+ if test $found = 1; then
+ DAMASK_USER=$i
+ found=0
+ fi
+ case $i in
+ -u* | -U*)
+ found=1
+ ;;
+ esac
+done
+# sourcing include_linux64 (needs DAMASK_USER to be set)
. $MARC_INCLUDE
+
#
#
@@ -405,7 +426,7 @@
did=
vid=
user=
-usersubname=
+usernoext=
objs=
qid=background
cpu=
@@ -676,50 +697,19 @@
esac
;;
-u* | -U*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ usernoext=$user
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
;;
-obj | -OBJ)
objs="$value"
@@ -1207,12 +1197,12 @@
fi
fi
fi
- if test "$usersubname"
+ if test "$user"
then
- if test ! -f $usersubname
+ if test ! -f $user
then
error="$error
-user subroutine file $usersubname not accessible"
+user subroutine file $user not accessible"
fi
fi
if test "$objs"
@@ -1531,7 +1521,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1564,7 +1554,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1687,7 +1677,7 @@
;;
esac
fi
- $ECHO "User subroutine name ($usersubname)? $ECHOTXT"
+ $ECHO "User subroutine name ($user)? $ECHOTXT"
read value
if test "$value"
then
@@ -1696,50 +1686,19 @@
user=
;;
*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ usernoext=$user
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
;;
esac
fi
@@ -2274,11 +2233,12 @@
#
# user subroutine used
#
+# add DAMASK options for linking
+ DAMASK="-lstdc++"
if test "$user"
then
-# program=$user.marc
- program=$DIRJOB/`$BASENAME $user .f`.marc
+ program=$usernoext.marc
case $program in
\/* | \.\/*)
bd=
@@ -2391,7 +2351,7 @@
fi
if test "$user"
then
- execpath=$DIRJOB/`$BASENAME $user .f`.marc
+ execpath=$usernoext.marc
usersub=1
fi
export execpath
@@ -3274,44 +3234,27 @@
echo
if test "$user"
then
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
- fi
-
+ userobj=$usernoext.o
fi
cat > $jid.runmarcscript << END4
if test "$user"
then
- if test ${basefile##*.} = f
- then
- ln -sf "$user.f" "$usersub"
- fi
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTLOWMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTLOWMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi
@@ -3330,6 +3273,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3343,6 +3287,9 @@
prgsav=yes
fi
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3389,7 +3336,7 @@
fi
else
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes
@@ -3555,7 +3502,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3568,21 +3515,21 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_lmp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
echo " $PRODUCT Exit number 3"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3592,39 +3539,27 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTLOWMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTLOWMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3643,6 +3578,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3684,6 +3620,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3777,7 +3716,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then
@@ -3902,7 +3841,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3915,20 +3854,20 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_lmp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3938,37 +3877,25 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTLOWMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTLOWMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3987,6 +3914,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -4027,7 +3955,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
-
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
# done if no job id given
if test -z "$jid"
then
@@ -4146,7 +4076,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then

517
install/MarcMentat/2023.1/Marc_tools/run_damask_mp.patch vendored Normal file
View File

@ -0,0 +1,517 @@
---
+++
@@ -136,6 +136,11 @@
# is created. For job running in the background, the log #
# file is always created. Default is "yes" #
##############################################################################
+# remove all Mentat paths from LD_LIBRARY_PATH
+LD_LIBRARY_PATH=:$LD_LIBRARY_PATH:
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([!(:)])mentat2023.1+([!(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH#:}; LD_LIBRARY_PATH=${LD_LIBRARY_PATH%:}
# set DIR to the directory in which this script is
REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`"
DIR=`dirname $REALCOM`
@@ -302,7 +307,23 @@
. "$DIR/getarch"
+
+# getting user subroutine file name
+found=0
+for i in "$@"; do
+ if test $found = 1; then
+ DAMASK_USER=$i
+ found=0
+ fi
+ case $i in
+ -u* | -U*)
+ found=1
+ ;;
+ esac
+done
+# sourcing include_linux64 (needs DAMASK_USER to be set)
. $MARC_INCLUDE
+
#
#
@@ -405,7 +426,7 @@
did=
vid=
user=
-usersubname=
+usernoext=
objs=
qid=background
cpu=
@@ -676,50 +697,19 @@
esac
;;
-u* | -U*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ usernoext=$user
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
;;
-obj | -OBJ)
objs="$value"
@@ -1207,12 +1197,12 @@
fi
fi
fi
- if test "$usersubname"
+ if test "$user"
then
- if test ! -f $usersubname
+ if test ! -f $user
then
error="$error
-user subroutine file $usersubname not accessible"
+user subroutine file $user not accessible"
fi
fi
if test "$objs"
@@ -1531,7 +1521,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1564,7 +1554,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1687,7 +1677,7 @@
;;
esac
fi
- $ECHO "User subroutine name ($usersubname)? $ECHOTXT"
+ $ECHO "User subroutine name ($user)? $ECHOTXT"
read value
if test "$value"
then
@@ -1696,50 +1686,19 @@
user=
;;
*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ usernoext=$user
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
+ usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
;;
esac
fi
@@ -2274,11 +2233,12 @@
#
# user subroutine used
#
+# add DAMASK options for linking
+ DAMASK="-lstdc++"
if test "$user"
then
-# program=$user.marc
- program=$DIRJOB/`$BASENAME $user .f`.marc
+ program=$usernoext.marc
case $program in
\/* | \.\/*)
bd=
@@ -2391,7 +2351,7 @@
fi
if test "$user"
then
- execpath=$DIRJOB/`$BASENAME $user .f`.marc
+ execpath=$usernoext.marc
usersub=1
fi
export execpath
@@ -3274,44 +3234,27 @@
echo
if test "$user"
then
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
- fi
-
+ userobj=$usernoext.o
fi
cat > $jid.runmarcscript << END4
if test "$user"
then
- if test ${basefile##*.} = f
- then
- ln -sf "$user.f" "$usersub"
- fi
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTRANMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTRANMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi
@@ -3330,6 +3273,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3343,6 +3287,9 @@
prgsav=yes
fi
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3389,7 +3336,7 @@
fi
else
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes
@@ -3555,7 +3502,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3568,21 +3515,21 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_mp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
echo " $PRODUCT Exit number 3"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3592,39 +3539,27 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTRANMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTRANMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3643,6 +3578,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3684,6 +3620,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3777,7 +3716,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then
@@ -3902,7 +3841,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3915,20 +3854,20 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_mp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3938,37 +3877,25 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTRANMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTRANMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3987,6 +3914,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -4027,7 +3955,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
-
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
# done if no job id given
if test -z "$jid"
then
@@ -4146,7 +4076,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then

24
install/MarcMentat/2023.1/Mentat_bin/edit_window.patch vendored Normal file
View File

@ -0,0 +1,24 @@
---
+++
@@ -1,18 +1,5 @@
#!/bin/sh
-# This script opens a window running an editor. The default window is an
-# xterm, and the default editor is vi. These may be customized.
+# This script opens a window running an editor.
+# The command to invoke the editor is specified during DAMASK installation
-dir=
-for d in /usr/bin /usr/bin/X11; do
- if test -x "$d/xterm"; then
- dir="$d"
- break
- fi
-done
-
-if test -z "$dir"; then
- echo "$0: Could not find xterm"
- exit 1
-fi
-
-"$dir/xterm" -T "vi $*" -n "vi $*" -e vi $*
+%EDITOR% $*

0
install/MarcMentat/2023.1/Mentat_bin/kill4.patch vendored Normal file
View File

0
install/MarcMentat/2023.1/Mentat_bin/kill5.patch vendored Normal file
View File

0
install/MarcMentat/2023.1/Mentat_bin/kill6.patch vendored Normal file
View File

38
install/MarcMentat/2023.1/Mentat_bin/submit4.patch vendored Normal file
View File

@ -0,0 +1,38 @@
---
+++
@@ -63,10 +63,10 @@
if [ "$slv" != "" -a "$slv" != "marc" -a "$slv" != "datfit" ]; then
slv="-iam sfm"
fi
-if [ "$slv" == "marc" ]; then
+if [ "$slv" = "marc" ]; then
slv=""
fi
-if [ "$slv" == "datfit" ]; then
+if [ "$slv" = "datfit" ]; then
slv="-iam datfit"
fi
@@ -91,6 +91,7 @@
srcfile="-u $srcfile -save y"
;;
runsaved)
+ srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
@@ -189,12 +190,12 @@
unset PYTHONPATH
if [ "$doe_first" = "-" ]; then # submit of regular Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b y $nprocds $nprocd \
+ "${DIR}/tools/run_damask_hmp" $slv -j $job -v n -b y $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
else # submit of a DoE Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b n $nprocds $nprocd \
+ "${DIR}/tools/run_damask_hmp" $slv -j $job -v n -b n $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu

38
install/MarcMentat/2023.1/Mentat_bin/submit5.patch vendored Normal file
View File

@ -0,0 +1,38 @@
---
+++
@@ -63,10 +63,10 @@
if [ "$slv" != "" -a "$slv" != "marc" -a "$slv" != "datfit" ]; then
slv="-iam sfm"
fi
-if [ "$slv" == "marc" ]; then
+if [ "$slv" = "marc" ]; then
slv=""
fi
-if [ "$slv" == "datfit" ]; then
+if [ "$slv" = "datfit" ]; then
slv="-iam datfit"
fi
@@ -91,6 +91,7 @@
srcfile="-u $srcfile -save y"
;;
runsaved)
+ srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
@@ -189,12 +190,12 @@
unset PYTHONPATH
if [ "$doe_first" = "-" ]; then # submit of regular Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b y $nprocds $nprocd \
+ "${DIR}/tools/run_damask_mp" $slv -j $job -v n -b y $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
else # submit of a DoE Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b n $nprocds $nprocd \
+ "${DIR}/tools/run_damask_mp" $slv -j $job -v n -b n $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu

38
install/MarcMentat/2023.1/Mentat_bin/submit6.patch vendored Normal file
View File

@ -0,0 +1,38 @@
---
+++
@@ -63,10 +63,10 @@
if [ "$slv" != "" -a "$slv" != "marc" -a "$slv" != "datfit" ]; then
slv="-iam sfm"
fi
-if [ "$slv" == "marc" ]; then
+if [ "$slv" = "marc" ]; then
slv=""
fi
-if [ "$slv" == "datfit" ]; then
+if [ "$slv" = "datfit" ]; then
slv="-iam datfit"
fi
@@ -91,6 +91,7 @@
srcfile="-u $srcfile -save y"
;;
runsaved)
+ srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
@@ -189,12 +190,12 @@
unset PYTHONPATH
if [ "$doe_first" = "-" ]; then # submit of regular Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b y $nprocds $nprocd \
+ "${DIR}/tools/run_damask_lmp" $slv -j $job -v n -b y $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
else # submit of a DoE Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b n $nprocds $nprocd \
+ "${DIR}/tools/run_damask_lmp" $slv -j $job -v n -b n $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu

158
install/MarcMentat/2023.1/Mentat_menus/job_run.ms.patch vendored Normal file
View File

@ -0,0 +1,158 @@
---
+++
@@ -362,11 +362,18 @@
}
button {
position +25 =
- size 25 4
+ size 18 4
text "ADVANCED JOB SUBMISSION"
help "job_run#Job Submission And Control"
popmenu job_submit_adv_pm
}
+ button {
+ position +18 =
+ size 7 4
+ text "DAMASK"
+ help "damask_run#Job Submission And Control"
+ popmenu damask
+ }
button {
position 0 +4
size 16 4
@@ -1303,6 +1310,135 @@
}
+#--------------------------------------------------------------------------------------------------
+popmenu damask {
+
+#ifdef QT_MENTAT
+ text "DAMASK.MPIE.DE"
+#endif
+
+ group {
+#ifndef QT_MENTAT
+ label {
+ position 0 0
+ size 50 4
+ text "DAMASK.MPIE.DE"
+ }
+#endif
+
+ label {
+ position 1 6
+ size 13 6
+ text "Optimzation"
+ border_width 1
+ border_color black
+ }
+
+ label {
+ position +13 =
+ size 20 6
+ text "write Input"
+ border_width 1
+ border_color black
+ }
+
+ label {
+ position +18 =
+ size 30 6
+ text "do not write Inp."
+ border_width 1
+ border_color black
+ }
+
+ label {
+ position -32 +6
+ size 12 6
+ text "O3 / OpenMP"
+ border_width 1
+ border_color black
+ }
+
+ popdown {
+ position +12 =
+ size 20 6
+ text "Submit"
+ command "*submit_job 4 *monitor_job"
+ }
+
+ popdown {
+ position +20 =
+ size 20 6
+ text "Execute"
+ command "*execute_job 4 *monitor_job"
+ }
+
+ label {
+ position -32 +6
+ size 12 6
+ text "O1 / OpenMP"
+ border_width 1
+ border_color black
+ }
+
+ popdown {
+ position +12 =
+ size 20 6
+ text "Submit"
+ command "*submit_job 5 *monitor_job"
+ }
+
+ popdown {
+ position +20 =
+ size 20 6
+ text "Execute"
+ command "*execute_job 5 *monitor_job"
+ }
+
+ label {
+ position -32 +6
+ size 12 6
+ text "O0 / OpenMP"
+ border_width 1
+ border_color black
+ }
+
+ popdown {
+ position +12 =
+ size 20 6
+ text "Submit"
+ command "*submit_job 6 *monitor_job"
+ }
+
+ popdown {
+ position +20 =
+ size 20 6
+ text "Execute"
+ command "*execute_job 6 *monitor_job"
+ }
+
+ popdown {
+ position 19 +8
+ size 12 8
+ text "CANCEL"
+ }
+}
+
+ window {
+ parent mentat
+ origin 38 8
+#ifdef DCOM
+ size 50 100
+#else
+ size 50 94
+#endif
+ background_color body
+ border_width 1
+ border_color border
+ buffering single
+ }
+ mode permanent
+}
+
#--------------------------------------------------------------------------------------------------
popmenu job_exit_msg_pm {

60
python/damask/_configmaterial.py
View File

@ -106,15 +106,12 @@ class ConfigMaterial(Config):
Load DREAM.3D (HDF5) file.
Data in DREAM.3D files can be stored per cell ('CellData')
and/or per grain ('Grain Data'). Per default, cell-wise data
is assumed.
damask.Grid.load_DREAM3D allows to get the corresponding geometry
for the grid solver.
and/or per grain ('Grain Data'). Per default, i.e. if
'grain_data' is None, cell-wise data is assumed.
Parameters
----------
fname : str
fname : str or pathlib.Path
Filename of the DREAM.3D (HDF5) file.
grain_data : str
Name of the group (folder) containing grain-wise data. Defaults
@ -140,36 +137,43 @@ class ConfigMaterial(Config):
and grain- or cell-wise data. Defaults to None, in which case
it is set as the path that contains _SIMPL_GEOMETRY/SPACING.
Notes
-----
Homogenization and phase entries are emtpy and need to be defined separately.
Returns
-------
loaded : damask.ConfigMaterial
Material configuration from file.
Notes
-----
damask.Grid.load_DREAM3D gives the corresponding geometry for
the grid solver.
For cell-wise data, only unique combinations of
orientation and phase are considered.
Homogenization and phase entries are emtpy and need to be
defined separately.
"""
b = util.DREAM3D_base_group(fname) if base_group is None else base_group
c = util.DREAM3D_cell_data_group(fname) if cell_data is None else cell_data
f = h5py.File(fname,'r')
with h5py.File(fname, 'r') as f:
b = util.DREAM3D_base_group(f) if base_group is None else base_group
c = util.DREAM3D_cell_data_group(f) if cell_data is None else cell_data
if grain_data is None:
phase = f['/'.join([b,c,phases])][()].flatten()
O = Rotation.from_Euler_angles(f['/'.join([b,c,Euler_angles])]).as_quaternion().reshape(-1,4) # noqa
_,idx = np.unique(np.hstack([O,phase.reshape(-1,1)]),return_index=True,axis=0)
idx = np.sort(idx)
else:
phase = f['/'.join([b,grain_data,phases])][()]
O = Rotation.from_Euler_angles(f['/'.join([b,grain_data,Euler_angles])]).as_quaternion() # noqa
idx = np.arange(phase.size)
if grain_data is None:
phase = f['/'.join([b,c,phases])][()].flatten()
O = Rotation.from_Euler_angles(f['/'.join([b,c,Euler_angles])]).as_quaternion().reshape(-1,4) # noqa
_,idx = np.unique(np.hstack([O,phase.reshape(-1,1)]),return_index=True,axis=0)
idx = np.sort(idx)
else:
phase = f['/'.join([b,grain_data,phases])][()]
O = Rotation.from_Euler_angles(f['/'.join([b,grain_data,Euler_angles])]).as_quaternion() # noqa
idx = np.arange(phase.size)
if cell_ensemble_data is not None and phase_names is not None:
try:
names = np.array([s.decode() for s in f['/'.join([b,cell_ensemble_data,phase_names])]])
phase = names[phase]
except KeyError:
pass
if cell_ensemble_data is not None and phase_names is not None:
try:
names = np.array([s.decode() for s in f['/'.join([b,cell_ensemble_data,phase_names])]])
phase = names[phase]
except KeyError:
pass
base_config = ConfigMaterial({'phase':{k if isinstance(k,int) else str(k): None for k in np.unique(phase)},

220
python/damask/_crystal.py
View File

@ -2,11 +2,11 @@ from typing import Optional, Union, Dict, List, Tuple
import numpy as np
from ._typehints import FloatSequence, CrystalFamily, CrystalLattice, CrystalKinematics
from ._typehints import FloatSequence, CrystalFamily, BravaisLattice, CrystalKinematics
from . import util
from . import Rotation
lattice_symmetries: Dict[CrystalLattice, CrystalFamily] = {
lattice_symmetries: Dict[BravaisLattice, CrystalFamily] = {
'aP': 'triclinic',
'mP': 'monoclinic',
@ -27,7 +27,7 @@ lattice_symmetries: Dict[CrystalLattice, CrystalFamily] = {
'cF': 'cubic',
}
orientation_relationships: Dict[str, Dict[CrystalLattice,np.ndarray]] = {
orientation_relationships: Dict[str, Dict[BravaisLattice,np.ndarray]] = {
'KS': {
'cF': np.array([
[[-1, 0, 1],[ 1, 1, 1]],
@ -323,7 +323,7 @@ class Crystal():
def __init__(self, *,
family: Optional[CrystalFamily] = None,
lattice: Optional[CrystalLattice] = None,
lattice: Optional[BravaisLattice] = None,
a: Optional[float] = None, b: Optional[float] = None, c: Optional[float] = None,
alpha: Optional[float] = None, beta: Optional[float] = None, gamma: Optional[float] = None,
degrees: bool = False):
@ -548,7 +548,17 @@ class Crystal():
@property
def symmetry_operations(self) -> Rotation:
"""Symmetry operations as Rotations."""
"""
Return symmetry operations.
References
----------
U.F. Kocks et al.,
Texture and Anisotropy:
Preferred Orientations in Polycrystals and their Effect on Materials Properties.
Cambridge University Press 1998. Table II
"""
_symmetry_operations: Dict[CrystalFamily, List] = {
'cubic': [
[ 1.0, 0.0, 0.0, 0.0 ],
@ -772,28 +782,28 @@ class Crystal():
Directions and planes of deformation mode families.
"""
_kinematics: Dict[CrystalLattice, Dict[CrystalKinematics, List[np.ndarray]]] = {
_kinematics: Dict[BravaisLattice, Dict[CrystalKinematics, List[np.ndarray]]] = {
'cF': {
'slip': [np.array([
[+0,+1,-1, +1,+1,+1],
[-1,+0,+1, +1,+1,+1],
[+1,-1,+0, +1,+1,+1],
[+0,-1,-1, -1,-1,+1],
[+1,+0,+1, -1,-1,+1],
[-1,+1,+0, -1,-1,+1],
[+0,-1,+1, +1,-1,-1],
[-1,+0,-1, +1,-1,-1],
[+1,+1,+0, +1,-1,-1],
[+0,+1,+1, -1,+1,-1],
[+1,+0,-1, -1,+1,-1],
[-1,-1,+0, -1,+1,-1]]),
[ 0,+1,-1, +1,+1,+1],
[-1, 0,+1, +1,+1,+1],
[+1,-1, 0, +1,+1,+1],
[ 0,-1,-1, -1,-1,+1],
[+1, 0,+1, -1,-1,+1],
[-1,+1, 0, -1,-1,+1],
[ 0,-1,+1, +1,-1,-1],
[-1, 0,-1, +1,-1,-1],
[+1,+1, 0, +1,-1,-1],
[ 0,+1,+1, -1,+1,-1],
[+1, 0,-1, -1,+1,-1],
[-1,-1, 0, -1,+1,-1]]),
np.array([
[+1,+1,+0, +1,-1,+0],
[+1,-1,+0, +1,+1,+0],
[+1,+0,+1, +1,+0,-1],
[+1,+0,-1, +1,+0,+1],
[+0,+1,+1, +0,+1,-1],
[+0,+1,-1, +0,+1,+1]])],
[+1,+1, 0, +1,-1, 0],
[+1,-1, 0, +1,+1, 0],
[+1, 0,+1, +1, 0,-1],
[+1, 0,-1, +1, 0,+1],
[ 0,+1,+1, 0,+1,-1],
[ 0,+1,-1, 0,+1,+1]])],
'twin': [np.array([
[-2, 1, 1, 1, 1, 1],
[ 1,-2, 1, 1, 1, 1],
@ -810,18 +820,18 @@ class Crystal():
},
'cI': {
'slip': [np.array([
[+1,-1,+1, +0,+1,+1],
[-1,-1,+1, +0,+1,+1],
[+1,+1,+1, +0,-1,+1],
[-1,+1,+1, +0,-1,+1],
[-1,+1,+1, +1,+0,+1],
[-1,-1,+1, +1,+0,+1],
[+1,+1,+1, -1,+0,+1],
[+1,-1,+1, -1,+0,+1],
[-1,+1,+1, +1,+1,+0],
[-1,+1,-1, +1,+1,+0],
[+1,+1,+1, -1,+1,+0],
[+1,+1,-1, -1,+1,+0]]),
[+1,-1,+1, 0,+1,+1],
[-1,-1,+1, 0,-1,-1],
[+1,+1,+1, 0,+1,-1],
[-1,+1,+1, 0,-1,+1],
[-1,+1,+1, -1, 0,-1],
[-1,-1,+1, +1, 0,+1],
[+1,+1,+1, -1, 0,+1],
[+1,-1,+1, +1, 0,-1],
[-1,+1,+1, +1,+1, 0],
[+1,-1,+1, -1,-1, 0],
[+1,+1,+1, +1,-1, 0],
[-1,-1,+1, -1,+1, 0]]),
np.array([
[-1,+1,+1, +2,+1,+1],
[+1,+1,+1, -2,+1,+1],
@ -876,33 +886,33 @@ class Crystal():
},
'hP': {
'slip': [np.array([
[+2,-1,-1,+0, +0,+0,+0,+1],
[-1,+2,-1,+0, +0,+0,+0,+1],
[-1,-1,+2,+0, +0,+0,+0,+1]]),
[+2,-1,-1, 0, 0, 0, 0,+1],
[-1,+2,-1, 0, 0, 0, 0,+1],
[-1,-1,+2, 0, 0, 0, 0,+1]]),
np.array([
[+2,-1,-1,+0, +0,+1,-1,+0],
[-1,+2,-1,+0, -1,+0,+1,+0],
[-1,-1,+2,+0, +1,-1,+0,+0]]),
[+2,-1,-1, 0, 0,+1,-1, 0],
[-1,+2,-1, 0, -1, 0,+1, 0],
[-1,-1,+2, 0, +1,-1, 0, 0]]),
np.array([
[-1,+2,-1,+0, +1,+0,-1,+1],
[-2,+1,+1,+0, +0,+1,-1,+1],
[-1,-1,+2,+0, -1,+1,+0,+1],
[+1,-2,+1,+0, -1,+0,+1,+1],
[+2,-1,-1,+0, +0,-1,+1,+1],
[+1,+1,-2,+0, +1,-1,+0,+1]]),
[-1,+2,-1, 0, +1, 0,-1,+1],
[-2,+1,+1, 0, 0,+1,-1,+1],
[-1,-1,+2, 0, -1,+1, 0,+1],
[+1,-2,+1, 0, -1, 0,+1,+1],
[+2,-1,-1, 0, 0,-1,+1,+1],
[+1,+1,-2, 0, +1,-1, 0,+1]]),
np.array([
[-2,+1,+1,+3, +1,+0,-1,+1],
[-1,-1,+2,+3, +1,+0,-1,+1],
[-1,-1,+2,+3, +0,+1,-1,+1],
[+1,-2,+1,+3, +0,+1,-1,+1],
[+1,-2,+1,+3, -1,+1,+0,+1],
[+2,-1,-1,+3, -1,+1,+0,+1],
[+2,-1,-1,+3, -1,+0,+1,+1],
[+1,+1,-2,+3, -1,+0,+1,+1],
[+1,+1,-2,+3, +0,-1,+1,+1],
[-1,+2,-1,+3, +0,-1,+1,+1],
[-1,+2,-1,+3, +1,-1,+0,+1],
[-2,+1,+1,+3, +1,-1,+0,+1]]),
[-2,+1,+1,+3, +1, 0,-1,+1],
[-1,-1,+2,+3, +1, 0,-1,+1],
[-1,-1,+2,+3, 0,+1,-1,+1],
[+1,-2,+1,+3, 0,+1,-1,+1],
[+1,-2,+1,+3, -1,+1, 0,+1],
[+2,-1,-1,+3, -1,+1, 0,+1],
[+2,-1,-1,+3, -1, 0,+1,+1],
[+1,+1,-2,+3, -1, 0,+1,+1],
[+1,+1,-2,+3, 0,-1,+1,+1],
[-1,+2,-1,+3, 0,-1,+1,+1],
[-1,+2,-1,+3, +1,-1, 0,+1],
[-2,+1,+1,+3, +1,-1, 0,+1]]),
np.array([
[-1,-1,+2,+3, +1,+1,-2,+2],
[+1,-2,+1,+3, -1,+2,-1,+2],
@ -941,61 +951,61 @@ class Crystal():
},
'tI': {
'slip': [np.array([
[+0,+0,+1, +1,+0,+0],
[+0,+0,+1, +0,+1,+0]]),
[ 0, 0,+1, +1, 0, 0],
[ 0, 0,+1, 0,+1, 0]]),
np.array([
[+0,+0,+1, +1,+1,+0],
[+0,+0,+1, -1,+1,+0]]),
[ 0, 0,+1, +1,+1, 0],
[ 0, 0,+1, -1,+1, 0]]),
np.array([
[+0,+1,+0, +1,+0,+0],
[+1,+0,+0, +0,+1,+0]]),
[ 0,+1, 0, +1, 0, 0],
[+1, 0, 0, 0,+1, 0]]),
np.array([
[+1,-1,+1, +1,+1,+0],
[+1,-1,-1, +1,+1,+0],
[-1,-1,-1, -1,+1,+0],
[-1,-1,+1, -1,+1,+0]]),
[+1,-1,+1, +1,+1, 0],
[+1,-1,-1, +1,+1, 0],
[-1,-1,-1, -1,+1, 0],
[-1,-1,+1, -1,+1, 0]]),
np.array([
[+1,-1,+0, +1,+1,+0],
[+1,+1,+0, +1,-1,+0]]),
[+1,-1, 0, +1,+1, 0],
[+1,+1, 0, +1,-1, 0]]),
np.array([
[+0,+1,+1, +1,+0,+0],
[+0,-1,+1, +1,+0,+0],
[-1,+0,+1, +0,+1,+0],
[+1,+0,+1, +0,+1,+0]]),
[ 0,+1,+1, +1, 0, 0],
[ 0,-1,+1, +1, 0, 0],
[-1, 0,+1, 0,+1, 0],
[+1, 0,+1, 0,+1, 0]]),
np.array([
[+0,+1,+0, +0,+0,+1],
[+1,+0,+0, +0,+0,+1]]),
[ 0,+1, 0, 0, 0,+1],
[+1, 0, 0, 0, 0,+1]]),
np.array([
[+1,+1,+0, +0,+0,+1],
[-1,+1,+0, +0,+0,+1]]),
[+1,+1, 0, 0, 0,+1],
[-1,+1, 0, 0, 0,+1]]),
np.array([
[+0,+1,-1, +0,+1,+1],
[+0,-1,-1, +0,-1,+1],
[-1,+0,-1, -1,+0,+1],
[+1,+0,-1, +1,+0,+1]]),
[ 0,+1,-1, 0,+1,+1],
[ 0,-1,-1, 0,-1,+1],
[-1, 0,-1, -1, 0,+1],
[+1, 0,-1, +1, 0,+1]]),
np.array([
[+1,-1,+1, +0,+1,+1],
[+1,+1,-1, +0,+1,+1],
[+1,+1,+1, +0,+1,-1],
[-1,+1,+1, +0,+1,-1],
[+1,-1,-1, +1,+0,+1],
[-1,-1,+1, +1,+0,+1],
[+1,+1,+1, +1,+0,-1],
[+1,-1,+1, +1,+0,-1]]),
[+1,-1,+1, 0,+1,+1],
[+1,+1,-1, 0,+1,+1],
[+1,+1,+1, 0,+1,-1],
[-1,+1,+1, 0,+1,-1],
[+1,-1,-1, +1, 0,+1],
[-1,-1,+1, +1, 0,+1],
[+1,+1,+1, +1, 0,-1],
[+1,-1,+1, +1, 0,-1]]),
np.array([
[+1,+0,+0, +0,+1,+1],
[+1,+0,+0, +0,+1,-1],
[+0,+1,+0, +1,+0,+1],
[+0,+1,+0, +1,+0,-1]]),
[+1, 0, 0, 0,+1,+1],
[+1, 0, 0, 0,+1,-1],
[ 0,+1, 0, +1, 0,+1],
[ 0,+1, 0, +1, 0,-1]]),
np.array([
[+0,+1,-1, +2,+1,+1],
[+0,-1,-1, +2,-1,+1],
[+1,+0,-1, +1,+2,+1],
[-1,+0,-1, -1,+2,+1],
[+0,+1,-1, -2,+1,+1],
[+0,-1,-1, -2,-1,+1],
[-1,+0,-1, -1,-2,+1],
[+1,+0,-1, +1,-2,+1]]),
[ 0,+1,-1, +2,+1,+1],
[ 0,-1,-1, +2,-1,+1],
[+1, 0,-1, +1,+2,+1],
[-1, 0,-1, -1,+2,+1],
[ 0,+1,-1, -2,+1,+1],
[ 0,-1,-1, -2,-1,+1],
[-1, 0,-1, -1,-2,+1],
[+1, 0,-1, +1,-2,+1]]),
np.array([
[-1,+1,+1, +2,+1,+1],
[-1,-1,+1, +2,-1,+1],
@ -1015,7 +1025,7 @@ class Crystal():
def relation_operations(self,
model: str) -> Tuple[CrystalLattice, Rotation]:
model: str) -> Tuple[BravaisLattice, Rotation]:
"""
Crystallographic orientation relationships for phase transformations.

44
python/damask/_grid.py
View File

@ -358,14 +358,14 @@ class Grid:
"""
Load DREAM.3D (HDF5) file.
Data in DREAM.3D files can be stored per cell ('CellData') and/or
per grain ('Grain Data'). Per default, cell-wise data is assumed.
Data in DREAM.3D files can be stored per cell ('CellData')
and/or per grain ('Grain Data'). Per default, i.e. if
'feature_IDs' is None, cell-wise data is assumed.
damask.ConfigMaterial.load_DREAM3D gives the corresponding material definition.
Parameters
----------
fname : str or or pathlib.Path
fname : str or pathlib.Path
Filename of the DREAM.3D (HDF5) file.
feature_IDs : str, optional
Name of the dataset containing the mapping between cells and
@ -392,23 +392,31 @@ class Grid:
loaded : damask.Grid
Grid-based geometry from file.
Notes
-----
damask.ConfigMaterial.load_DREAM3D gives the corresponding
material definition.
For cell-wise data, only unique combinations of
orientation and phase are considered.
"""
b = util.DREAM3D_base_group(fname) if base_group is None else base_group
c = util.DREAM3D_cell_data_group(fname) if cell_data is None else cell_data
f = h5py.File(fname, 'r')
with h5py.File(fname, 'r') as f:
b = util.DREAM3D_base_group(f) if base_group is None else base_group
c = util.DREAM3D_cell_data_group(f) if cell_data is None else cell_data
cells = f['/'.join([b,'_SIMPL_GEOMETRY','DIMENSIONS'])][()]
size = f['/'.join([b,'_SIMPL_GEOMETRY','SPACING'])] * cells
origin = f['/'.join([b,'_SIMPL_GEOMETRY','ORIGIN'])][()]
cells = f['/'.join([b,'_SIMPL_GEOMETRY','DIMENSIONS'])][()]
size = f['/'.join([b,'_SIMPL_GEOMETRY','SPACING'])] * cells
origin = f['/'.join([b,'_SIMPL_GEOMETRY','ORIGIN'])][()]
if feature_IDs is None:
phase = f['/'.join([b,c,phases])][()].reshape(-1,1)
O = Rotation.from_Euler_angles(f['/'.join([b,c,Euler_angles])]).as_quaternion().reshape(-1,4) # noqa
unique,unique_inverse = np.unique(np.hstack([O,phase]),return_inverse=True,axis=0)
ma = np.arange(cells.prod()) if len(unique) == cells.prod() else \
np.arange(unique.size)[np.argsort(pd.unique(unique_inverse))][unique_inverse]
else:
ma = f['/'.join([b,c,feature_IDs])][()].flatten()
if feature_IDs is None:
phase = f['/'.join([b,c,phases])][()].reshape(-1,1)
O = Rotation.from_Euler_angles(f['/'.join([b,c,Euler_angles])]).as_quaternion().reshape(-1,4) # noqa
unique,unique_inverse = np.unique(np.hstack([O,phase]),return_inverse=True,axis=0)
ma = np.arange(cells.prod()) if len(unique) == cells.prod() else \
np.arange(unique.size)[np.argsort(pd.unique(unique_inverse))][unique_inverse]
else:
ma = f['/'.join([b,c,feature_IDs])][()].flatten()
return Grid(material = ma.reshape(cells,order='F'),
size = size,

8
python/damask/_orientation.py
View File

@ -3,7 +3,7 @@ from typing import Optional, Union, TypeVar
import numpy as np
from ._typehints import FloatSequence, IntSequence, CrystalFamily, CrystalLattice
from ._typehints import FloatSequence, IntSequence, CrystalFamily, BravaisLattice
from . import Rotation
from . import Crystal
from . import util
@ -73,7 +73,7 @@ class Orientation(Rotation,Crystal):
rotation: Union[FloatSequence, Rotation] = np.array([1.,0.,0.,0.]),
*,
family: Optional[CrystalFamily] = None,
lattice: Optional[CrystalLattice] = None,
lattice: Optional[BravaisLattice] = None,
a: Optional[float] = None, b: Optional[float] = None, c: Optional[float] = None,
alpha: Optional[float] = None, beta: Optional[float] = None, gamma: Optional[float] = None,
degrees: bool = False):
@ -804,7 +804,7 @@ class Orientation(Rotation,Crystal):
blend += sym_ops.shape
v = sym_ops.broadcast_to(shape) \
@ np.broadcast_to(v.reshape(util.shapeshifter(v.shape,shape+(3,))),shape+(3,))
return ~(self.broadcast_to(blend))@ np.broadcast_to(v,blend+(3,))
return ~(self.broadcast_to(blend))@np.broadcast_to(v,blend+(3,))
def Schmid(self, *,
@ -833,7 +833,7 @@ class Orientation(Rotation,Crystal):
>>> import damask
>>> np.set_printoptions(3,suppress=True,floatmode='fixed')
>>> O = damask.Orientation.from_Euler_angles(phi=[0,45,0],degrees=True,lattice='cF')
>>> O.Schmid(N_slip=[1])
>>> O.Schmid(N_slip=[12])[0]
array([[ 0.000, 0.000, 0.000],
[ 0.577, -0.000, 0.816],
[ 0.000, 0.000, 0.000]])

727
python/damask/_result.py
View File

@ -1,5 +1,3 @@
import multiprocessing as mp
from multiprocessing.synchronize import Lock
import re
import fnmatch
import os
@ -7,8 +5,8 @@ import copy
import datetime
import xml.etree.ElementTree as ET # noqa
import xml.dom.minidom
import functools
from pathlib import Path
from functools import partial
from collections import defaultdict
from collections.abc import Iterable
from typing import Optional, Union, Callable, Any, Sequence, Literal, Dict, List, Tuple
@ -626,17 +624,6 @@ class Result:
f['/geometry/T_c'].attrs['VTK_TYPE'].decode())
@staticmethod
def _add_absolute(x: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': np.abs(x['data']),
'label': f'|{x["label"]}|',
'meta': {
'unit': x['meta']['unit'],
'description': f"absolute value of {x['label']} ({x['meta']['description']})",
'creator': 'add_absolute'
}
}
def add_absolute(self, x: str):
"""
Add absolute value.
@ -647,28 +634,20 @@ class Result:
Name of scalar, vector, or tensor dataset to take absolute value of.
"""
self._add_generic_pointwise(self._add_absolute,{'x':x})
def absolute(x: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': np.abs(x['data']),
'label': f'|{x["label"]}|',
'meta': {
'unit': x['meta']['unit'],
'description': f"absolute value of {x['label']} ({x['meta']['description']})",
'creator': 'add_absolute'
}
}
self._add_generic_pointwise(absolute,{'x':x})
@staticmethod
def _add_calculation(**kwargs) -> Dict[str, Any]:
formula = kwargs['formula']
for d in re.findall(r'#(.*?)#',formula):
formula = formula.replace(f'#{d}#',f"kwargs['{d}']['data']")
data = eval(formula)
if not hasattr(data,'shape') or data.shape[0] != kwargs[d]['data'].shape[0]:
raise ValueError('"{}" results in invalid shape'.format(kwargs['formula']))
return {
'data': data,
'label': kwargs['label'],
'meta': {
'unit': kwargs['unit'],
'description': f"{kwargs['description']} (formula: {kwargs['formula']})",
'creator': 'add_calculation'
}
}
def add_calculation(self,
formula: str,
name: str,
@ -717,24 +696,30 @@ class Result:
... 'Mises equivalent of the Cauchy stress')
"""
def calculation(**kwargs) -> Dict[str, Any]:
formula = kwargs['formula']
for d in re.findall(r'#(.*?)#',formula):
formula = formula.replace(f'#{d}#',f"kwargs['{d}']['data']")
data = eval(formula)
if not hasattr(data,'shape') or data.shape[0] != kwargs[d]['data'].shape[0]:
raise ValueError('"{}" results in invalid shape'.format(kwargs['formula']))
return {
'data': data,
'label': kwargs['label'],
'meta': {
'unit': kwargs['unit'],
'description': f"{kwargs['description']} (formula: {kwargs['formula']})",
'creator': 'add_calculation'
}
}
dataset_mapping = {d:d for d in set(re.findall(r'#(.*?)#',formula))} # datasets used in the formula
args = {'formula':formula,'label':name,'unit':unit,'description':description}
self._add_generic_pointwise(self._add_calculation,dataset_mapping,args)
self._add_generic_pointwise(calculation,dataset_mapping,args)
@staticmethod
def _add_stress_Cauchy(P: Dict[str, Any], F: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': mechanics.stress_Cauchy(P['data'],F['data']),
'label': 'sigma',
'meta': {
'unit': P['meta']['unit'],
'description': "Cauchy stress calculated "
f"from {P['label']} ({P['meta']['description']})"
f" and {F['label']} ({F['meta']['description']})",
'creator': 'add_stress_Cauchy'
}
}
def add_stress_Cauchy(self,
P: str = 'P',
F: str = 'F'):
@ -751,20 +736,23 @@ class Result:
Defaults to 'F'.
"""
self._add_generic_pointwise(self._add_stress_Cauchy,{'P':P,'F':F})
def stress_Cauchy(P: Dict[str, Any], F: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': mechanics.stress_Cauchy(P['data'],F['data']),
'label': 'sigma',
'meta': {
'unit': P['meta']['unit'],
'description': "Cauchy stress calculated "
f"from {P['label']} ({P['meta']['description']})"
f" and {F['label']} ({F['meta']['description']})",
'creator': 'add_stress_Cauchy'
}
}
self._add_generic_pointwise(stress_Cauchy,{'P':P,'F':F})
@staticmethod
def _add_determinant(T: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': np.linalg.det(T['data']),
'label': f"det({T['label']})",
'meta': {
'unit': T['meta']['unit'],
'description': f"determinant of tensor {T['label']} ({T['meta']['description']})",
'creator': 'add_determinant'
}
}
def add_determinant(self, T: str):
"""
Add the determinant of a tensor.
@ -783,20 +771,21 @@ class Result:
>>> r.add_determinant('F_p')
"""
self._add_generic_pointwise(self._add_determinant,{'T':T})
def determinant(T: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': np.linalg.det(T['data']),
'label': f"det({T['label']})",
'meta': {
'unit': T['meta']['unit'],
'description': f"determinant of tensor {T['label']} ({T['meta']['description']})",
'creator': 'add_determinant'
}
}
self._add_generic_pointwise(determinant,{'T':T})
@staticmethod
def _add_deviator(T: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': tensor.deviatoric(T['data']),
'label': f"s_{T['label']}",
'meta': {
'unit': T['meta']['unit'],
'description': f"deviator of tensor {T['label']} ({T['meta']['description']})",
'creator': 'add_deviator'
}
}
def add_deviator(self, T: str):
"""
Add the deviatoric part of a tensor.
@ -815,29 +804,21 @@ class Result:
>>> r.add_deviator('sigma')
"""
self._add_generic_pointwise(self._add_deviator,{'T':T})
def deviator(T: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': tensor.deviatoric(T['data']),
'label': f"s_{T['label']}",
'meta': {
'unit': T['meta']['unit'],
'description': f"deviator of tensor {T['label']} ({T['meta']['description']})",
'creator': 'add_deviator'
}
}
self._add_generic_pointwise(deviator,{'T':T})
@staticmethod
def _add_eigenvalue(T_sym: Dict[str, Any], eigenvalue: Literal['max, mid, min']) -> Dict[str, Any]:
if eigenvalue == 'max':
label,p = 'maximum',2
elif eigenvalue == 'mid':
label,p = 'intermediate',1
elif eigenvalue == 'min':
label,p = 'minimum',0
else:
raise ValueError(f'invalid eigenvalue: {eigenvalue}')
return {
'data': tensor.eigenvalues(T_sym['data'])[:,p],
'label': f"lambda_{eigenvalue}({T_sym['label']})",
'meta' : {
'unit': T_sym['meta']['unit'],
'description': f"{label} eigenvalue of {T_sym['label']} ({T_sym['meta']['description']})",
'creator': 'add_eigenvalue'
}
}
def add_eigenvalue(self,
T_sym: str,
eigenvalue: Literal['max', 'mid', 'min'] = 'max'):
@ -860,30 +841,30 @@ class Result:
>>> r.add_eigenvalue('sigma','min')
"""
self._add_generic_pointwise(self._add_eigenvalue,{'T_sym':T_sym},{'eigenvalue':eigenvalue})
def eigenval(T_sym: Dict[str, Any], eigenvalue: Literal['max, mid, min']) -> Dict[str, Any]:
if eigenvalue == 'max':
label,p = 'maximum',2
elif eigenvalue == 'mid':
label,p = 'intermediate',1
elif eigenvalue == 'min':
label,p = 'minimum',0
else:
raise ValueError(f'invalid eigenvalue: {eigenvalue}')
return {
'data': tensor.eigenvalues(T_sym['data'])[:,p],
'label': f"lambda_{eigenvalue}({T_sym['label']})",
'meta' : {
'unit': T_sym['meta']['unit'],
'description': f"{label} eigenvalue of {T_sym['label']} ({T_sym['meta']['description']})",
'creator': 'add_eigenvalue'
}
}
self._add_generic_pointwise(eigenval,{'T_sym':T_sym},{'eigenvalue':eigenvalue})
@staticmethod
def _add_eigenvector(T_sym: Dict[str, Any], eigenvalue: Literal['max', 'mid', 'min']) -> Dict[str, Any]:
if eigenvalue == 'max':
label,p = 'maximum',2
elif eigenvalue == 'mid':
label,p = 'intermediate',1
elif eigenvalue == 'min':
label,p = 'minimum',0
else:
raise ValueError(f'invalid eigenvalue: {eigenvalue}')
return {
'data': tensor.eigenvectors(T_sym['data'])[:,p],
'label': f"v_{eigenvalue}({T_sym['label']})",
'meta' : {
'unit': '1',
'description': f"eigenvector corresponding to {label} eigenvalue"
f" of {T_sym['label']} ({T_sym['meta']['description']})",
'creator': 'add_eigenvector'
}
}
def add_eigenvector(self,
T_sym: str,
eigenvalue: Literal['max', 'mid', 'min'] = 'max'):
@ -899,25 +880,31 @@ class Result:
Defaults to 'max'.
"""
self._add_generic_pointwise(self._add_eigenvector,{'T_sym':T_sym},{'eigenvalue':eigenvalue})
def eigenvector(T_sym: Dict[str, Any], eigenvalue: Literal['max', 'mid', 'min']) -> Dict[str, Any]:
if eigenvalue == 'max':
label,p = 'maximum',2
elif eigenvalue == 'mid':
label,p = 'intermediate',1
elif eigenvalue == 'min':
label,p = 'minimum',0
else:
raise ValueError(f'invalid eigenvalue: {eigenvalue}')
return {
'data': tensor.eigenvectors(T_sym['data'])[:,p],
'label': f"v_{eigenvalue}({T_sym['label']})",
'meta' : {
'unit': '1',
'description': f"eigenvector corresponding to {label} eigenvalue"
f" of {T_sym['label']} ({T_sym['meta']['description']})",
'creator': 'add_eigenvector'
}
}
self._add_generic_pointwise(eigenvector,{'T_sym':T_sym},{'eigenvalue':eigenvalue})
@staticmethod
def _add_IPF_color(l: FloatSequence, q: Dict[str, Any]) -> Dict[str, Any]:
m = util.scale_to_coprime(np.array(l))
lattice = q['meta']['lattice']
o = Orientation(rotation = q['data'],lattice=lattice)
return {
'data': np.uint8(o.IPF_color(l)*255),
'label': 'IPFcolor_({} {} {})'.format(*m),
'meta' : {
'unit': '8-bit RGB',
'lattice': q['meta']['lattice'],
'description': 'Inverse Pole Figure (IPF) colors along sample direction ({} {} {})'.format(*m),
'creator': 'add_IPF_color'
}
}
def add_IPF_color(self,
l: FloatSequence,
q: str = 'O'):
@ -941,20 +928,26 @@ class Result:
>>> r.add_IPF_color(np.array([0,1,1]))
"""
self._add_generic_pointwise(self._add_IPF_color,{'q':q},{'l':l})
def IPF_color(l: FloatSequence, q: Dict[str, Any]) -> Dict[str, Any]:
m = util.scale_to_coprime(np.array(l))
lattice = q['meta']['lattice']
o = Orientation(rotation = q['data'],lattice=lattice)
return {
'data': np.uint8(o.IPF_color(l)*255),
'label': 'IPFcolor_({} {} {})'.format(*m),
'meta' : {
'unit': '8-bit RGB',
'lattice': q['meta']['lattice'],
'description': 'Inverse Pole Figure (IPF) colors along sample direction ({} {} {})'.format(*m),
'creator': 'add_IPF_color'
}
}
self._add_generic_pointwise(IPF_color,{'q':q},{'l':l})
@staticmethod
def _add_maximum_shear(T_sym: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': mechanics.maximum_shear(T_sym['data']),
'label': f"max_shear({T_sym['label']})",
'meta': {
'unit': T_sym['meta']['unit'],
'description': f"maximum shear component of {T_sym['label']} ({T_sym['meta']['description']})",
'creator': 'add_maximum_shear'
}
}
def add_maximum_shear(self, T_sym: str):
"""
Add maximum shear components of symmetric tensor.
@ -965,30 +958,20 @@ class Result:
Name of symmetric tensor dataset.
"""
self._add_generic_pointwise(self._add_maximum_shear,{'T_sym':T_sym})
def maximum_shear(T_sym: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': mechanics.maximum_shear(T_sym['data']),
'label': f"max_shear({T_sym['label']})",
'meta': {
'unit': T_sym['meta']['unit'],
'description': f"maximum shear component of {T_sym['label']} ({T_sym['meta']['description']})",
'creator': 'add_maximum_shear'
}
}
self._add_generic_pointwise(maximum_shear,{'T_sym':T_sym})
@staticmethod
def _add_equivalent_Mises(T_sym: Dict[str, Any], kind: str) -> Dict[str, Any]:
k = kind
if k is None:
if T_sym['meta']['unit'] == '1':
k = 'strain'
elif T_sym['meta']['unit'] == 'Pa':
k = 'stress'
if k not in ['stress', 'strain']:
raise ValueError(f'invalid von Mises kind "{kind}"')
return {
'data': (mechanics.equivalent_strain_Mises if k=='strain' else \
mechanics.equivalent_stress_Mises)(T_sym['data']),
'label': f"{T_sym['label']}_vM",
'meta': {
'unit': T_sym['meta']['unit'],
'description': f"Mises equivalent {k} of {T_sym['label']} ({T_sym['meta']['description']})",
'creator': 'add_Mises'
}
}
def add_equivalent_Mises(self,
T_sym: str,
kind: Optional[str] = None):
@ -1018,32 +1001,30 @@ class Result:
>>> r.add_equivalent_Mises('epsilon_V^0.0(F)')
"""
self._add_generic_pointwise(self._add_equivalent_Mises,{'T_sym':T_sym},{'kind':kind})
def equivalent_Mises(T_sym: Dict[str, Any], kind: str) -> Dict[str, Any]:
k = kind
if k is None:
if T_sym['meta']['unit'] == '1':
k = 'strain'
elif T_sym['meta']['unit'] == 'Pa':
k = 'stress'
if k not in ['stress', 'strain']:
raise ValueError(f'invalid von Mises kind "{kind}"')
return {
'data': (mechanics.equivalent_strain_Mises if k=='strain' else \
mechanics.equivalent_stress_Mises)(T_sym['data']),
'label': f"{T_sym['label']}_vM",
'meta': {
'unit': T_sym['meta']['unit'],
'description': f"Mises equivalent {k} of {T_sym['label']} ({T_sym['meta']['description']})",
'creator': 'add_Mises'
}
}
self._add_generic_pointwise(equivalent_Mises,{'T_sym':T_sym},{'kind':kind})
@staticmethod
def _add_norm(x: Dict[str, Any], ord: Union[int, float, Literal['fro', 'nuc']]) -> Dict[str, Any]:
o = ord
if len(x['data'].shape) == 2:
axis: Union[int, Tuple[int, int]] = 1
t = 'vector'
if o is None: o = 2
elif len(x['data'].shape) == 3:
axis = (1,2)
t = 'tensor'
if o is None: o = 'fro'
else:
raise ValueError(f'invalid shape of {x["label"]}')
return {
'data': np.linalg.norm(x['data'],ord=o,axis=axis,keepdims=True),
'label': f"|{x['label']}|_{o}",
'meta': {
'unit': x['meta']['unit'],
'description': f"{o}-norm of {t} {x['label']} ({x['meta']['description']})",
'creator': 'add_norm'
}
}
def add_norm(self,
x: str,
ord: Union[None, int, float, Literal['fro', 'nuc']] = None):
@ -1058,22 +1039,32 @@ class Result:
Order of the norm. inf means NumPy's inf object. For details refer to numpy.linalg.norm.
"""
self._add_generic_pointwise(self._add_norm,{'x':x},{'ord':ord})
def norm(x: Dict[str, Any], ord: Union[int, float, Literal['fro', 'nuc']]) -> Dict[str, Any]:
o = ord
if len(x['data'].shape) == 2:
axis: Union[int, Tuple[int, int]] = 1
t = 'vector'
if o is None: o = 2
elif len(x['data'].shape) == 3:
axis = (1,2)
t = 'tensor'
if o is None: o = 'fro'
else:
raise ValueError(f'invalid shape of {x["label"]}')
return {
'data': np.linalg.norm(x['data'],ord=o,axis=axis,keepdims=True),
'label': f"|{x['label']}|_{o}",
'meta': {
'unit': x['meta']['unit'],
'description': f"{o}-norm of {t} {x['label']} ({x['meta']['description']})",
'creator': 'add_norm'
}
}
self._add_generic_pointwise(norm,{'x':x},{'ord':ord})
@staticmethod
def _add_stress_second_Piola_Kirchhoff(P: Dict[str, Any], F: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': mechanics.stress_second_Piola_Kirchhoff(P['data'],F['data']),
'label': 'S',
'meta': {
'unit': P['meta']['unit'],
'description': "second Piola-Kirchhoff stress calculated "
f"from {P['label']} ({P['meta']['description']})"
f" and {F['label']} ({F['meta']['description']})",
'creator': 'add_stress_second_Piola_Kirchhoff'
}
}
def add_stress_second_Piola_Kirchhoff(self,
P: str = 'P',
F: str = 'F'):
@ -1096,34 +1087,23 @@ class Result:
is taken into account.
"""
self._add_generic_pointwise(self._add_stress_second_Piola_Kirchhoff,{'P':P,'F':F})
def stress_second_Piola_Kirchhoff(P: Dict[str, Any], F: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': mechanics.stress_second_Piola_Kirchhoff(P['data'],F['data']),
'label': 'S',
'meta': {
'unit': P['meta']['unit'],
'description': "second Piola-Kirchhoff stress calculated "
f"from {P['label']} ({P['meta']['description']})"
f" and {F['label']} ({F['meta']['description']})",
'creator': 'add_stress_second_Piola_Kirchhoff'
}
}
self._add_generic_pointwise(stress_second_Piola_Kirchhoff,{'P':P,'F':F})
@staticmethod
def _add_pole(q: Dict[str, Any],
uvw: FloatSequence,
hkl: FloatSequence,
with_symmetry: bool,
normalize: bool) -> Dict[str, Any]:
c = q['meta']['c/a'] if 'c/a' in q['meta'] else 1
brackets = ['[]','()','⟨⟩','{}'][(uvw is None)*1+with_symmetry*2]
label = 'p^' + '{}{} {} {}{}'.format(brackets[0],
*(uvw if uvw else hkl),
brackets[-1],)
ori = Orientation(q['data'],lattice=q['meta']['lattice'],a=1,c=c)
return {
'data': ori.to_pole(uvw=uvw,hkl=hkl,with_symmetry=with_symmetry,normalize=normalize),
'label': label,
'meta' : {
'unit': '1',
'description': f'{"normalized " if normalize else ""}lab frame vector along lattice ' \
+ ('direction' if uvw is not None else 'plane') \
+ ('s' if with_symmetry else ''),
'creator': 'add_pole'
}
}
def add_pole(self,
q: str = 'O',
*,
@ -1149,22 +1129,33 @@ class Result:
Defaults to True.
"""
self._add_generic_pointwise(self._add_pole,
{'q':q},
{'uvw':uvw,'hkl':hkl,'with_symmetry':with_symmetry,'normalize':normalize})
def pole(q: Dict[str, Any],
uvw: FloatSequence,
hkl: FloatSequence,
with_symmetry: bool,
normalize: bool) -> Dict[str, Any]:
c = q['meta']['c/a'] if 'c/a' in q['meta'] else 1
brackets = ['[]','()','⟨⟩','{}'][(uvw is None)*1+with_symmetry*2]
label = 'p^' + '{}{} {} {}{}'.format(brackets[0],
*(uvw if uvw else hkl),
brackets[-1],)
ori = Orientation(q['data'],lattice=q['meta']['lattice'],a=1,c=c)
return {
'data': ori.to_pole(uvw=uvw,hkl=hkl,with_symmetry=with_symmetry,normalize=normalize),
'label': label,
'meta' : {
'unit': '1',
'description': f'{"normalized " if normalize else ""}lab frame vector along lattice ' \
+ ('direction' if uvw is not None else 'plane') \
+ ('s' if with_symmetry else ''),
'creator': 'add_pole'
}
}
self._add_generic_pointwise(pole,{'q':q},{'uvw':uvw,'hkl':hkl,'with_symmetry':with_symmetry,'normalize':normalize})
@staticmethod
def _add_rotation(F: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': mechanics.rotation(F['data']).as_matrix(),
'label': f"R({F['label']})",
'meta': {
'unit': F['meta']['unit'],
'description': f"rotational part of {F['label']} ({F['meta']['description']})",
'creator': 'add_rotation'
}
}
def add_rotation(self, F: str):
"""
Add rotational part of a deformation gradient.
@ -1183,20 +1174,20 @@ class Result:
>>> r.add_rotation('F')
"""
self._add_generic_pointwise(self._add_rotation,{'F':F})
def rotation(F: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': mechanics.rotation(F['data']).as_matrix(),
'label': f"R({F['label']})",
'meta': {
'unit': F['meta']['unit'],
'description': f"rotational part of {F['label']} ({F['meta']['description']})",
'creator': 'add_rotation'
}
}
self._add_generic_pointwise(rotation,{'F':F})
@staticmethod
def _add_spherical(T: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': tensor.spherical(T['data'],False),
'label': f"p_{T['label']}",
'meta': {
'unit': T['meta']['unit'],
'description': f"spherical component of tensor {T['label']} ({T['meta']['description']})",
'creator': 'add_spherical'
}
}
def add_spherical(self, T: str):
"""
Add the spherical (hydrostatic) part of a tensor.
@ -1215,30 +1206,29 @@ class Result:
>>> r.add_spherical('sigma')
"""
self._add_generic_pointwise(self._add_spherical,{'T':T})
def spherical(T: Dict[str, Any]) -> Dict[str, Any]:
return {
'data': tensor.spherical(T['data'],False),
'label': f"p_{T['label']}",
'meta': {
'unit': T['meta']['unit'],
'description': f"spherical component of tensor {T['label']} ({T['meta']['description']})",
'creator': 'add_spherical'
}
}
self._add_generic_pointwise(spherical,{'T':T})
@staticmethod
def _add_strain(F: Dict[str, Any], t: Literal['V', 'U'], m: float) -> Dict[str, Any]:
side = 'left' if t == 'V' else 'right'
return {
'data': mechanics.strain(F['data'],t,m),
'label': f"epsilon_{t}^{m}({F['label']})",
'meta': {
'unit': F['meta']['unit'],
'description': f'strain tensor of order {m} based on {side} stretch tensor '+\
f"of {F['label']} ({F['meta']['description']})",
'creator': 'add_strain'
}
}
def add_strain(self,
F: str = 'F',
t: Literal['V', 'U'] = 'V',
m: float = 0.0):
"""
Add strain tensor of a deformation gradient.
r"""
Add strain tensor (Seth-Hill family) of a deformation gradient.
For details, see damask.mechanics.strain.
By default, the logarithmic strain based on the
left stretch tensor is added.
Parameters
----------
@ -1272,22 +1262,40 @@ class Result:
spatial/Eulerian strain measures (based on 'V') for elastic strains
when calculating averages.
The strain is defined as:
.. math::
m = 0 \\\\
\vb*{\epsilon}_V^{(0)} = \ln (\vb{V}) \\\\
\vb*{\epsilon}_U^{(0)} = \ln (\vb{U}) \\\\
m \neq 0 \\\\
\vb*{\epsilon}_V^{(m)} = \frac{1}{2m} (\vb{V}^{2m} - \vb{I}) \\\\
\vb*{\epsilon}_U^{(m)} = \frac{1}{2m} (\vb{U}^{2m} - \vb{I})
References
----------
| https://en.wikipedia.org/wiki/Finite_strain_theory
| https://de.wikipedia.org/wiki/Verzerrungstensor
"""
self._add_generic_pointwise(self._add_strain,{'F':F},{'t':t,'m':m})
def strain(F: Dict[str, Any], t: Literal['V', 'U'], m: float) -> Dict[str, Any]:
side = 'left' if t == 'V' else 'right'
return {
'data': mechanics.strain(F['data'],t,m),
'label': f"epsilon_{t}^{m}({F['label']})",
'meta': {
'unit': F['meta']['unit'],
'description': f'Seth-Hill strain tensor of order {m} based on {side} stretch tensor '+\
f"of {F['label']} ({F['meta']['description']})",
'creator': 'add_strain'
}
}
self._add_generic_pointwise(strain,{'F':F},{'t':t,'m':m})
@staticmethod
def _add_stretch_tensor(F: Dict[str, Any], t: str) -> Dict[str, Any]:
return {
'data': (mechanics.stretch_left if t.upper() == 'V' else mechanics.stretch_right)(F['data']),
'label': f"{t}({F['label']})",
'meta': {
'unit': F['meta']['unit'],
'description': f"{'left' if t.upper() == 'V' else 'right'} stretch tensor "\
+f"of {F['label']} ({F['meta']['description']})", # noqa
'creator': 'add_stretch_tensor'
}
}
def add_stretch_tensor(self,
F: str = 'F',
t: Literal['V', 'U'] = 'V'):
@ -1303,20 +1311,21 @@ class Result:
Defaults to 'V'.
"""
self._add_generic_pointwise(self._add_stretch_tensor,{'F':F},{'t':t})
def stretch_tensor(F: Dict[str, Any], t: str) -> Dict[str, Any]:
return {
'data': (mechanics.stretch_left if t.upper() == 'V' else mechanics.stretch_right)(F['data']),
'label': f"{t}({F['label']})",
'meta': {
'unit': F['meta']['unit'],
'description': f"{'left' if t.upper() == 'V' else 'right'} stretch tensor "\
+f"of {F['label']} ({F['meta']['description']})", # noqa
'creator': 'add_stretch_tensor'
}
}
self._add_generic_pointwise(stretch_tensor,{'F':F},{'t':t})
@staticmethod
def _add_curl(f: Dict[str, Any], size: np.ndarray) -> Dict[str, Any]:
return {
'data': grid_filters.curl(size,f['data']),
'label': f"curl({f['label']})",
'meta': {
'unit': f['meta']['unit']+'/m',
'description': f"curl of {f['label']} ({f['meta']['description']})",
'creator': 'add_curl'
}
}
def add_curl(self, f: str):
"""
Add curl of a field.
@ -1332,20 +1341,20 @@ class Result:
i.e. fields resulting from the grid solver.
"""
self._add_generic_grid(self._add_curl,{'f':f},{'size':self.size})
def curl(f: Dict[str, Any], size: np.ndarray) -> Dict[str, Any]:
return {
'data': grid_filters.curl(size,f['data']),
'label': f"curl({f['label']})",
'meta': {
'unit': f['meta']['unit']+'/m',
'description': f"curl of {f['label']} ({f['meta']['description']})",
'creator': 'add_curl'
}
}
self._add_generic_grid(curl,{'f':f},{'size':self.size})
@staticmethod
def _add_divergence(f: Dict[str, Any], size: np.ndarray) -> Dict[str, Any]:
return {
'data': grid_filters.divergence(size,f['data']),
'label': f"divergence({f['label']})",
'meta': {
'unit': f['meta']['unit']+'/m',
'description': f"divergence of {f['label']} ({f['meta']['description']})",
'creator': 'add_divergence'
}
}
def add_divergence(self, f: str):
"""
Add divergence of a field.
@ -1361,21 +1370,20 @@ class Result:
i.e. fields resulting from the grid solver.
"""
self._add_generic_grid(self._add_divergence,{'f':f},{'size':self.size})
def divergence(f: Dict[str, Any], size: np.ndarray) -> Dict[str, Any]:
return {
'data': grid_filters.divergence(size,f['data']),
'label': f"divergence({f['label']})",
'meta': {
'unit': f['meta']['unit']+'/m',
'description': f"divergence of {f['label']} ({f['meta']['description']})",
'creator': 'add_divergence'
}
}
self._add_generic_grid(divergence,{'f':f},{'size':self.size})
@staticmethod
def _add_gradient(f: Dict[str, Any], size: np.ndarray) -> Dict[str, Any]:
return {
'data': grid_filters.gradient(size,f['data'] if len(f['data'].shape) == 4 else \
f['data'].reshape(f['data'].shape+(1,))),
'label': f"gradient({f['label']})",
'meta': {
'unit': f['meta']['unit']+'/m',
'description': f"gradient of {f['label']} ({f['meta']['description']})",
'creator': 'add_gradient'
}
}
def add_gradient(self, f: str):
"""
Add gradient of a field.
@ -1391,7 +1399,19 @@ class Result:
i.e. fields resulting from the grid solver.
"""
self._add_generic_grid(self._add_gradient,{'f':f},{'size':self.size})
def gradient(f: Dict[str, Any], size: np.ndarray) -> Dict[str, Any]:
return {
'data': grid_filters.gradient(size,f['data'] if len(f['data'].shape) == 4 else \
f['data'].reshape(f['data'].shape+(1,))),
'label': f"gradient({f['label']})",
'meta': {
'unit': f['meta']['unit']+'/m',
'description': f"gradient of {f['label']} ({f['meta']['description']})",
'creator': 'add_gradient'
}
}
self._add_generic_grid(gradient,{'f':f},{'size':self.size})
def _add_generic_grid(self,
@ -1453,29 +1473,6 @@ class Result:
f'damask.Result.{creator} v{damask.version}'.encode()
def _job_pointwise(self,
group: str,
callback: Callable,
datasets: Dict[str, str],
args: Dict[str, str],
lock: Lock) -> List[Union[None, Any]]:
"""Execute job for _add_generic_pointwise."""
try:
datasets_in = {}
lock.acquire()
with h5py.File(self.fname,'r') as f:
for arg,label in datasets.items():
loc = f[group+'/'+label]
datasets_in[arg]={'data' :loc[()],
'label':label,
'meta': {k:(v.decode() if not h5py3 and type(v) is bytes else v) \
for k,v in loc.attrs.items()}}
lock.release()
r = callback(**datasets_in,**args)
return [group,r]
except Exception as err:
print(f'Error during calculation: {err}.')
return [None,None]
def _add_generic_pointwise(self,
@ -1497,8 +1494,24 @@ class Result:
Arguments parsed to func.
"""
pool = mp.Pool(int(os.environ.get('OMP_NUM_THREADS',4)))
lock = mp.Manager().Lock()
def job_pointwise(group: str,
callback: Callable,
datasets: Dict[str, str],
args: Dict[str, str]) -> Union[None, Any]:
try:
datasets_in = {}
with h5py.File(self.fname,'r') as f:
for arg,label in datasets.items():
loc = f[group+'/'+label]
datasets_in[arg]={'data' :loc[()],
'label':label,
'meta': {k:(v.decode() if not h5py3 and type(v) is bytes else v) \
for k,v in loc.attrs.items()}}
return callback(**datasets_in,**args)
except Exception as err:
print(f'Error during calculation: {err}.')
return None
groups = []
with h5py.File(self.fname,'r') as f:
@ -1513,12 +1526,10 @@ class Result:
print('No matching dataset found, no data was added.')
return
default_arg = partial(self._job_pointwise,callback=func,datasets=datasets,args=args,lock=lock)
for group,result in util.show_progress(pool.imap_unordered(default_arg,groups),len(groups)):# type: ignore
if not result:
for group in util.show_progress(groups):
if not (result := job_pointwise(group, callback=func, datasets=datasets, args=args)): # type: ignore
continue
lock.acquire()
with h5py.File(self.fname, 'a') as f:
try:
if not self._protected and '/'.join([group,result['label']]) in f:
@ -1550,10 +1561,6 @@ class Result:
except (OSError,RuntimeError) as err:
print(f'Could not add dataset: {err}.')
lock.release()
pool.close()
pool.join()
def _mappings(self):
@ -2192,7 +2199,7 @@ class Result:
cfg_dir = (Path.cwd() if target_dir is None else Path(target_dir))
with h5py.File(self.fname,'r') as f_in:
f_in['setup'].visititems(partial(export,
output=output,
cfg_dir=cfg_dir,
overwrite=overwrite))
f_in['setup'].visititems(functools.partial(export,
output=output,
cfg_dir=cfg_dir,
overwrite=overwrite))

147
python/damask/_rotation.py
View File

@ -307,7 +307,8 @@ class Rotation:
p_m = self.quaternion[...,1:]
q_o = other.quaternion[...,0:1]
p_o = other.quaternion[...,1:]
q = (q_m*q_o - np.einsum('...i,...i',p_m,p_o).reshape(self.shape+(1,)))
qmo = q_m*q_o
q = (qmo - np.einsum('...i,...i',p_m,p_o).reshape(qmo.shape))
p = q_m*p_o + q_o*p_m + _P * np.cross(p_m,p_o)
return self.copy(Rotation(np.block([q,p]))._standardize())
else:
@ -374,6 +375,11 @@ class Rotation:
Return self@other.
Rotate vector, second-order tensor, or fourth-order tensor.
`other` is interpreted as an array of tensor quantities with the highest-possible order
considering the shape of `self`. Compatible innermost dimensions will blend.
For instance, shapes of (2,) and (3,3) for `self` and `other` prompt interpretation of
`other` as a second-rank tensor and result in (2,) rotated tensors, whereas
shapes of (2,1) and (3,3) for `self` and `other` result in (2,3) rotated vectors.
Parameters
----------
@ -385,29 +391,73 @@ class Rotation:
rotated : numpy.ndarray, shape (...,3), (...,3,3), or (...,3,3,3,3)
Rotated vector or tensor, i.e. transformed to frame defined by rotation.
Examples
--------
All below examples rely on imported modules:
>>> import numpy as np
>>> import damask
Application of twelve (random) rotations to a set of five vectors.
>>> r = damask.Rotation.from_random(shape=(12))
>>> o = np.ones((5,3))
>>> (r@o).shape # (12) @ (5, 3)
(12,5, 3)
Application of a (random) rotation to all twelve second-rank tensors.
>>> r = damask.Rotation.from_random()
>>> o = np.ones((12,3,3))
>>> (r@o).shape # (1) @ (12, 3,3)
(12,3,3)
Application of twelve (random) rotations to the corresponding twelve second-rank tensors.
>>> r = damask.Rotation.from_random(shape=(12))
>>> o = np.ones((12,3,3))
>>> (r@o).shape # (12) @ (3,3)
(12,3,3)
Application of each of three (random) rotations to all three vectors.
>>> r = damask.Rotation.from_random(shape=(3))
>>> o = np.ones((3,3))
>>> (r[...,np.newaxis]@o[np.newaxis,...]).shape # (3,1) @ (1,3, 3)
(3,3,3)
Application of twelve (random) rotations to all twelve second-rank tensors.
>>> r = damask.Rotation.from_random(shape=(12))
>>> o = np.ones((12,3,3))
>>> (r@o[np.newaxis,...]).shape # (12) @ (1,12, 3,3)
(12,3,3,3)
"""
if isinstance(other, np.ndarray):
if self.shape + (3,) == other.shape:
q_m = self.quaternion[...,0]
p_m = self.quaternion[...,1:]
A = q_m**2 - np.einsum('...i,...i',p_m,p_m)
B = 2. * np.einsum('...i,...i',p_m,other)
C = 2. * _P * q_m
return np.block([(A * other[...,i]).reshape(self.shape+(1,)) +
(B * p_m[...,i]).reshape(self.shape+(1,)) +
(C * ( p_m[...,(i+1)%3]*other[...,(i+2)%3]\
- p_m[...,(i+2)%3]*other[...,(i+1)%3])).reshape(self.shape+(1,))
for i in [0,1,2]])
if self.shape + (3,3) == other.shape:
R = self.as_matrix()
return np.einsum('...im,...jn,...mn',R,R,other)
if self.shape + (3,3,3,3) == other.shape:
R = self.as_matrix()
return np.einsum('...im,...jn,...ko,...lp,...mnop',R,R,R,R,other)
else:
raise ValueError('can only rotate vectors, second-order tensors, and fourth-order tensors')
obs = util.shapeblender(self.shape,other.shape,keep_ones=False)[len(self.shape):]
for l in [4,2,1]:
if obs[-l:] == l*(3,):
bs = util.shapeblender(self.shape,other.shape[:-l],False)
self_ = self.broadcast_to(bs) if self.shape != bs else self
if l==1:
q_m = self_.quaternion[...,0]
p_m = self_.quaternion[...,1:]
A = q_m**2 - np.einsum('...i,...i',p_m,p_m)
B = 2. * np.einsum('...i,...i',p_m,other)
C = 2. * _P * q_m
return np.block([(A * other[...,i]) +
(B * p_m[...,i]) +
(C * ( p_m[...,(i+1)%3]*other[...,(i+2)%3]
- p_m[...,(i+2)%3]*other[...,(i+1)%3]))
for i in [0,1,2]]).reshape(bs+(3,),order='F')
else:
return np.einsum({2: '...im,...jn,...mn',
4: '...im,...jn,...ko,...lp,...mnop'}[l],
*l*[self_.as_matrix()],
other)
raise ValueError('can only rotate vectors, second-order tensors, and fourth-order tensors')
elif isinstance(other, Rotation):
raise TypeError('use "R1*R2", i.e. multiplication, to compose rotations "R1" and "R2"')
raise TypeError('use "R2*R1", i.e. multiplication, to compose rotations "R1" and "R2"')
else:
raise TypeError(f'cannot rotate "{type(other)}"')
@ -1323,28 +1373,41 @@ class Rotation:
@staticmethod
def _qu2eu(qu: np.ndarray) -> np.ndarray:
"""Quaternion to Bunge Euler angles."""
q02 = qu[...,0:1]*qu[...,2:3]
q13 = qu[...,1:2]*qu[...,3:4]
q01 = qu[...,0:1]*qu[...,1:2]
q23 = qu[...,2:3]*qu[...,3:4]
q03_s = qu[...,0:1]**2+qu[...,3:4]**2
q12_s = qu[...,1:2]**2+qu[...,2:3]**2
chi = np.sqrt(q03_s*q12_s)
"""
Quaternion to Bunge Euler angles.
eu = np.where(np.abs(q12_s) < 1.e-8,
np.block([np.arctan2(-_P*2.*qu[...,0:1]*qu[...,3:4],qu[...,0:1]**2-qu[...,3:4]**2),
np.zeros(qu.shape[:-1]+(2,))]),
np.where(np.abs(q03_s) < 1.e-8,
np.block([np.arctan2( 2.*qu[...,1:2]*qu[...,2:3],qu[...,1:2]**2-qu[...,2:3]**2),
np.broadcast_to(np.pi,qu[...,0:1].shape),
np.zeros(qu.shape[:-1]+(1,))]),
np.block([np.arctan2((-_P*q02+q13)*chi, (-_P*q01-q23)*chi),
np.arctan2( 2.*chi, q03_s-q12_s ),
np.arctan2(( _P*q02+q13)*chi, (-_P*q01+q23)*chi)])
)
)
eu[np.abs(eu) < 1.e-6] = 0.
References
----------
E. Bernardes and S. Viollet, PLoS ONE 17(11):e0276302, 2022
https://doi.org/10.1371/journal.pone.0276302
"""
a = qu[...,0:1]
b = -_P*qu[...,3:4]
c = -_P*qu[...,1:2]
d = -_P*qu[...,2:3]
eu = np.block([
np.arctan2(b,a),
np.arccos(2*(a**2+b**2)/(a**2+b**2+c**2+d**2)-1),
np.arctan2(-d,c),
])
eu_sum = eu[...,0] + eu[...,2]
eu_diff = eu[...,0] - eu[...,2]
is_zero = np.isclose(eu[...,1],0.0)
is_pi = np.isclose(eu[...,1],np.pi)
is_ok = ~np.logical_or(is_zero,is_pi)
eu[...,0][is_zero] = 2*eu[...,0][is_zero]
eu[...,0][is_pi] = -2*eu[...,2][is_pi]
eu[...,2][~is_ok] = 0.0
eu[...,0][is_ok] = eu_diff[is_ok]
eu[...,2][is_ok] = eu_sum [is_ok]
eu[np.logical_or(np.abs(eu) < 1.e-6,
np.abs(eu-2*np.pi) < 1.e-6)] = 0.
return np.where(eu < 0., eu%(np.pi*np.array([2.,1.,2.])),eu)
@staticmethod

2
python/damask/_typehints.py
View File

@ -11,7 +11,7 @@ IntSequence = Union[np.ndarray,Sequence[int]]
StrSequence = Union[np.ndarray,Sequence[str]]
FileHandle = Union[TextIO, str, Path]
CrystalFamily = Union[None,Literal['triclinic', 'monoclinic', 'orthorhombic', 'tetragonal', 'hexagonal', 'cubic']]
CrystalLattice = Union[None,Literal['aP', 'mP', 'mS', 'oP', 'oS', 'oI', 'oF', 'tP', 'tI', 'hP', 'cP', 'cI', 'cF']]
BravaisLattice = Union[None,Literal['aP', 'mP', 'mS', 'oP', 'oS', 'oI', 'oF', 'tP', 'tI', 'hP', 'cP', 'cI', 'cF']]
CrystalKinematics = Literal['slip', 'twin']
NumpyRngSeed = Union[int, IntSequence, np.random.SeedSequence, np.random.Generator]
# BitGenerator does not exists in older numpy versions

2
python/damask/solver/_marc.py
View File

@ -4,7 +4,7 @@ import re
from pathlib import Path
from typing import Literal
_marc_version = '2022.4'
_marc_version = '2023.1'
_marc_root = '/opt/msc'
_damask_root = str(Path(__file__).parents[3])

63
python/damask/util.py
View File

@ -512,7 +512,8 @@ def shapeshifter(fro: _Tuple[int, ...],
return tuple(final_shape[::-1] if mode == 'left' else final_shape)
def shapeblender(a: _Tuple[int, ...],
b: _Tuple[int, ...]) -> _Tuple[int, ...]:
b: _Tuple[int, ...],
keep_ones: bool = True) -> _Tuple[int, ...]:
"""
Return a shape that overlaps the rightmost entries of 'a' with the leftmost of 'b'.
@ -522,6 +523,9 @@ def shapeblender(a: _Tuple[int, ...],
Shape of first array.
b : tuple
Shape of second array.
keep_ones : bool, optional
Treat innermost '1's as literal value instead of dimensional placeholder.
Defaults to True.
Examples
--------
@ -531,13 +535,30 @@ def shapeblender(a: _Tuple[int, ...],
(1,2,3)
>>> shapeblender((1,),(2,2,1))
(1,2,2,1)
>>> shapeblender((1,),(2,2,1),False)
(2,2,1)
>>> shapeblender((3,2),(3,2))
(3,2)
"""
i = min(len(a),len(b))
while i > 0 and a[-i:] != b[:i]: i -= 1
return a + b[i:]
def is_broadcastable(a,b):
try:
_np.broadcast_shapes(a,b)
return True
except ValueError:
return False
a_,_b = a,b
if keep_ones:
i = min(len(a_),len(_b))
while i > 0 and a_[-i:] != _b[:i]: i -= 1
return a_ + _b[i:]
else:
a_ += max(0,len(_b)-len(a_))*(1,)
while not is_broadcastable(a_,_b):
a_ = a_ + ((1,) if len(a_)<=len(_b) else ())
_b = ((1,) if len(_b)<len(a_) else ()) + _b
return _np.broadcast_shapes(a_,_b)
def _docstringer(docstring: _Union[str, _Callable],
@ -698,7 +719,7 @@ def pass_on(keyword: str,
return wrapper
return decorator
def DREAM3D_base_group(fname: _Union[str, _Path]) -> str:
def DREAM3D_base_group(fname: _Union[str, _Path, _h5py.File]) -> str:
"""
Determine the base group of a DREAM.3D file.
@ -707,7 +728,7 @@ def DREAM3D_base_group(fname: _Union[str, _Path]) -> str:
Parameters
----------
fname : str or pathlib.Path
fname : str, pathlib.Path, or _h5py.File
Filename of the DREAM.3D (HDF5) file.
Returns
@ -716,15 +737,19 @@ def DREAM3D_base_group(fname: _Union[str, _Path]) -> str:
Path to the base group.
"""
with _h5py.File(_Path(fname).expanduser(),'r') as f:
def get_base_group(f: _h5py.File) -> str:
base_group = f.visit(lambda path: path.rsplit('/',2)[0] if '_SIMPL_GEOMETRY/SPACING' in path else None)
if base_group is None:
raise ValueError(f'could not determine base group in file "{fname}"')
return base_group
if base_group is None:
raise ValueError(f'could not determine base group in file "{fname}"')
if isinstance(fname,_h5py.File):
return get_base_group(fname)
return base_group
with _h5py.File(_Path(fname).expanduser(),'r') as f:
return get_base_group(f)
def DREAM3D_cell_data_group(fname: _Union[str, _Path]) -> str:
def DREAM3D_cell_data_group(fname: _Union[str, _Path, _h5py.File]) -> str:
"""
Determine the cell data group of a DREAM.3D file.
@ -734,7 +759,7 @@ def DREAM3D_cell_data_group(fname: _Union[str, _Path]) -> str:
Parameters
----------
fname : str or pathlib.Path
fname : str, pathlib.Path, or h5py.File
Filename of the DREAM.3D (HDF5) file.
Returns
@ -743,17 +768,21 @@ def DREAM3D_cell_data_group(fname: _Union[str, _Path]) -> str:
Path to the cell data group.
"""
base_group = DREAM3D_base_group(fname)
with _h5py.File(_Path(fname).expanduser(),'r') as f:
def get_cell_data_group(f: _h5py.File) -> str:
base_group = DREAM3D_base_group(f)
cells = tuple(f['/'.join([base_group,'_SIMPL_GEOMETRY','DIMENSIONS'])][()][::-1])
cell_data_group = f[base_group].visititems(lambda path,obj: path.split('/')[0] \
if isinstance(obj,_h5py._hl.dataset.Dataset) and _np.shape(obj)[:-1] == cells \
else None)
if cell_data_group is None:
raise ValueError(f'could not determine cell-data group in file "{fname}/{base_group}"')
return cell_data_group
if cell_data_group is None:
raise ValueError(f'could not determine cell-data group in file "{fname}/{base_group}"')
if isinstance(fname,_h5py.File):
return get_cell_data_group(fname)
return cell_data_group
with _h5py.File(_Path(fname).expanduser(),'r') as f:
return get_cell_data_group(f)
def Bravais_to_Miller(*,

24
python/tests/resources/Orientation/cI_slip.txt vendored
View File

@ -1,23 +1,23 @@
3x3:1_Schmid 3x3:2_Schmid 3x3:3_Schmid 3x3:4_Schmid 3x3:5_Schmid 3x3:6_Schmid 3x3:7_Schmid 3x3:8_Schmid 3x3:9_Schmid
0.0 0.4082482904638631 0.408248290463863 0.0 -0.408248290463863 -0.40824829046386296 0.0 0.4082482904638631 0.408248290463863
0.0 -0.408248290463863 -0.40824829046386296 0.0 -0.408248290463863 -0.40824829046386296 0.0 0.4082482904638631 0.408248290463863
0.0 -0.408248290463863 0.408248290463863 0.0 -0.408248290463863 0.408248290463863 0.0 -0.408248290463863 0.408248290463863
0.0 0.408248290463863 0.40824829046386296 0.0 0.408248290463863 0.40824829046386296 0.0 -0.4082482904638631 -0.408248290463863
0.0 0.408248290463863 -0.408248290463863 0.0 0.408248290463863 -0.408248290463863 0.0 0.408248290463863 -0.408248290463863
0.0 0.40824829046386285 -0.40824829046386285 0.0 -0.408248290463863 0.408248290463863 0.0 -0.408248290463863 0.408248290463863
-0.40824829046386296 2.4997998108697434e-17 -0.40824829046386285 0.4082482904638631 -2.4997998108697446e-17 0.408248290463863 0.4082482904638631 -2.4997998108697446e-17 0.408248290463863
0.40824829046386296 -2.4997998108697434e-17 0.40824829046386285 -0.4082482904638631 2.4997998108697446e-17 -0.408248290463863 -0.4082482904638631 2.4997998108697446e-17 -0.408248290463863
-0.408248290463863 2.499799810869744e-17 -0.40824829046386296 -0.408248290463863 2.499799810869744e-17 -0.40824829046386296 0.4082482904638631 -2.4997998108697446e-17 0.408248290463863
-0.408248290463863 2.499799810869744e-17 0.408248290463863 -0.408248290463863 2.499799810869744e-17 0.408248290463863 -0.408248290463863 2.499799810869744e-17 0.408248290463863
-0.408248290463863 2.499799810869744e-17 0.408248290463863 0.40824829046386296 -2.4997998108697437e-17 -0.40824829046386296 -0.408248290463863 2.499799810869744e-17 0.408248290463863
0.408248290463863 -2.499799810869744e-17 -0.408248290463863 -0.40824829046386296 2.4997998108697437e-17 0.40824829046386296 0.408248290463863 -2.499799810869744e-17 -0.408248290463863
-0.40824829046386296 -0.40824829046386285 4.999599621739487e-17 0.4082482904638631 0.408248290463863 -4.999599621739489e-17 0.4082482904638631 0.408248290463863 -4.999599621739489e-17
-0.4082482904638631 -0.408248290463863 4.999599621739489e-17 0.408248290463863 0.40824829046386296 -4.999599621739488e-17 -0.4082482904638631 -0.408248290463863 4.999599621739489e-17
-0.408248290463863 0.408248290463863 0.0 -0.408248290463863 0.408248290463863 0.0 -0.408248290463863 0.408248290463863 0.0
-0.40824829046386296 0.40824829046386296 0.0 -0.40824829046386296 0.40824829046386296 0.0 0.408248290463863 -0.408248290463863 0.0
0.408248290463863 -0.408248290463863 0.0 0.408248290463863 -0.408248290463863 0.0 0.408248290463863 -0.408248290463863 0.0
0.40824829046386296 -0.40824829046386296 0.0 0.40824829046386296 -0.40824829046386296 0.0 -0.408248290463863 0.408248290463863 0.0
-0.4714045207910316 -0.23570226039551578 -0.23570226039551576 0.4714045207910318 0.23570226039551587 0.23570226039551584 0.4714045207910318 0.23570226039551587 0.23570226039551584
-0.4714045207910318 0.23570226039551595 0.2357022603955159 -0.4714045207910318 0.23570226039551595 0.2357022603955159 -0.4714045207910318 0.23570226039551595 0.2357022603955159
0.47140452079103173 -0.2357022603955159 0.23570226039551584 0.47140452079103173 -0.2357022603955159 0.23570226039551584 -0.4714045207910318 0.23570226039551595 -0.23570226039551587
-0.4714045207910318 0.23570226039551595 0.23570226039551595 -0.4714045207910318 0.23570226039551595 0.23570226039551595 -0.4714045207910318 0.23570226039551595 0.23570226039551595
0.47140452079103173 -0.2357022603955159 0.23570226039551587 0.47140452079103173 -0.2357022603955159 0.23570226039551587 -0.4714045207910318 0.23570226039551595 -0.2357022603955159
0.4714045207910318 0.23570226039551587 -0.23570226039551595 -0.47140452079103173 -0.23570226039551584 0.2357022603955159 0.4714045207910318 0.23570226039551587 -0.23570226039551595
0.2357022603955159 0.4714045207910318 0.23570226039551584 -0.23570226039551587 -0.47140452079103173 -0.23570226039551578 0.2357022603955159 0.4714045207910318 0.23570226039551584
-0.23570226039551587 0.47140452079103173 0.23570226039551587 -0.23570226039551587 0.47140452079103173 0.23570226039551587 0.2357022603955159 -0.4714045207910318 -0.2357022603955159
0.2357022603955159 -0.4714045207910318 0.23570226039551595 0.2357022603955159 -0.4714045207910318 0.23570226039551595 0.2357022603955159 -0.4714045207910318 0.23570226039551595
-0.23570226039551587 0.47140452079103173 0.23570226039551584 -0.23570226039551587 0.47140452079103173 0.23570226039551584 0.2357022603955159 -0.4714045207910318 -0.23570226039551587
0.2357022603955159 -0.4714045207910318 0.2357022603955159 0.2357022603955159 -0.4714045207910318 0.2357022603955159 0.2357022603955159 -0.4714045207910318 0.2357022603955159
-0.2357022603955158 -0.4714045207910316 0.23570226039551584 0.2357022603955159 0.4714045207910318 -0.23570226039551595 0.2357022603955159 0.4714045207910318 -0.23570226039551595
0.23570226039551587 0.23570226039551584 0.47140452079103173 0.23570226039551587 0.23570226039551584 0.47140452079103173 -0.2357022603955159 -0.23570226039551587 -0.4714045207910318
-0.2357022603955159 0.2357022603955159 0.4714045207910318 0.23570226039551587 -0.23570226039551587 -0.47140452079103173 -0.2357022603955159 0.2357022603955159 0.4714045207910318
@ -36,7 +36,7 @@
-0.30860669992418377 0.1543033499620919 -0.46291004988627565 0.3086066999241839 -0.15430334996209197 0.4629100498862758 0.3086066999241839 -0.15430334996209197 0.4629100498862758
0.3086066999241839 0.1543033499620919 -0.4629100498862758 0.3086066999241839 0.1543033499620919 -0.4629100498862758 0.3086066999241839 0.1543033499620919 -0.4629100498862758
0.3086066999241839 0.4629100498862758 0.15430334996209188 -0.3086066999241838 -0.4629100498862757 -0.15430334996209186 0.3086066999241839 0.4629100498862758 0.15430334996209188
-0.3086066999241838 0.4629100498862757 0.15430334996209188 -0.3086066999241838 0.4629100498862757 0.15430334996209188 0.3086066999241839 -0.4629100498862758 -0.1543033499620919
-0.3086066999241838 0.4629100498862757 0.1543033499620919 -0.3086066999241838 0.4629100498862757 0.1543033499620919 0.3086066999241839 -0.4629100498862758 -0.15430334996209194
0.3086066999241839 -0.4629100498862758 0.15430334996209194 0.3086066999241839 -0.4629100498862758 0.15430334996209194 0.3086066999241839 -0.4629100498862758 0.15430334996209194
-0.30860669992418377 -0.46291004988627565 0.15430334996209194 0.3086066999241839 0.4629100498862758 -0.154303349962092 0.3086066999241839 0.4629100498862758 -0.154303349962092
-0.46291004988627565 -0.15430334996209186 -0.3086066999241837 0.4629100498862758 0.1543033499620919 0.3086066999241838 0.4629100498862758 0.1543033499620919 0.3086066999241838
@ -45,5 +45,5 @@
0.4629100498862758 0.1543033499620919 -0.3086066999241839 -0.4629100498862757 -0.15430334996209188 0.3086066999241838 0.4629100498862758 0.1543033499620919 -0.3086066999241839
-0.46291004988627565 -0.3086066999241837 -0.1543033499620918 0.4629100498862758 0.3086066999241838 0.15430334996209188 0.4629100498862758 0.3086066999241838 0.15430334996209188
-0.4629100498862758 0.3086066999241839 0.15430334996209194 -0.4629100498862758 0.3086066999241839 0.15430334996209194 -0.4629100498862758 0.3086066999241839 0.15430334996209194
0.4629100498862757 -0.3086066999241838 0.1543033499620919 0.4629100498862757 -0.3086066999241838 0.1543033499620919 -0.4629100498862758 0.3086066999241839 -0.15430334996209194
0.4629100498862757 -0.3086066999241838 0.15430334996209188 0.4629100498862757 -0.3086066999241838 0.15430334996209188 -0.4629100498862758 0.3086066999241839 -0.1543033499620919
0.4629100498862758 0.3086066999241838 -0.154303349962092 -0.4629100498862757 -0.30860669992418377 0.15430334996209197 0.4629100498862758 0.3086066999241838 -0.154303349962092

16
python/tests/resources/Result/12grains6x7x8.material.yaml vendored
View File

@ -12,12 +12,12 @@ phase:
elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke}
plastic:
N_sl: [12]
a_sl: 2.25
a_sl: [2.25]
atol_xi: 1.0
dot_gamma_0_sl: 0.001
h_0_sl-sl: 75e6
dot_gamma_0_sl: [0.001]
h_0_sl-sl: [75e6]
h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4]
n_sl: 20
n_sl: [20]
output: [xi_sl]
type: phenopowerlaw
xi_0_sl: [31e6]
@ -29,12 +29,12 @@ phase:
elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke}
plastic:
N_sl: [12]
a_sl: 2.25
a_sl: [2.25]
atol_xi: 1.0
dot_gamma_0_sl: 0.001
h_0_sl-sl: 75e6
dot_gamma_0_sl: [0.001]
h_0_sl-sl: [75e6]
h_sl-sl: [1, 1.4, 1, 1.4, 1.4, 1.4, 1.4]
n_sl: 20
n_sl: [20]
output: [xi_sl]
type: phenopowerlaw
xi_0_sl: [31e6]

16
python/tests/resources/Result/4grains2x4x3.material.yaml vendored
View File

@ -644,12 +644,12 @@ phase:
elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke}
plastic:
N_sl: [12]
a_sl: 2.25
a_sl: [2.25]
atol_xi: 1.0
dot_gamma_0_sl: 0.001
h_0_sl-sl: 75e6
dot_gamma_0_sl: [0.001]
h_0_sl-sl: [75e6]
h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4]
n_sl: 20
n_sl: [20]
output: [xi_sl]
type: phenopowerlaw
xi_0_sl: [31e6]
@ -661,12 +661,12 @@ phase:
elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke}
plastic:
N_sl: [12]
a_sl: 2.25
a_sl: [2.25]
atol_xi: 1.0
dot_gamma_0_sl: 0.001
h_0_sl-sl: 75e6
dot_gamma_0_sl: [0.001]
h_0_sl-sl: [75e6]
h_sl-sl: [1, 1.4, 1, 1.4, 1.4, 1.4, 1.4]
n_sl: 20
n_sl: [20]
output: [xi_sl]
type: phenopowerlaw
xi_0_sl: [31e6]

8
python/tests/resources/Result/6grains6x7x8_single_phase.material.yaml vendored
View File

@ -12,12 +12,12 @@ phase:
elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke}
plastic:
N_sl: [12]
a_sl: 2.25
a_sl: [2.25]
atol_xi: 1.0
dot_gamma_0_sl: 0.001
h_0_sl-sl: 75e6
dot_gamma_0_sl: [0.001]
h_0_sl-sl: [75e6]
h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4]
n_sl: 20
n_sl: [20]
output: [xi_sl]
type: phenopowerlaw
xi_0_sl: [31e6]

32
python/tests/test_Orientation.py
View File

@ -162,7 +162,7 @@ class TestOrientation:
([np.arccos(3**(-.5)),np.pi/4,0],[0,0],[0,0,1],[0,0,1])])
def test_fiber_IPF(self,crystal,sample,direction,color):
fiber = Orientation.from_fiber_component(crystal=crystal,sample=sample,family='cubic',shape=200)
print(np.allclose(fiber.IPF_color(direction),color))
assert np.allclose(fiber.IPF_color(direction),color)
@pytest.mark.parametrize('kwargs',[
@ -319,9 +319,7 @@ class TestOrientation:
eu = o.related(model).as_Euler_angles(degrees=True)
if update:
coords = np.array([(1,i+1) for i,x in enumerate(eu)])
Table(eu,{'Eulers':(3,)})\
.add('pos',coords)\
.save(reference)
Table({'Eulers':(3,)},eu).set('pos',coords).save(reference)
assert np.allclose(eu,Table.load(reference).get('Eulers'))
def test_basis_real(self):
@ -369,8 +367,7 @@ class TestOrientation:
reference = res_path/f'{lattice}_{mode}.txt'
P = O.Schmid(N_slip='*') if mode == 'slip' else O.Schmid(N_twin='*')
if update:
table = Table(P.reshape(-1,9),{'Schmid':(3,3,)})
table.save(reference)
Table({'Schmid':(3,3,)},P.reshape(-1,9)).save(reference)
assert np.allclose(P,Table.load(reference).get('Schmid'))
def test_Schmid_invalid(self):
@ -458,11 +455,9 @@ class TestOrientation:
p = Orientation.from_random(family=family,shape=right)
blend = util.shapeblender(o.shape,p.shape)
for loc in np.random.randint(0,blend,(10,len(blend))):
# print(f'{a}/{b} @ {loc}')
# print(o[tuple(loc[:len(o.shape)])].disorientation(p[tuple(loc[-len(p.shape):])]))
# print(o.disorientation(p)[tuple(loc)])
assert o[tuple(loc[:len(o.shape)])].disorientation(p[tuple(loc[-len(p.shape):])]) \
.isclose(o.disorientation(p)[tuple(loc)])
l = () if left is None else tuple(np.minimum(np.array(left )-1,loc[:len(left)]))
r = () if right is None else tuple(np.minimum(np.array(right)-1,loc[-len(right):]))
assert o[l].disorientation(p[r]).isclose(o.disorientation(p)[tuple(loc)])
@pytest.mark.parametrize('family',crystal_families)
@pytest.mark.parametrize('left,right',[
@ -470,13 +465,16 @@ class TestOrientation:
((2,2),(4,4)),
((3,1),(1,3)),
(None,(3,)),
(None,()),
])
def test_IPF_color_blending(self,family,left,right):
o = Orientation.from_random(family=family,shape=left)
v = np.random.random(right+(3,))
blend = util.shapeblender(o.shape,v.shape[:-1])
for loc in np.random.randint(0,blend,(10,len(blend))):
assert np.allclose(o[tuple(loc[:len(o.shape)])].IPF_color(v[tuple(loc[-len(v.shape[:-1]):])]),
l = () if left is None else tuple(np.minimum(np.array(left )-1,loc[:len(left)]))
r = () if right is None else tuple(np.minimum(np.array(right)-1,loc[-len(right):]))
assert np.allclose(o[l].IPF_color(v[r]),
o.IPF_color(v)[tuple(loc)])
@pytest.mark.parametrize('family',crystal_families)
@ -491,7 +489,9 @@ class TestOrientation:
v = np.random.random(right+(3,))
blend = util.shapeblender(o.shape,v.shape[:-1])
for loc in np.random.randint(0,blend,(10,len(blend))):
assert np.allclose(o[tuple(loc[:len(o.shape)])].to_SST(v[tuple(loc[-len(v.shape[:-1]):])]),
l = () if left is None else tuple(np.minimum(np.array(left )-1,loc[:len(left)]))
r = () if right is None else tuple(np.minimum(np.array(right)-1,loc[-len(right):]))
assert np.allclose(o[l].to_SST(v[r]),
o.to_SST(v)[tuple(loc)])
@pytest.mark.parametrize('lattice,a,b,c,alpha,beta,gamma',
@ -517,8 +517,10 @@ class TestOrientation:
v = np.random.random(right+(3,))
blend = util.shapeblender(o.shape,v.shape[:-1])
for loc in np.random.randint(0,blend,(10,len(blend))):
assert np.allclose(o[tuple(loc[:len(o.shape)])].to_pole(uvw=v[tuple(loc[-len(v.shape[:-1]):])]),
o.to_pole(uvw=v)[tuple(loc)])
l = () if left is None else tuple(np.minimum(np.array(left )-1,loc[:len(left)]))
r = () if right is None else tuple(np.minimum(np.array(right)-1,loc[-len(right):]))
assert np.allclose(o[l].to_pole(uvw=v[r]),
o.to_pole(uvw=v)[tuple(loc)])
def test_mul_invalid(self):
with pytest.raises(TypeError):

2
python/tests/test_Result.py
View File

@ -326,7 +326,7 @@ class TestResult:
if shape == 'pseudo_scalar': default.add_calculation('#F#[:,0,0:1]','x','1','a pseudo scalar')
if shape == 'scalar': default.add_calculation('#F#[:,0,0]','x','1','just a scalar')
if shape == 'vector': default.add_calculation('#F#[:,:,1]','x','1','just a vector')
x = default.place('x').reshape((np.product(default.cells),-1))
x = default.place('x').reshape((np.prod(default.cells),-1))
default.add_gradient('x')
in_file = default.place('gradient(x)')
in_memory = grid_filters.gradient(default.size,x.reshape(tuple(default.cells)+x.shape[1:])).reshape(in_file.shape)

9
python/tests/test_Rotation.py
View File

@ -975,6 +975,13 @@ class TestRotation:
assert np.allclose(rot_broadcast.quaternion[...,i,:], rot.quaternion)
@pytest.mark.parametrize('shape',[(3,2),(4,6)])
def test_broadcastcomposition(self,shape):
a = Rotation.from_random(shape[0])
b = Rotation.from_random(shape[1])
assert (a[:,np.newaxis]*b[np.newaxis,:]).allclose(a.broadcast_to(shape)*b.broadcast_to(shape))
@pytest.mark.parametrize('function,invalid',[(Rotation.from_quaternion, np.array([-1,0,0,0])),
(Rotation.from_quaternion, np.array([1,1,1,0])),
(Rotation.from_Euler_angles, np.array([1,4,0])),
@ -1058,7 +1065,7 @@ class TestRotation:
@pytest.mark.parametrize('data',[np.random.rand(4),
np.random.rand(3,2),
np.random.rand(3,2,3,3)])
np.random.rand(3,3,3,1)])
def test_rotate_invalid_shape(self,data):
R = Rotation.from_random()
with pytest.raises(ValueError):

2
python/tests/test_grid_filters.py
View File

@ -398,7 +398,7 @@ class TestGridFilters:
np.arange(cells[1]),
np.arange(cells[2]),indexing='ij')).reshape(tuple(cells)+(3,),order='F')
x,y,z = map(np.random.randint,cells)
assert grid_filters.ravel_index(indices)[x,y,z] == np.arange(0,np.product(cells)).reshape(cells,order='F')[x,y,z]
assert grid_filters.ravel_index(indices)[x,y,z] == np.arange(0,np.prod(cells)).reshape(cells,order='F')[x,y,z]
def test_unravel_index(self):
cells = np.random.randint(8,32,(3))

42
python/tests/test_util.py
View File

@ -128,39 +128,47 @@ class TestUtil:
with pytest.raises(ValueError):
util.shapeshifter(fro,to,mode)
@pytest.mark.parametrize('a,b,answer',
@pytest.mark.parametrize('a,b,ones,answer',
[
((),(1,),(1,)),
((1,),(),(1,)),
((1,),(7,),(1,7)),
((2,),(2,2),(2,2)),
((1,2),(2,2),(1,2,2)),
((1,2,3),(2,3,4),(1,2,3,4)),
((1,2,3),(1,2,3),(1,2,3)),
((),(1,),True,(1,)),
((1,),(),False,(1,)),
((1,1),(7,),False,(1,7)),
((1,),(7,),False,(7,)),
((1,),(7,),True,(1,7)),
((2,),(2,2),False,(2,2)),
((1,2),(2,2),False,(2,2)),
((1,1,2),(2,2),False,(1,2,2)),
((1,1,2),(2,2),True,(1,1,2,2)),
((1,2,3),(2,3,4),False,(1,2,3,4)),
((1,2,3),(1,2,3),False,(1,2,3)),
])
def test_shapeblender(self,a,b,answer):
assert util.shapeblender(a,b) == answer
def test_shapeblender(self,a,b,ones,answer):
assert util.shapeblender(a,b,ones) == answer
@pytest.mark.parametrize('style',[util.emph,util.deemph,util.warn,util.strikeout])
def test_decorate(self,style):
assert 'DAMASK' in style('DAMASK')
@pytest.mark.parametrize('complete',[True,False])
def test_D3D_base_group(self,tmp_path,complete):
@pytest.mark.parametrize('fhandle',[True,False])
def test_D3D_base_group(self,tmp_path,complete,fhandle):
base_group = ''.join(random.choices('DAMASK', k=10))
with h5py.File(tmp_path/'base_group.dream3d','w') as f:
f.create_group('/'.join((base_group,'_SIMPL_GEOMETRY')))
if complete:
f['/'.join((base_group,'_SIMPL_GEOMETRY'))].create_dataset('SPACING',data=np.ones(3))
fname = tmp_path/'base_group.dream3d'
if fhandle: fname = h5py.File(fname)
if complete:
assert base_group == util.DREAM3D_base_group(tmp_path/'base_group.dream3d')
assert base_group == util.DREAM3D_base_group(fname)
else:
with pytest.raises(ValueError):
util.DREAM3D_base_group(tmp_path/'base_group.dream3d')
util.DREAM3D_base_group(fname)
@pytest.mark.parametrize('complete',[True,False])
def test_D3D_cell_data_group(self,tmp_path,complete):
@pytest.mark.parametrize('fhandle',[True,False])
def test_D3D_cell_data_group(self,tmp_path,complete,fhandle):
base_group = ''.join(random.choices('DAMASK', k=10))
cell_data_group = ''.join(random.choices('KULeuven', k=10))
cells = np.random.randint(1,50,3)
@ -172,11 +180,13 @@ class TestUtil:
if complete:
f['/'.join((base_group,cell_data_group))].create_dataset('data',shape=np.append(cells,1))
fname = tmp_path/'cell_data_group.dream3d'
if fhandle: fname = h5py.File(fname)
if complete:
assert cell_data_group == util.DREAM3D_cell_data_group(tmp_path/'cell_data_group.dream3d')
assert cell_data_group == util.DREAM3D_cell_data_group(fname)
else:
with pytest.raises(ValueError):
util.DREAM3D_cell_data_group(tmp_path/'cell_data_group.dream3d')
util.DREAM3D_cell_data_group(fname)
@pytest.mark.parametrize('full,reduced',[({}, {}),

267
src/CLI.f90
View File

@ -21,14 +21,16 @@ module CLI
implicit none(type,external)
private
integer, public, protected :: &
CLI_restartInc = 0 !< Increment at which calculation starts
CLI_restartInc = 0 !< increment at which calculation starts
character(len=:), allocatable, public, protected :: &
CLI_geomFile, & !< parameter given for geometry file
CLI_loadFile, & !< parameter given for load case file
CLI_materialFile
CLI_geomFile, & !< location of the geometry file
CLI_loadFile, & !< location of the load case file
CLI_materialFile, & !< location of the material configuration file
CLI_numericsFile, & !< location of the numerics configuration file
solverJobname
public :: &
getSolverJobName, &
getSolverJobname, &
CLI_init
contains
@ -47,148 +49,177 @@ subroutine CLI_init()
character(len=:), allocatable :: &
commandLine, & !< command line call as string
arg, & !< individual argument
loadCaseArg, & !< -l argument given to the executable
geometryArg, & !< -g argument given to the executable
materialArg, & !< -m argument given to the executable
workingDirArg !< -w argument given to the executable
geomArg, & !< -g CLI argument
loadArg, & !< -l CLI argument
materialArg, & !< -m CLI argument
numericsArg, & !< -n CLI argument
workingDirArg !< -w CLI argument
integer :: &
stat, &
i
integer, dimension(8) :: &
dateAndTime
logical :: &
hasArg
external :: &
quit
workingDirArg = getCWD()
print '(/,1x,a)', '<<<+- CLI init -+>>>'
print'(/,1x,a)', '<<<+- CLI init -+>>>'
! http://patorjk.com/software/taag/#p=display&f=Lean&t=DAMASK%203
#ifdef DEBUG
print '(a)', achar(27)//'[31m'
print '(1x,a,/)', 'debug version - debug version - debug version - debug version - debug version'
print'(a)', achar(27)//'[31m'
print'(1x,a,/)', 'debug version - debug version - debug version - debug version - debug version'
#else
print '(a)', achar(27)//'[94m'
print'(a)', achar(27)//'[1;94m'
#endif
print '(1x,a)', ' _/_/_/ _/_/ _/ _/ _/_/ _/_/_/ _/ _/ _/_/_/'
print '(1x,a)', ' _/ _/ _/ _/ _/_/ _/_/ _/ _/ _/ _/ _/ _/'
print '(1x,a)', ' _/ _/ _/_/_/_/ _/ _/ _/ _/_/_/_/ _/_/ _/_/ _/_/'
print '(1x,a)', ' _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/'
print '(1x,a)', '_/_/_/ _/ _/ _/ _/ _/ _/ _/_/_/ _/ _/ _/_/_/'
print'(1x,a)', ' _/_/_/ _/_/ _/ _/ _/_/ _/_/_/ _/ _/ _/_/_/'
print'(1x,a)', ' _/ _/ _/ _/ _/_/ _/_/ _/ _/ _/ _/ _/ _/'
print'(1x,a)', ' _/ _/ _/_/_/_/ _/ _/ _/ _/_/_/_/ _/_/ _/_/ _/_/'
print'(1x,a)', ' _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/'
print'(1x,a)', '_/_/_/ _/ _/ _/ _/ _/ _/ _/_/_/ _/ _/ _/_/_/'
#if defined(GRID)
print '(1x,a)', 'Grid solver'
print'(1x,a)', 'Grid solver'
#elif defined(MESH)
print '(1x,a)', 'Mesh solver'
print'(1x,a)', 'Mesh solver'
#endif
#ifdef DEBUG
print '(/,1x,a)', 'debug version - debug version - debug version - debug version - debug version'
print'(/,1x,a)', 'debug version - debug version - debug version - debug version - debug version'
#endif
print '(a)', achar(27)//'[0m'
print'(a)', achar(27)//'[0m'
print '(1x,a)', 'F. Roters et al., Computational Materials Science 158:420–478, 2019'
print '(1x,a)', 'https://doi.org/10.1016/j.commatsci.2018.04.030'
print'(1x,a)', 'F. Roters et al., Computational Materials Science 158:420–478, 2019'
print'(1x,a)', 'https://doi.org/10.1016/j.commatsci.2018.04.030'
print '(/,1x,a)', 'Version: '//DAMASKVERSION
print'(/,1x,a)', 'Version: '//DAMASKVERSION
print '(/,1x,a)', 'Compiled with: '//compiler_version()
print '(1x,a)', 'Compiled on: '//CMAKE_SYSTEM
print '(1x,a)', 'Compiler options: '//compiler_options()
print'(/,1x,a)', 'Compiled with: '//compiler_version()
print'(1x,a)', 'Compiled on: '//CMAKE_SYSTEM
print'(1x,a)', 'Compiler options: '//compiler_options()
! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
print '(/,1x,a)', 'Compiled on: '//__DATE__//' at '//__TIME__
print'(/,1x,a)', 'Compiled on: '//__DATE__//' at '//__TIME__
print '(/,1x,a,1x,i0,a,i0,a,i0)', &
print'(/,1x,a,1x,i0,a,i0,a,i0)', &
'PETSc version:',PETSC_VERSION_MAJOR,'.',PETSC_VERSION_MINOR,'.',PETSC_VERSION_SUBMINOR
call date_and_time(values = dateAndTime)
print '(/,1x,a,1x,2(i2.2,a),i4.4)', 'Date:',dateAndTime(3),'/',dateAndTime(2),'/',dateAndTime(1)
print '(1x,a,1x,2(i2.2,a),i2.2)', 'Time:',dateAndTime(5),':',dateAndTime(6),':',dateAndTime(7)
print'(/,1x,a,1x,2(i2.2,a),i4.4)', 'Date:',dateAndTime(3),'/',dateAndTime(2),'/',dateAndTime(1)
print'(1x,a,1x,2(i2.2,a),i2.2)', 'Time:',dateAndTime(5),':',dateAndTime(6),':',dateAndTime(7)
do i = 1, command_argument_count()
hasArg = i < command_argument_count()
arg = getArg(i)
select case(trim(arg)) ! extract key
case ('-h','--help')
print '(/,1x,a)','#######################################################################'
print '(1x,a)', 'DAMASK Command Line Interface:'
print '(1x,a)', 'Düsseldorf Advanced Material Simulation Kit with PETSc-based solvers'
print '(1x,a,/)','#######################################################################'
print '(1x,a,/)','Valid command line switches:'
print '(1x,a)', ' --geom (-g, --geometry)'
print '(1x,a)', ' --load (-l, --loadcase)'
print '(1x,a)', ' --material (-m, --materialconfig)'
print '(1x,a)', ' --workingdir (-w, --wd, --workingdirectory)'
print '(1x,a)', ' --restart (-r, --rs)'
print '(1x,a)', ' --help (-h)'
print '(/,1x,a)','-----------------------------------------------------------------------'
print '(1x,a)', 'Mandatory arguments:'
print '(/,1x,a)',' --geom PathToGeomFile/NameOfGeom'
print '(1x,a)', ' Specifies the location of the geometry definition file.'
print '(/,1x,a)',' --load PathToLoadFile/NameOfLoadFile'
print '(1x,a)', ' Specifies the location of the load case definition file.'
print '(/,1x,a)',' --material PathToMaterialConfigurationFile/NameOfMaterialConfigurationFile'
print '(1x,a)', ' Specifies the location of the material configuration file.'
print '(/,1x,a)','-----------------------------------------------------------------------'
print '(1x,a)', 'Optional arguments:'
print '(/,1x,a)',' --workingdirectory PathToWorkingDirectory'
print '(1x,a)', ' Specifies the base directory of relative paths.'
print '(/,1x,a)',' --restart N'
print '(1x,a)', ' Reads in increment N and continues with calculating'
print '(1x,a)', ' increment N+1, N+2, ... based on this.'
print '(1x,a)', ' Appends to existing results file'
print '(1x,a)', ' "NameOfGeom_NameOfLoadFile_NameOfMaterialConfigurationFile.hdf5".'
print '(1x,a)', ' Works only if the restart information for increment N'
print '(1x,a)', ' is available in the base directory.'
print '(/,1x,a)','-----------------------------------------------------------------------'
print '(1x,a)', 'Help:'
print '(/,1x,a)',' --help'
print '(1x,a,/)',' Prints this message and exits'
print'(/,1x,a)','#######################################################################'
print'(1x,a)', 'DAMASK Command Line Interface:'
print'(1x,a)', 'Düsseldorf Advanced Material Simulation Kit with PETSc-based solvers'
print'(1x,a,/)','#######################################################################'
print'(1x,a,/)','Valid command line switches:'
print'(1x,a)', ' --geom (-g, --geometry)'
print'(1x,a)', ' --load (-l, --loadcase)'
print'(1x,a)', ' --material (-m, --materialconfig)'
print'(1x,a)', ' --numerics (-n, --numericsconfig)'
print'(1x,a)', ' --jobname (-j, --job)'
print'(1x,a)', ' --workingdir (-w, --wd, --workingdirectory)'
print'(1x,a)', ' --restart (-r, --rs)'
print'(1x,a)', ' --help (-h)'
print'(/,1x,a)','-----------------------------------------------------------------------'
print'(1x,a)', 'Mandatory arguments:'
print'(/,1x,a)',' --geom GEOMFILE'
print'(1x,a)', ' specify the file path of the geometry definition'
print'(/,1x,a)',' --load LOADFILE'
print'(1x,a)', ' specify the file path of the load case definition'
print'(/,1x,a)',' --material MATERIALFILE'
print'(1x,a)', ' specify the file path of the material configuration'
print'(/,1x,a)','-----------------------------------------------------------------------'
print'(1x,a)', 'Optional arguments:'
print'(/,1x,a)',' --numerics NUMERICSFILE'
print'(1x,a)', ' Specify the file path of the numerics configuration'
print'(/,1x,a)',' --jobname JOBNAME'
print'(1x,a)', ' specify the job name.'
print'(1x,a)', ' Defaults to GEOM_LOAD_MATERIAL[_NUMERICS].'
print'(/,1x,a)',' --workingdirectory WORKINGDIRECTORY'
print'(1x,a)', ' specify the base directory of relative paths.'
print'(1x,a)', ' Defaults to the current working directory'
print'(/,1x,a)',' --restart N'
print'(1x,a)', ' read in increment N and continues with calculating'
print'(1x,a)', ' increment N+1, N+2, ... based on this'
print'(1x,a)', ' works only if the restart information for increment N'
print'(1x,a)', ' is available in JOBNAME_restart.hdf5'
print'(1x,a)', ' append to existing results file JOBNAME.hdf5'
print'(/,1x,a)','-----------------------------------------------------------------------'
print'(1x,a)', 'Help:'
print'(/,1x,a)',' --help'
print'(1x,a,/)',' Prints this message and exits'
call quit(0) ! normal Termination
case ('-l', '--load', '--loadcase')
loadCaseArg = getArg(i+1)
case ('-g', '--geom', '--geometry')
geometryArg = getArg(i+1)
if (.not. hasArg) call IO_error(610,ext_msg='--geom')
geomArg = getArg(i+1)
case ('-l', '--load', '--loadcase')
if (.not. hasArg) call IO_error(610,ext_msg='--load')
loadArg = getArg(i+1)
case ('-m', '--material', '--materialconfig')
if (.not. hasArg) call IO_error(610,ext_msg='--material')
materialArg = getArg(i+1)
case ('-n', '--numerics', '--numericsconfig')
if (.not. hasArg) call IO_error(610,ext_msg='--numerics')
numericsArg = getArg(i+1)
case ('-j', '--job', '--jobname')
if (.not. hasArg) call IO_error(610,ext_msg='--jobname')
solverJobname = getArg(i+1)
case ('-w', '--wd', '--workingdir', '--workingdirectory')
if (.not. hasArg) call IO_error(610,ext_msg='--workingdirectory')
workingDirArg = getArg(i+1)
case ('-r', '--rs', '--restart')
if (.not. hasArg) call IO_error(610,ext_msg='--jobname')
arg = getArg(i+1)
read(arg,*,iostat=stat) CLI_restartInc
if (CLI_restartInc < 0 .or. stat /= 0) then
print'(/,1x,a)', 'ERROR: Could not parse restart increment: '//trim(arg)
call quit(1)
end if
CLI_restartInc = IO_strAsInt(arg)
if (CLI_restartInc < 0 .or. stat /= 0) call IO_error(611,ext_msg=arg)
end select
end do
if (.not. all([allocated(loadcaseArg),allocated(geometryArg),allocated(materialArg)])) then
print '(/,1x,a)', 'ERROR: Please specify geometry AND load case AND material configuration (-h for help)'
call quit(1)
end if
if (.not. allocated(geomArg)) call IO_error(612,ext_msg='--geom')
if (.not. allocated(loadArg)) call IO_error(612,ext_msg='--load')
if (.not. allocated(materialArg)) call IO_error(612,ext_msg='--material')
call setWorkingDirectory(trim(workingDirArg))
CLI_geomFile = getPathRelCWD(geometryArg,'geometry')
CLI_loadFile = getPathRelCWD(loadCaseArg,'load case')
CLI_geomFile = getPathRelCWD(geomArg,'geometry')
CLI_loadFile = getPathRelCWD(loadArg,'load case')
CLI_materialFile = getPathRelCWD(materialArg,'material configuration')
if (allocated(numericsArg)) &
CLI_numericsFile = getPathRelCWD(numericsArg,'numerics configuration')
if (.not. allocated(solverJobname)) then
solverJobname = jobname(CLI_geomFile,CLI_loadFile,CLI_materialFile,CLI_numericsFile)
elseif (scan(solverJobname,'/') > 0) then
call IO_error(630)
endif
commandLine = getArg(-1)
print '(/,1x,a)', 'Host name: '//getHostName()
print '(1x,a)', 'User name: '//getUserName()
print'(/,1x,a)', 'Host name: '//getHostName()
print'(1x,a)', 'User name: '//getUserName()
print '(/,1x,a,/)', 'Command line call: '//trim(commandLine)
print '(1x,a)', 'Working directory: '//IO_glueDiffering(getCWD(),workingDirArg)
print '(1x,a)', 'Geometry: '//IO_glueDiffering(CLI_geomFile,geometryArg)
print '(1x,a)', 'Load case: '//IO_glueDiffering(CLI_loadFile,loadCaseArg)
print '(1x,a)', 'Material config: '//IO_glueDiffering(CLI_materialFile,materialArg)
print '(1x,a)', 'Solver job name: '//getSolverJobName()
print'(/,1x,a,/)', 'Command line call: '//trim(commandLine)
print'(1x,a)', 'Working directory: '//IO_glueDiffering(getCWD(),workingDirArg)
print'(1x,a)', 'Geometry: '//IO_glueDiffering(CLI_geomFile,geomArg)
print'(1x,a)', 'Load case: '//IO_glueDiffering(CLI_loadFile,loadArg)
print'(1x,a)', 'Material config: '//IO_glueDiffering(CLI_materialFile,materialArg)
if (allocated(numericsArg)) &
print'(1x,a)', 'Numerics config: '//IO_glueDiffering(CLI_numericsFile,numericsArg)
print'(1x,a)', 'Solver job name: '//getSolverJobname()
if (CLI_restartInc > 0) &
print '(1x,a,i6.6)', 'Restart from increment: ', CLI_restartInc
print'(1x,a,i6.6)', 'Restart from increment: ', CLI_restartInc
end subroutine CLI_init
!--------------------------------------------------------------------------------------------------
!> @brief Get argument from command line.
!--------------------------------------------------------------------------------------------------
@ -228,9 +259,6 @@ subroutine setWorkingDirectory(workingDirectoryArg)
character(len=*), intent(in) :: workingDirectoryArg !< working directory argument
character(len=:), allocatable :: workingDirectory
logical :: error
external :: quit
absolutePath: if (workingDirectoryArg(1:1) == '/') then
workingDirectory = workingDirectoryArg
@ -240,36 +268,50 @@ subroutine setWorkingDirectory(workingDirectoryArg)
end if absolutePath
workingDirectory = trim(normpath(workingDirectory))
error = setCWD(trim(workingDirectory))
if (error) then
print '(1x,a)', 'ERROR: Invalid Working directory: '//trim(workingDirectory)
call quit(1)
end if
if (setCWD(trim(workingDirectory))) call IO_error(640,ext_msg=workingDirectory)
end subroutine setWorkingDirectory
!--------------------------------------------------------------------------------------------------
!> @brief solver job name (no extension) as combination of geometry and load case name
!> @brief Return solver job name (MSC.Marc compatible).
!--------------------------------------------------------------------------------------------------
function getSolverJobName()
function getSolverJobname()
character(len=:), allocatable :: getSolverJobName
integer :: posExt,posSep
character(len=:), allocatable :: getSolverJobname
posExt = scan(CLI_geomFile,'.',back=.true.)
posSep = scan(CLI_geomFile,'/',back=.true.)
getSolverJobname = solverJobname
getSolverJobName = CLI_geomFile(posSep+1:posExt-1)
end function getSolverJobname
posExt = scan(CLI_loadFile,'.',back=.true.)
posSep = scan(CLI_loadFile,'/',back=.true.)
getSolverJobName = getSolverJobName//'_'//CLI_loadFile(posSep+1:posExt-1)
!--------------------------------------------------------------------------------------------------
!> @brief Determine solver job name.
!--------------------------------------------------------------------------------------------------
function jobname(geomFile,LoadFile,materialsFile,numericsFile)
end function getSolverJobName
character(len=:), allocatable :: jobname
character(len=*), intent(in) :: geomFile,loadFile,materialsFile
character(len=:), allocatable, intent(in) :: numericsFile
jobname = stem(geomFile)//'_'//stem(loadFile)//'_'//stem(materialsFile)
if (allocated(numericsFile)) jobname = jobname//'_'//stem(numericsFile)
contains
function stem(fullname)
character(len=:), allocatable :: stem
character(len=*), intent(in) :: fullname
stem = fullname(scan(fullname,'/',back=.true.)+1:scan(fullname,'.',back=.true.)-1)
end function stem
end function jobname
!--------------------------------------------------------------------------------------------------
@ -282,7 +324,6 @@ function getPathRelCWD(path,fileType)
character(len=*), intent(in) :: fileType
logical :: file_exists
external :: quit
getPathRelCWD = trim(path)
@ -290,10 +331,7 @@ function getPathRelCWD(path,fileType)
getPathRelCWD = trim(relpath(getPathRelCWD,getCWD()))
inquire(file=getPathRelCWD, exist=file_exists)
if (.not. file_exists) then
print '(1x,a)', 'ERROR: '//fileType//' file does not exist: '//trim(getPathRelCWD)
call quit(1)
end if
if (.not. file_exists) call IO_error(100,ext_msg=fileType//' "'//trim(getPathRelCWD)//'"')
end function getPathRelCWD
@ -376,4 +414,5 @@ function relpath(path,start)
end function relpath
end module CLI

15
src/CMakeLists.txt
View File

@ -1,10 +1,3 @@
# special flags for some files
if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
# long lines for interaction matrix
set_source_files_properties("lattice.f90" PROPERTIES COMPILE_FLAGS "-ffree-line-length-240")
set_source_files_properties("parallelization.f90" PROPERTIES COMPILE_FLAGS "-ffree-line-length-none")
endif()
file(GLOB damask-sources CONFIGURE_DEPENDS *.f90 *.c)
if(PROJECT_NAME STREQUAL "damask-grid")
@ -18,14 +11,6 @@ elseif(PROJECT_NAME STREQUAL "damask-test")
file(GLOB solver-sources CONFIGURE_DEPENDS test/*.f90)
endif()
foreach(solver-source ${solver-sources})
file(READ ${solver-source} content)
string(FIND "${content}" "CHKERR" found)
if((NOT ${found} EQUAL -1) AND (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU"))
set_source_files_properties(${solver-source} PROPERTIES COMPILE_FLAGS "-ffree-line-length-none")
endif()
endforeach()
if(NOT CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
add_executable(${executable-name} ${damask-sources} ${solver-sources})

33
src/HDF5_utilities.f90
View File

@ -6,6 +6,7 @@
!> @author Philip Eisenlohr, Michigan State University
!--------------------------------------------------------------------------------------------------
module HDF5_utilities
use IO
use HDF5
#ifdef PETSC
#include <petsc/finclude/petscsys.h>
@ -190,6 +191,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
character :: m
integer(HID_T) :: plist_id
integer :: hdferr
logical :: exist
m = misc_optional(mode,'r')
@ -214,6 +216,8 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
call H5Fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id)
call HDF5_chkerr(hdferr)
elseif (m == 'r') then
inquire(file=fileName,exist=exist)
if (.not. exist) call IO_error(100,trim(fileName))
call H5Fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id)
call HDF5_chkerr(hdferr)
else
@ -1836,15 +1840,13 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in) :: parallel
integer(HSIZE_T), intent(in), dimension(:) :: &
localShape
integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: &
integer(HSIZE_T), intent(in), dimension(:) :: localShape
integer(HSIZE_T), intent(out), dimension(size(localShape)) :: &
myStart, &
globalShape !< shape of the dataset (all processes)
integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(MPI_INTEGER_KIND), dimension(worldsize) :: &
readSize !< contribution of all processes
integer(MPI_INTEGER_KIND), dimension(worldsize) :: readSize !< contribution of all processes
integer :: hdferr
integer(MPI_INTEGER_KIND) :: err_MPI
@ -1860,7 +1862,8 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
if (parallel) then
call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
call HDF5_chkerr(hdferr)
call MPI_Allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get total output size over each process
call MPI_Allgather(int(localShape(ubound(localShape,1)),MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
readSize,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
end if
#endif
@ -1930,15 +1933,14 @@ end subroutine finalize_read
!--------------------------------------------------------------------------------------------------
subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, &
loc_id,myShape,datasetName,datatype,parallel)
loc_id,localShape,datasetName,datatype,parallel)
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in) :: parallel
integer(HID_T), intent(in) :: datatype
integer(HSIZE_T), intent(in), dimension(:) :: &
myShape
integer(HSIZE_T), intent(out), dimension(size(myShape,1)):: &
integer(HSIZE_T), intent(in), dimension(:) :: localShape
integer(HSIZE_T), intent(out), dimension(size(localShape)) :: &
myStart, &
totalShape !< shape of the dataset (all processes)
integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id
@ -1964,16 +1966,17 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
!--------------------------------------------------------------------------------------------------
! determine the global data layout among all processes
writeSize = 0_MPI_INTEGER_KIND
writeSize(worldrank+1) = int(myShape(ubound(myShape,1)),MPI_INTEGER_KIND)
writeSize(worldrank+1) = int(localShape(ubound(localShape,1)),MPI_INTEGER_KIND)
#ifdef PETSC
if (parallel) then
call MPI_Allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get total output size over each process
call MPI_Allgather(int(localShape(ubound(localShape,1)),MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
writeSize,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
end if
#endif
myStart = int(0,HSIZE_T)
myStart(ubound(myStart)) = int(sum(writeSize(1:worldrank)),HSIZE_T)
totalShape = [myShape(1:ubound(myShape,1)-1),int(sum(writeSize),HSIZE_T)]
totalShape = [localShape(1:ubound(localShape,1)-1),int(sum(writeSize),HSIZE_T)]
!--------------------------------------------------------------------------------------------------
! chunk dataset, enable compression for larger datasets
@ -2001,7 +2004,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
!--------------------------------------------------------------------------------------------------
! create dataspace in memory (local shape) and in file (global shape)
call H5Screate_simple_f(size(myShape), myShape, memspace_id, hdferr, myShape)
call H5Screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape)
call HDF5_chkerr(hdferr)
call H5Screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape)
call HDF5_chkerr(hdferr)
@ -2010,7 +2013,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
! create dataset in the file and select a hyperslab from it (the portion of the current process)
call H5Dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr, dcpl)
call HDF5_chkerr(hdferr)
call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, myShape, hdferr)
call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr)
call HDF5_chkerr(hdferr)
call H5Pclose_f(dcpl , hdferr)

71
src/IO.f90
View File

@ -11,6 +11,7 @@ module IO
IO_STDERR => ERROR_UNIT
use prec
use constants
use misc
implicit none(type,external)
@ -20,14 +21,12 @@ module IO
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_EOL = LF, & !< end of line character
IO_COMMENT = '#'
character, parameter :: &
CR = achar(13), &
LF = IO_EOL
public :: &
IO_init, &
IO_selfTest, &
IO_read, &
IO_readlines, &
IO_isBlank, &
@ -57,7 +56,7 @@ subroutine IO_init()
print'(/,1x,a)', '<<<+- IO init -+>>>'; flush(IO_STDOUT)
call selfTest()
call IO_selfTest()
end subroutine IO_init
@ -294,9 +293,6 @@ pure function IO_lc(str)
character(len=*), intent(in) :: str !< string to convert
character(len=len(str)) :: IO_lc
character(len=*), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(len=len(LOWER)), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,n
@ -476,7 +472,7 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2)
case (131)
msg = 'hex lattice structure with invalid c/a ratio'
case (132)
msg = 'trans_lattice_structure not possible'
msg = 'invalid parameters for transformation'
case (134)
msg = 'negative lattice parameter'
case (135)
@ -553,8 +549,22 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2)
!--------------------------------------------------------------------------------------------------
! user errors
case (600)
msg = 'only one source entry allowed'
case (603)
msg = 'invalid data for table'
case (610)
msg = 'missing argument for option'
case (611)
msg = 'could not parse restart increment'
case (612)
msg = 'missing option'
case (630)
msg = 'JOBNAME must not contain any slashes'
case (640)
msg = 'invalid working directory'
!------------------------------------------------------------------------------------------------
! errors related to YAML data
@ -622,9 +632,9 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2)
end select
call panel('error',error_ID,msg, &
ext_msg=ext_msg, &
label1=label1,ID1=ID1, &
label2=label2,ID2=ID2)
ext_msg=ext_msg, &
label1=label1,ID1=ID1, &
label2=label2,ID2=ID2)
call quit(9000+error_ID)
end subroutine IO_error
@ -704,38 +714,43 @@ subroutine panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2)
character(len=pSTRLEN) :: formatString
integer, parameter :: panelwidth = 69
character(len=:), allocatable :: msg_,ID_,msg1,msg2
character(len=*), parameter :: DIVIDER = repeat('─',panelwidth)
if (.not. present(label1) .and. present(ID1)) error stop 'missing label for value 1'
if (.not. present(label2) .and. present(ID2)) error stop 'missing label for value 2'
if ( present(label1) .and. .not. present(ID1)) error stop 'missing value for label 1'
if ( present(label2) .and. .not. present(ID2)) error stop 'missing value for label 2'
ID_ = IO_intAsStr(ID)
if (present(label1)) msg1 = label1
if (present(label2)) msg2 = label2
if (present(ID1)) msg1 = msg1//' '//IO_intAsStr(ID1)
if (present(ID2)) msg2 = msg2//' '//IO_intAsStr(ID2)
if (paneltype == 'error') msg_ = achar(27)//'[31m'//trim(msg)//achar(27)//'[0m'
if (paneltype == 'warning') msg_ = achar(27)//'[33m'//trim(msg)//achar(27)//'[0m'
!$OMP CRITICAL (write2out)
write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐'
write(formatString,'(a,i2,a)') '(a,24x,a,',max(1,panelwidth-24-len_trim(paneltype)),'x,a)'
write(IO_STDERR,formatString) ' │',trim(paneltype), '│'
write(formatString,'(a,i2,a)') '(a,24x,i3,',max(1,panelwidth-24-3),'x,a)'
write(IO_STDERR,formatString) ' │',ID, '│'
write(formatString,'(a,i2,a)') '(a,24x,a,1x,i0,',max(1,panelwidth-24-len_trim(paneltype)-1-len_trim(ID_)),'x,a)'
write(IO_STDERR,formatString) ' │',trim(paneltype),ID, '│'
write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤'
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(msg_)),',',&
max(1,panelwidth+3-len_trim(msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(msg), '│'
write(IO_STDERR,formatString) '│ ',trim(msg_), '│'
if (present(ext_msg)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,panelwidth+3-len_trim(ext_msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│'
end if
if (present(label1)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',&
max(1,panelwidth+3-len_trim(label1)-9-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│'
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(msg1)),',',&
max(1,panelwidth+3-len_trim(msg1)-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(msg1), '│'
end if
if (present(label2)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',&
max(1,panelwidth+3-len_trim(label2)-9-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│'
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(msg2)),',',&
max(1,panelwidth+3-len_trim(msg2)-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(msg2), '│'
end if
write(formatString,'(a,i2.2,a)') '(a,',max(1,panelwidth),'x,a)'
write(IO_STDERR,formatString) ' │', '│'
@ -749,7 +764,7 @@ end subroutine panel
!--------------------------------------------------------------------------------------------------
!> @brief Check correctness of some IO functions.
!--------------------------------------------------------------------------------------------------
subroutine selfTest()
subroutine IO_selfTest()
integer, dimension(:), allocatable :: chunkPos
character(len=:), allocatable :: str,out
@ -832,6 +847,6 @@ subroutine selfTest()
if ('abc,'//IO_EOL//'xxdefg,'//IO_EOL//'xxhij' /= IO_wrapLines('abc,defg, hij',filler='xx',length=4)) &
error stop 'IO_wrapLines/7'
end subroutine selfTest
end subroutine IO_selfTest
end module IO

49
src/Marc/DAMASK_Marc.f90
View File

@ -16,15 +16,24 @@
#endif
#include "../prec.f90"
#include "../parallelization.f90"
#include "../constants.f90"
#include "../misc.f90"
#include "../IO.f90"
#include "../YAML_types.f90"
#include "../YAML_parse.f90"
#include "../HDF5_utilities.f90"
module DAMASK_interface
use prec
use, intrinsic :: ISO_fortran_env, only: &
compiler_version, &
compiler_options
use ifport, only: &
CHDIR
use prec
use IO
implicit none(type,external)
private
@ -105,7 +114,7 @@ logical function solverIsSymmetric()
status='old', position='rewind', action='read',iostat=myStat)
do
read (fileUnit,'(A)',END=100) line
if (index(trim(lc(line)),'solver') == 1) then
if (index(trim(IO_lc(line)),'solver') == 1) then
read (fileUnit,'(A)',END=100) line ! next line
s = verify(line, ' ') ! start of first chunk
s = s + verify(line(s+1:),' ') ! start of second chunk
@ -114,40 +123,11 @@ logical function solverIsSymmetric()
end if
end do
100 close(fileUnit)
contains
!--------------------------------------------------------------------------------------------------
!> @brief changes characters in string to lower case
!> @details copied from IO_lc
!--------------------------------------------------------------------------------------------------
function lc(string)
character(len=*), intent(in) :: string !< string to convert
character(len=len(string)) :: lc
character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,n
do i=1,len(string)
lc(i:i) = string(i:i)
n = index(UPPER,lc(i:i))
if (n/=0) lc(i:i) = LOWER(n:n)
end do
end function lc
end function solverIsSymmetric
end module DAMASK_interface
#include "../parallelization.f90"
#include "../misc.f90"
#include "../constants.f90"
#include "../IO.f90"
#include "../YAML_types.f90"
#include "../YAML_parse.f90"
#include "../HDF5_utilities.f90"
#include "../result.f90"
#include "../config.f90"
#include "../LAPACK_interface.f90"
@ -155,7 +135,7 @@ end module DAMASK_interface
#include "../rotations.f90"
#include "../polynomials.f90"
#include "../tables.f90"
#include "../lattice.f90"
#include "../crystal.f90"
#include "element.f90"
#include "../geometry_plastic_nonlocal.f90"
#include "../discretization.f90"
@ -173,11 +153,10 @@ end module DAMASK_interface
#include "../phase_mechanical_plastic_dislotungsten.f90"
#include "../phase_mechanical_plastic_nonlocal.f90"
#include "../phase_mechanical_eigen.f90"
#include "../phase_mechanical_eigen_cleavageopening.f90"
#include "../phase_mechanical_eigen_thermalexpansion.f90"
#include "../phase_thermal.f90"
#include "../phase_thermal_dissipation.f90"
#include "../phase_thermal_externalheat.f90"
#include "../phase_thermal_source_dissipation.f90"
#include "../phase_thermal_source_externalheat.f90"
#include "../phase_damage.f90"
#include "../phase_damage_isobrittle.f90"
#include "../phase_damage_anisobrittle.f90"

14
src/Marc/discretization_Marc.f90
View File

@ -69,14 +69,16 @@ subroutine discretization_Marc_init
unscaledNormals
type(tDict), pointer :: &
num_solver, &
num_commercialFEM
print'(/,a)', ' <<<+- discretization_Marc init -+>>>'; flush(6)
num_commercialFEM => config_numerics%get_dict('commercialFEM',defaultVal = emptyDict)
mesh_unitlength = num_commercialFEM%get_asReal('unitlength',defaultVal=1.0_pREAL) ! set physical extent of a length unit in mesh
if (mesh_unitlength <= 0.0_pREAL) call IO_error(301,'unitlength')
num_solver => config_numerics%get_dict('solver',defaultVal=emptyDict)
num_commercialFEM => num_solver%get_dict('Marc',defaultVal=emptyDict)
mesh_unitlength = num_commercialFEM%get_asReal('unit_length',defaultVal=1.0_pREAL) ! set physical extent of a length unit in mesh
if (mesh_unitlength <= 0.0_pREAL) call IO_error(301,'unit_length')
call inputRead(elem,node0_elem,connectivity_elem,materialAt)
nElems = size(connectivity_elem,2)
@ -210,9 +212,9 @@ subroutine inputRead(elem,node0_elem,connectivity_elem,materialAt)
call result_openJobFile()
call result_writeDataset_str(IO_read(trim(getSolverJobName())//InputFileExtension), 'setup', &
trim(getSolverJobName())//InputFileExtension, &
'MSC.Marc input deck')
call result_addSetupFile(IO_read(trim(getSolverJobName())//InputFileExtension), &
trim(getSolverJobName())//InputFileExtension, &
'MSC.Marc input deck')
call result_closeJobFile()
inputFile = IO_readlines(trim(getSolverJobName())//InputFileExtension)

471
src/Marc/include/concom2023.1 vendored Normal file
View File

@ -0,0 +1,471 @@
! common block definition file taken from respective MSC.Marc release and reformated to free format
!***********************************************************************
!
! File: concom.cmn
!
! MSC.Marc include file
!
integer &
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,&
ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,&
ipoist, irpflo, ismall, ismalt, isoil, ispect, ispnow, istore, iswep, ithcrp,&
itherm, iupblg, iupdat, jacflg, jel, jparks, largst, lfond, loadup, loaduq,&
lodcor, lovl, lsub, magnet, ncycle, newtnt, newton, noshr, linear, ivscpl,&
icrpim, iradrt, ipshft, itshr, iangin, iupmdr, iconjf, jincfl, jpermg, jhour,&
isolvr, jritz, jtable, jshell, jdoubl, jform, jcentr, imini, kautth, iautof,&
ibukty, iassum, icnstd, icnstt, kmakmas, imethvp, iradrte, iradrtp, iupdate, iupdatp,&
ncycnt, marmen , idynme, ihavca, ispf, kmini, imixex, largtt, kdoela, iautofg,&
ipshftp, idntrc, ipore, jtablm, jtablc, isnecma, itrnspo, imsdif, jtrnspo, mcnear,&
imech, imecht, ielcmat, ielectt, magnett, imsdift, noplas, jtabls, jactch, jtablth,&
kgmsto , jpzo, ifricsh, iremkin, iremfor, ishearp, jspf, machining, jlshell, icompsol,&
iupblgfo, jcondir, nstcrp, nactive, ipassref, nstspnt, ibeart, icheckmpc, noline, icuring,&
ishrink, ioffsflg, isetoff, ioffsetm,iharmt, inc_incdat, iautspc, ibrake, icbush, istream_input,&
iprsinp, ivlsinp, ifirst_time,ipin_m, jgnstr_glb, imarc_return,iqvcinp, nqvceid, istpnx, imicro1,&
iaxisymm, jbreakglue,iglstif, jfastasm,iwear, iwearcf, imixmeth, ielcmadyn, idinout, igena_meth,&
magf_meth, non_assumed, iredoboudry, ioffsz0,icomplt, mesh_dual, iactrp, mgnewton, iusedens,igsigd0,&
iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror,&
icsprg, imol, imolt, idatafit,iharmpar, inclcase, imultifreq,init_elas, ifatig, iftgmat,&
nchybrid, ibuckle, iexpande, matfor
dimension :: ideva(60)
integer num_concom
parameter(num_concom=264)
common/marc_concom/&
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,&
ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,&
ipoist, irpflo, ismall, ismalt, isoil, ispect, ispnow, istore, iswep, ithcrp,&
itherm, iupblg, iupdat, jacflg, jel, jparks, largst, lfond, loadup, loaduq,&
lodcor, lovl, lsub, magnet, ncycle, newtnt, newton, noshr, linear, ivscpl,&
icrpim, iradrt, ipshft, itshr, iangin, iupmdr, iconjf, jincfl, jpermg, jhour,&
isolvr, jritz, jtable, jshell, jdoubl, jform, jcentr, imini, kautth, iautof,&
ibukty, iassum, icnstd, icnstt, kmakmas, imethvp, iradrte, iradrtp, iupdate, iupdatp,&
ncycnt, marmen, idynme, ihavca, ispf, kmini, imixex, largtt, kdoela, iautofg,&
ipshftp, idntrc, ipore, jtablm, jtablc, isnecma, itrnspo, imsdif, jtrnspo, mcnear,&
imech, imecht, ielcmat, ielectt, magnett, imsdift, noplas, jtabls, jactch, jtablth,&
kgmsto , jpzo, ifricsh, iremkin, iremfor, ishearp, jspf, machining, jlshell, icompsol,&
iupblgfo, jcondir, nstcrp, nactive, ipassref, nstspnt, ibeart, icheckmpc, noline, icuring,&
ishrink, ioffsflg, isetoff, ioffsetm,iharmt, inc_incdat, iautspc, ibrake, icbush, istream_input,&
iprsinp, ivlsinp, ifirst_time,ipin_m, jgnstr_glb, imarc_return,iqvcinp, nqvceid, istpnx, imicro1,&
iaxisymm, jbreakglue,iglstif, jfastasm,iwear, iwearcf, imixmeth, ielcmadyn, idinout, igena_meth,&
magf_meth, non_assumed, iredoboudry, ioffsz0,icomplt, mesh_dual, iactrp, mgnewton, iusedens,igsigd0,&
iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror,&
icsprg, imol, imolt, idatafit,iharmpar, inclcase, imultifreq,init_elas, ifatig, iftgmat,&
nchybrid, ibuckle, iexpande, matfor
!
! comments of variables:
!
! iacous Control flag for acoustic analysis. Input data.
! iacous=1 modal acoustic analysis.
! iacous=2 harmonic acoustic-structural analysis.
! iasmbl Control flag to indicate that operator matrix should be
! recalculated.
! iautth Control flag for AUTO THERM option.
! ibear Control flag for bearing analysis. Input data.
! icompl Control variable to indicate that a complex analysis is
! being performed. Either a Harmonic analysis with damping,
! or a harmonic electro-magnetic analysis. Input data.
! iconj Flag for EBE conjugate gradient solver (=solver 1, retired)
! Also used for VKI iterative solver.
! icreep Control flag for creep analysis. Input data.
! ideva(60) - debug print out flag
! 1 print element stiffness matrices, mass matrix
! 2 output matrices used in tying
! 3 force the solution of a nonpositive definite matrix
! 4 print info of connections to each node
! 5 info of gap convergence, internal heat generated, contact
! touching and separation
! 6 nodal value array during rezoning
! 7 tying info in CONRAD GAP option, fluid element numbers in
! CHANNEL option
! 8 output incremental displacements in local coord. system
! 9 latent heat output
! 10 stress-strain in local coord. system
! 11 additional info on interlaminar stress
! 12 output right hand side and solution vector
! 13 info of CPU resources used and memory available on NT
! 14 info of mesh adaption process, 2D outline information
! info of penetration checking for remeshing
! save .fem files after afmesh3d meshing
! print local adaptivity info
! 15 surface energy balance flag
! 16 print info regarding pyrolysis
! 17 print info of "streamline topology"
! 18 print mesh data changes after remeshing
! 19 print material flow stress data read in from *.mat file
! if unit flag is on, print out flow stress after conversion
! 20 print information on table input
! 21 print out information regarding kinematic boundary conditions
! 22 print out information regarding dist loads, point loads, film
! and foundations
! 23 print out information about automatic domain decomposition
! 24 print out iteration information in SuperForm status report file
! 25 print out information for ablation
! 26 print out information for films - Table input
! 27 print out the tying forces
! 28 print out for CASI solver, convection,
! 29 DDM single file debug printout
! 30 print out cavity debug info
! 31 print out welding related info
! 32 prints categorized DDM memory usage
! 33 print out the cutting info regarding machining feature
! 34 print out the list of quantities which can be defined via a table
! and for each quantity the supported independent variables
! 35 print out detailed coupling region info
! 36 print out solver debug info level 1 (Least Detailed)
! 37 print out solver debug info level 1 (Medium Detailed)
! 38 print out solver debug info level 1 (Very Detailed)
! 39 print detailed memory allocation info
! 40 print out marc-adams debug info
! 41 output rezone mapping post file for debugging
! 42 output post file after calling oprofos() for debugging
! 43 debug printout for vcct
! 44 debug printout for progressive failure
! 45 print out automatically generated midside node coordinates (arecrd)
! 46 print out message about routine and location, where the ibort is raised (ibort_inc)
! 47 print out summary message of element variables on a
! group-basis after all the automatic changes have been
! made (em_ellibp)
! 48 Automatically generate check results based on max and min vals.
! These vals are stored in the checkr file, which is inserted
! into the *dat file by the generate_check_results script from /marc/tools
! 49 Automatically generate check results based on the real calculated values
! at the sppecified check result locations.
! These vals are stored in the checkr file, which is inserted
! into the *dat file by the update_check_results script from /marc/tools
! 50 generate a file containing the resistance or capacity matrix;
! this file can be used to compare results with a reference file
! 51 print out detailed information for segment-to-segment contact
! 52 print out detailed relative displacement information
! for uniaxial sliding contact
! 53 print out detailed sliding direction information for
! uniaxial sliding contact
! 54 print out detailed information for edges attached to a curve
! 55 print information related to viscoelasticity calculations
! 56 print out detailed information for element coloring for multithreading
! 57 print out extra overheads due to multi-threading.
! These overhead includes (i) time and (ii) memory.
! The memory report will be summed over all the children.
! 58 debug output for ELSTO usage
! 59 print out contact body forces and nodes in contact
!
! idyn Control flag for dynamics. Input data.
! 1 = eigenvalue extraction and / or modal superposition
! 2 = Newmark Beta and Single Step Houbolt (ssh with idynme=1)
! 3 = Houbolt
! 4 = Central difference
! 5 = Newer central difference
! idynt Copy of idyn at begining of increment
! ielas Control flag for ELASTIC analysis. Input data.
! Set by user or automatically turned on by Fourier option.
! Implies that each load case is treated separately.
! In Adaptive meshing analysis , forces re-analysis until
! convergence obtained.
! Also seriously misused to indicate no convergence.
! = 1 elastic option with fourier analysis
! = 2 elastic option without fourier analysis
! =-1 no convergence in recycles or max # increments reached
! Set to 1 if ELASTIC or SUBSTRUC parameter cards are used,
! or if fourier option is used.
! Then set to 2 if not fourier analysis.
! ielcma Control flag for electromagnetic analysis. Input data.
! ielcma = 1 Harmonic formulation
! ielcma = 2 Transient formulation
! ielect Control flag for electrostatic option. Input data.
! iform Control flag indicating that contact will be performed.
! ifour Control flag for Fourier analysis.
! 0 = Odd and even terms.
! 1 = symmetric (cosine) terms
! 2 = antisymmetric (sine) terms.
! iharm Control flag to indicate that a harmonic analysis will
! be performed. May change between passes.
! ihcps Control flag for coupled thermal - stress analysis.
! iheat Control flag for heat transfer analysis. Input data.
! iheatt Permanent control flag for heat transfer analysis.
! Note in coupled analysis iheatt will remain as one,
! but iheat will be zero in stress pass.
! ihresp Control flag to indicate to perform a harmonic subincrement.
! ijoule Control flag for Joule heating.
! ilem Control flag to determin which vector is to be transformed.
! Control flag to see where one is:
! ilem = 1 - elem.f
! ilem = 2 - initst.f
! ilem = 3 - pressr.f
! ilem = 3 - fstif.f
! ilem = 4 - jflux.f
! ilem = 4 - strass.f
! ilem = 5 - mass.f
! ilem = 5 - osolty.f
! ilnmom Control flag for soil - pore pressure calculation. Input data.
! ilnmom = 0 - perform only pore pressure calculation.
! = 1 - couples pore pressure - displacement analysis
! iloren Control flag for DeLorenzi J-Integral evaluation. Input data.
! inc Increment number.
! incext Control flag indicating that currently working on a
! subincrement.
! Could be due to harmonics , damping component (bearing),
! stiffness component (bearing), auto therm creep or
! old viscoplaticity
! incsub Sub-increment number.
! inonlcl control flag for nonlocal pass
! inonlct permanent control flag for nonlocal pass
! ipass Control flag for which part of coupled analysis.
! ipass = -1 - reset to base values
! ipass = 0 - do nothing
! ipass = 1 - stress part
! ipass = 2 - heat transfer part
! 3 - fluid pass
! 4 - joule heating pass
! 5 - pore pressure pass
! 6 - electrostatic pass
! 7 - magnetostatic pass
! 8 - electromagnetic pass
! 9 - diffusion pass
! ipass = 10 - nonlocal part
! iplres Flag indicating that either second matrix is stored.
! dynamic analysis - mass matrix
! heat transfer - specific heat matrix
! buckle - initial stress stiffness
! ipois Control flag indicating Poisson type analysis
! ipois = 1 for heat transfer
! = 1 for heat transfer part of coupled
! = 1 for bearing
! = 1 for electrostatic
! = 1 for magnetostatic
! = 1 for nonlocal part
! ipoist Permanent copy of ipois. In coupled analysis , ipois = 0
! in stress portion, yet ipoist will still =1.
! irpflo global flag for rigid plastic flow analysis
! = 1 eularian formulation
! = 2 regular formulation; rigid material present in the analysis
! ismall control flag to indicate small displacement analysis. input data.
! ismall = 0 - large disp included.
! ismall = 1 - small displacement.
! the flag is changing between passes.
! ismalt permanent copy of ismall . in heat transfer portion of
! coupled analysis ismall =0 , but ismalt remains the same.
! isoil control flag indicating that soil / pore pressure
! calculation . input data.
! ispect control flag for response spectrum calculation. input data.
! ispnow control flag to indicate to perform a spectrum response
! calculation now.
! istore store stresses flag.
! istore = 0 in elem.f and if first pass of creep
! convergence checking in ogetst.f
! or harmonic analysis or thruc.f if not
! converged.
! iswep control flag for eigenvalue analysis.
! iswep=1 - go do extraction process
! ithcrp control flag for auto therm creep option. input data.
! itherm control flag for either temperature dependent material
! properties and/or thermal loads.
! iupblg control flag for follower force option. input data.
! iupdat control flag for update lagrange option for current element.
! jacflg control flag for lanczos iteration method. input data.
! jel control flag indicating that total load applied in
! increment, ignore previous solution.
! jel = 1 in increment 0
! = 1 if elastic or fourier
! = 1 in subincrements with elastic and adaptive
! jparks control flag for j integral by parks method. input data.
! largst control flag for finite strain plasticity. input data.
! lfond control variable that indicates if doing elastic
! foundation or film calculation. influences whether
! this is volumetric or surface integration.
! loadup control flag that indicates that nonlinearity occurred
! during previous increment.
! loaduq control flag that indicates that nonlinearity occurred.
! lodcor control flag for switching on the residual load correction.
! notice in input stage lodcor=0 means no loadcor,
! after omarc lodcor=1 means no loadcor
! lovl control flag for determining which "overlay" is to
! be called from ellib.
! lovl = 1 omarc
! = 2 oaread
! = 3 opress
! = 4 oasemb
! = 5 osolty
! = 6 ogetst
! = 7 oscinc
! = 8 odynam
! = 9 opmesh
! = 10 omesh2
! = 11 osetz
! = 12 oass
! = 13 oincdt
! = 14 oasmas
! = 15 ofluas
! = 16 ofluso
! = 17 oshtra
! = 18 ocass
! = 19 osoltc
! = 20 orezon
! = 21 otest
! = 22 oeigen
! lsub control variable to determine which part of element
! assembly function is being done.
! lsub = 1 - no longer used
! = 2 - beta*
! = 3 - cons*
! = 4 - ldef*
! = 5 - posw*
! = 6 - theta*
! = 7 - tmarx*
! = 8 - geom*
! magnet control flag for magnetostatic analysis. input data.
! ncycle cycle number. accumulated in osolty.f
! note first time through oasemb.f , ncycle = 0.
! newtnt control flag for permanent copy of newton.
! newton iteration type. input data.
! newton : = 1 full newton raphson
! 2 modified newton raphson
! 3 newton raphson with strain correct.
! 4 direct substitution
! 5 direct substitution followed by n.r.
! 6 direct substitution with line search
! 7 full newton raphson with secant initial stress
! 8 secant method
! 9 full newton raphson with line search
! noshr control flag for calculation interlaminar shears for
! elements 22,45, and 75. input data.
!ees
!
! jactch = 1 or 2 if elements are activated or deactivated
! = 3 if elements are adaptively remeshed or rezoned
! = 0 normally / reset to 0 when assembly is done
! ifricsh = 0 call to fricsh in otest not needed
! = 1 call to fricsh (nodal friction) in otest needed
! iremkin = 0 remove deactivated kinematic boundary conditions
! immediately - only in new input format (this is default)
! = 1 remove deactivated kinematic boundary conditions
! gradually - only in new input format
! iremfor = 0 remove force boundary conditions immediately -
! only in new input format (this is default)
! = 1 remove force boundary conditions gradually -
! only in new input format (this is default)
! ishearp set to 1 if shear panel elements are present in the model
!
! jspf = 0 not in spf loadcase
! > 0 in spf loadcase (jspf=1 during first increment)
! machining = 1 if the metal cutting feature is used, for memory allocation purpose
! = 0 (default) if no metal cutting feature required
!
! jlshell = 1 if there is a shell element in the mesh
! icompsol = 1 if there is a composite solid element in the mesh
! iupblgfo = 1 if follower force for point loads
! jcondir = 1 if contact priority option is used
! nstcrp = 0 (default) steady state creep flag (undocumented feature.
! if not 0, turns off special ncycle = 0 code in radial.f)
! nactive = number of active passes, if =1 then it's not a coupled analysis
! ipassref = reference ipass, if not in a multiphysics pass ipass=ipassref
! icheckmpc = value of mpc-check parameter option
! noline = set to 1 in osolty if no line seacrh should be done in ogetst
! icuring = set to 1 if the curing is included for the heat transfer analysis.
! ishrink = set to 1 if shrinkage strain is included for mechancial analysis.
! ioffsflg = 1 for small displacement beam/shell offsets
! = 2 for large displacement beam/shell offsets
! isetoff = 0 - do not apply beam/shell offsets
! = 1 - apply beam/shell offsets
! ioffsetm = min. value of offset flag
! iharmt = 1 global flag if a coupled analysis contains an harmonic pass
! inc_incdat = flag to record increment number of a new loadcase in incdat.f
! iautspc = flag for AutoSPC option
! ibrake = brake squeal in this increment
! icbush = set to 1 if cbush elements present in model
! istream_input = set to 1 for streaming input calling Marc as library
! iprsinp = set to 1 if pressure input, introduced so other variables
! such as h could be a function of pressure
! ivlsinp = set to 1 if velocity input, introduced so other variables
! such as h could be a function of velocity
! ipin_m = # of beam element with PIN flag
! jgnstr_glb = global control over pre or fast integrated composite shells
! imarc_return = Marc return flag for streaming input control
! iqvcimp = if non-zero, then the number of QVECT boundary conditions
! nqvceid = number of QVECT boundary conditions, where emisivity/absorbtion id entered
! istpnx = 1 if to stop at end of increment
! imicro1 = 1 if micro1 interface is used
! iaxisymm = set to 1 if axisymmetric analysis
! jbreakglue = set to 1 if breaking glued option is used
! iglstif = 1 if ddm and global stiffness matrix formed (sgi solver 6 or solver9)
! jfastasm = 1 do fast assembly using SuperForm code
! iwear = set to 1 if wear model, set to 2 if wear model and coordinates updated
! iwearcf = set to 1 to store nodal coefficient of friction for wear calculation
! imixmeth = set=1 then use nonlinear mixture material - allocate memory
! ielcmadyn = flag for magnetodynamics
! 0 - electromagnetics using newmark beta
! 1 - transient magnetics using backward euler
! idinout = flag to control if inside out elements should be deactivated
! igena_meth = 0 - generalized alpha parameters depend on whether or not contact
! is flagged (dynamic,7)
! 10 - generalized alpha parameters are optimized for a contact
! analysis (dynamic,8)
! 11 - generalized alpha parameters are optimized for an analysis
! without contact (dynamic,8)
! magf_meth = - Method to compute force in magnetostatic - structural
! = 1 - Virtual work method based on finite difference for the force computation
! = 2 - Maxwell stress tensor
! = 3 - Virtual work method based on local derivative for the force computation
! non_assumed = 1 no assumed strain formulation (forced)
! iredoboudry set to 1 if contact boundary needs to be recalculated
! ioffsz0 = 1 if composite are used with reference position.ne.0
! icomplt = 1 global flag if a coupled analysis contains an complex pass
! mesh_dual = 1 two independent meshes are used in magnetodynamic/thermal/structural
! one for magnetodynamic and the other for the remaining passes
! iactrp = 1 in an analysis with global remeshing, include inactive
! rigid bodies on post file
! mgnewton = 1 Use full Newton Raphson iteration for magnetostatic pass
!
! iusedens > 0 if mass density is used in the analysis (dynamics, mass dependent loading)
! igsigd0 = 1 set varselem(igsigd) to zero in next oasemb
! iaem = 1 if marc is called from aem (0 - off - default)
! icosim = 1 if marc is used in co-simulation analysis with ADAMS using the CosimEngine
! = 2 if marc is used in co-simulation analysis with ADAMS using the ACSI interface
! = 3 if marc is used in co-simulation analysis with scFLOW using the CosimEngine
! = 4 if marc is used in co-simulation analysis with scFLOW and ADAMS using the CosimEngine
! inodels = 1 nodal integration elements 239/240/241 present
! nlharm = 0 harmonic subincrements are linear
! = 1 harmonic subincrements are nonlinear
! iampini = 0 amplitude of previous harmonic subinc is initial estimate (default)
! = 1 zero amplitude is initial estimate
! iphasetr = 1 phase transformation material model is used
! iforminp flag indicating that contact is switched on via the CONTACT
! option in the input file (as opposed to the case that contact
! is switched on internally due to cyclic symmetry or model
! section creation)
! ispecerror = a+10*b (only for spectrum response analysis with missing mass option)
! a=0 or a=1 (modal shape with non-zero shift)
! b=0 or b=1 (recover with new assembly of stiffness matrix)
! icsprg = set to 1 if spring elements present in model
! imol Control flag for molecualr diffusion pass
! imolt Permanent control flag for molecualr diffusion pass
! Note in coupled analysis imolt will remain as one,
! but imol will be zero in stress pass or thermal pass.
! idatafit = run Marc to fit parameters
! iharmpar = 1 if harmonic parameter option is used
! inclcase load case increment use for cyclic plasticity data fitting
! imultifreq flag to indicate how many harmonic magnetodynamic passes are computed in coupled
! magnetodynamic/thermal(/structural) analyses.
! 0 or 1 one pass 2 two passes 3 or more is not supported
! init_elas use elastic stress-strain law as the material tangent for
! the first cycle of an increment
! ifatig packed integer telling which fatigue mode is active
! 1 = elastomer
! 10 = stress-life
! 100 = strain-life
! = 2 strain-life fatigue
! iftgmat = 0 no fatigue material properties in the dat file
! = 1 fatigue material properties in the dat file
! nchybrid cycle count used for hybrid contact; meant to force an extra iteration
! if the overlap for a node in hybrid contact is too large
! ibuckle buckle parameter option is active
! iexpande set to 1 if expanded elements (248, 249, 250 or 251) are
! present, 0 otherwise
! matfor flag for material forces computation
! 0: Eshleby stress and material force vector not requested
! 1: output Eshelby stress tensor, but no material force vector
! 2: output material force vector, but no Eshelby stress tensor
! 3: output Eshelby stress tensor and material force vector
!
!***********************************************************************
!$omp threadprivate(/marc_concom/)
!!

73
src/Marc/include/creeps2023.1 vendored Normal file
View File

@ -0,0 +1,73 @@
! common block definition file taken from respective MSC.Marc release and reformated to free format
!***********************************************************************
!
! File: creeps.cmn
!
! MSC.Marc include file
!
real(pReal) cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b
integer icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,&
icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa
real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst
real(pReal) fraction_donn,timinc_ol2
!
integer num_creepsr,num_creepsi,num_creeps2r,ncrp_arry
parameter(num_creepsr=7)
parameter(num_creepsi=17)
parameter(num_creeps2r=6)
parameter(ncrp_arry=7)
common/marc_creeps/cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b,icfte,icfst,&
icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa
common/marc_creeps2/time_beg_lcase,time_beg_inc,fractol,time_beg_pst,fraction_donn,timinc_ol2
!
! cptim Total time at begining of increment.
! timinc Incremental time for this step.
! icfte Local copy number of slopes of creep strain rate function
! versus temperature. Is -1 if exponent law used.
! icfst Local copy number of slopes of creep strain rate function
! versus equivalent stress. Is -1 if exponent law used.
! icfeq Local copy number of slopes of creep strain rate function
! versus equivalent strain. Is -1 if exponent law used.
! icftm Local copy number of slopes of creep strain rate function
! versus time. Is -1 if exponent law used.
! icetem Element number that needs to be checked for creep convergence
! or, if negative, the number of elements that need to
! be checked. In the latter case the elements to check
! are stored in ielcp.
! mcreep Maximum nuber of iterations for explicit creep.
! jcreep Counter of number of iterations for explicit creep
! procedure. jcreep must be .le. mcreep
! icpa(1-6) Pointer to constants in creep strain rate expression.
! icftmp Pointer to temperature dependent creep strain rate data.
! icfstr Pointer to equivalent stress dependent creep strain rate data.
! icfqcp Pointer to equivalent creep strain dependent creep strain
! rate data.
! icfcpm Pointer to equivalent creep strain rate dependent
! creep strain rate data.
! icrppr Permanent copy of icreep
! icrcha Control flag for creep convergence checking , if set to
! 1 then testing on absolute change in stress and creep
! strain, not relative testing. Input data.
! icpb(1-4) Pointer to storage of material id cross reference numbers.
! iicpmt creep law type ID
! =1 - power law
! =2 - solder
! =3 - steady-creep
! =4 - hyperbolic steady-creep
! iicpa Pointer to table IDs for constants in creep strain rate
! expression
!
!
! time_beg_lcase time at the beginning of the current load case
! time_beg_inc time at the beginning of the current increment
! fractol fraction of loadcase or increment time when we
! consider it to be finished
! time_beg_pst time corresponding to first increment to be
! read in from thermal post file for auto step
!
! timinc_old Time step of the previous increment
!
!***********************************************************************
!!$omp threadprivate(/marc_creeps/)
!!$omp threadprivate(/marc_creeps2/)
!!

4
src/Marc/materialpoint_Marc.f90
View File

@ -16,7 +16,7 @@ module materialpoint_Marc
use rotations
use polynomials
use tables
use lattice
use crystal
use material
use phase
use homogenization
@ -75,7 +75,7 @@ subroutine materialpoint_initAll()
call rotations_init()
call polynomials_init()
call tables_init()
call lattice_init()
call crystal_init()
call discretization_Marc_init()
call material_init(.false.)
call phase_init()

4
src/YAML_parse.f90
View File

@ -162,7 +162,7 @@ end function parse_flow
!> @brief Find location of chunk end: ',' '}', or ']'.
!> @details leaves nested lists ( '[...]' and dicts '{...}') intact
!--------------------------------------------------------------------------------------------------
integer function find_end(str,e_char)
integer(pI64) function find_end(str,e_char)
character(len=*), intent(in) :: str !< chunk of YAML flow string
character, intent(in) :: e_char !< end of list/dict ( '}' or ']')
@ -456,7 +456,7 @@ end subroutine remove_line_break
!--------------------------------------------------------------------------------------------------
subroutine list_item_inline(blck,s_blck,inline,offset)
character(len=*), intent(in) :: blck !< YAML in mixed style
character(len=*), intent(in) :: blck !< YAML in mixed style
integer, intent(inout) :: s_blck
character(len=:), allocatable, intent(out) :: inline
integer, intent(inout) :: offset

10
src/YAML_types.f90
View File

@ -1166,7 +1166,10 @@ function tDict_get_as1dReal(self,k,defaultVal,requiredSize) result(nodeAs1dReal)
end if
if (present(requiredSize)) then
if (requiredSize /= size(nodeAs1dReal)) call IO_error(146,ext_msg=k)
if (requiredSize /= size(nodeAs1dReal)) &
call IO_error(146,ext_msg=k, &
label1='actual',ID1=size(nodeAs1dReal), &
label2='required',ID2=requiredSize)
end if
end function tDict_get_as1dReal
@ -1251,7 +1254,10 @@ function tDict_get_as1dInt(self,k,defaultVal,requiredSize) result(nodeAs1dInt)
end if
if (present(requiredSize)) then
if (requiredSize /= size(nodeAs1dInt)) call IO_error(146,ext_msg=k)
if (requiredSize /= size(nodeAs1dInt)) &
call IO_error(146,ext_msg=k, &
label1='actual',ID1=size(nodeAs1dInt), &
label2='required',ID2=requiredSize)
end if
end function tDict_get_as1dInt

82
src/config.f90
View File

@ -34,8 +34,23 @@ subroutine config_init()
print'(/,1x,a)', '<<<+- config init -+>>>'; flush(IO_STDOUT)
call parse_material()
call parse_numerics()
#if defined(MESH) || defined(GRID)
config_material => parse(CLI_materialFile,'material configuration')
#else
config_material => parse('material.yaml','material configuration')
#endif
config_numerics => emptyDict
#if defined(MESH) || defined(GRID)
if (allocated(CLI_numericsFile)) &
config_numerics => parse(CLI_numericsFile,'numerics configuration')
#else
MSCMarc: block
logical :: exists
inquire(file='numerics.yaml',exist=exists)
if (exists) config_numerics => parse('numerics.yaml','numerics configuration')
end block MSCMarc
#endif
end subroutine config_init
@ -68,11 +83,10 @@ end subroutine config_numerics_deallocate
!--------------------------------------------------------------------------------------------------
function config_listReferences(config,indent) result(references)
type(tDict) :: config
integer, optional :: indent
type(tDict), intent(in) :: config
integer, intent(in), optional :: indent
character(len=:), allocatable :: references
type(tList), pointer :: ref
character(len=:), allocatable :: filler
integer :: r
@ -93,63 +107,27 @@ end function config_listReferences
!--------------------------------------------------------------------------------------------------
!> @brief Read material.yaml.
!> @brief Read configuration, spread over all processes, and add to DADF5.
!--------------------------------------------------------------------------------------------------
subroutine parse_material()
function parse(fname,description)
character(len=*), intent(in) :: fname, description
type(tDict), pointer :: parse
character(len=:), allocatable :: fileContent
logical :: fileExists
character(len=:), allocatable :: &
fileContent, fname
if (worldrank == 0) then
print'(/,1x,a)', 'reading material configuration'; flush(IO_STDOUT)
#if defined(MESH) || defined(GRID)
fname = CLI_materialFile
#else
fname = 'material.yaml'
#endif
print'(/,1x,a)', 'reading '//description; flush(IO_STDOUT)
fileContent = IO_read(fname)
if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:)
call result_openJobFile(parallel=.false.)
call result_writeDataset_str(fileContent,'setup',fname,'material configuration')
call result_addSetupFile(fileContent,fname,description)
call result_closeJobFile()
end if
call parallelization_bcast_str(fileContent)
config_material => YAML_parse_str_asDict(fileContent)
parse => YAML_parse_str_asDict(fileContent)
end subroutine parse_material
!--------------------------------------------------------------------------------------------------
!> @brief Read numerics.yaml.
!--------------------------------------------------------------------------------------------------
subroutine parse_numerics()
logical :: fileExists
character(len=:), allocatable :: fileContent
config_numerics => emptyDict
inquire(file='numerics.yaml', exist=fileExists)
if (fileExists) then
if (worldrank == 0) then
print'(1x,a)', 'reading numerics.yaml'; flush(IO_STDOUT)
fileContent = IO_read('numerics.yaml')
if (len(fileContent) > 0) then
call result_openJobFile(parallel=.false.)
call result_writeDataset_str(fileContent,'setup','numerics.yaml','numerics configuration')
call result_closeJobFile()
end if
end if
call parallelization_bcast_str(fileContent)
config_numerics => YAML_parse_str_asDict(fileContent)
end if
end subroutine parse_numerics
end function parse
end module config

7
src/constants.f90
View File

@ -13,4 +13,11 @@ module constants
K_B = 1.380649e-23_pREAL, & !< Boltzmann constant in J/Kelvin (https://doi.org/10.1351/goldbook)
N_A = 6.02214076e23_pREAL !< Avogadro constant in 1/mol (https://doi.org/10.1351/goldbook)
character, parameter :: &
CR = achar(13), &
LF = new_line('DAMASK')
character(len=*), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(len=len(LOWER)), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
end module constants

471
src/lattice.f90 → src/crystal.f90
View File

@ -3,10 +3,10 @@
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief contains lattice definitions including Schmid matrices for slip, twin, trans,
! and cleavage as well as interaction among the various systems
!> @brief Contains crystal definitions including Schmid matrices for slip, twin, trans,
! and cleavage as well as interaction among the various systems.
!--------------------------------------------------------------------------------------------------
module lattice
module crystal
use prec
use misc
use IO
@ -80,7 +80,7 @@ module lattice
],pREAL),shape(CF_SYSTEMTWIN)) !< cF twin systems
integer, dimension(2,CF_NTWIN), parameter, public :: &
lattice_CF_TWINNUCLEATIONSLIPPAIR = reshape( [&
crystal_CF_TWINNUCLEATIONSLIPPAIR = reshape( [&
2,3, &
1,3, &
1,2, &
@ -93,7 +93,7 @@ module lattice
11,12, &
10,12, &
10,11 &
],shape(lattice_CF_TWINNUCLEATIONSLIPPAIR))
],shape(crystal_CF_TWINNUCLEATIONSLIPPAIR))
real(pREAL), dimension(3+3,CF_NCLEAVAGE), parameter :: &
CF_SYSTEMCLEAVAGE = reshape(real([&
@ -123,18 +123,21 @@ module lattice
real(pREAL), dimension(3+3,CI_NSLIP), parameter :: &
CI_SYSTEMSLIP = reshape(real([&
! <111>{110} systems
! Sign convention follows Table 1 of 10.1016/j.ijplas.2020.102733
! to allow for universal calculation of non-glide plane normal n1 = Rot(-m,60°) @ n
! The choice matters since Rot(-m,60°) @ n ≠ Rot(m,60°) @ -n ..!
1,-1, 1, 0, 1, 1, &
-1,-1, 1, 0, 1, 1, &
1, 1, 1, 0,-1, 1, &
-1,-1, 1, 0,-1,-1, &
1, 1, 1, 0, 1,-1, &
-1, 1, 1, 0,-1, 1, &
-1, 1, 1, 1, 0, 1, &
-1, 1, 1, -1, 0,-1, &
-1,-1, 1, 1, 0, 1, &
1, 1, 1, -1, 0, 1, &
1,-1, 1, -1, 0, 1, &
1,-1, 1, 1, 0,-1, &
-1, 1, 1, 1, 1, 0, &
-1, 1,-1, 1, 1, 0, &
1, 1, 1, -1, 1, 0, &
1, 1,-1, -1, 1, 0, &
1,-1, 1, -1,-1, 0, &
1, 1, 1, 1,-1, 0, &
-1,-1, 1, -1, 1, 0, &
! <111>{112} systems
-1, 1, 1, 2, 1, 1, &
1, 1, 1, -2, 1, 1, &
@ -367,60 +370,60 @@ module lattice
],pREAL),shape(TI_SYSTEMSLIP)) !< tI slip systems for c/a = 0.5456 (Sn), sorted by Bieler 2009 (https://doi.org/10.1007/s11664-009-0909-x)
interface lattice_forestProjection_edge
interface crystal_forestProjection_edge
module procedure slipProjection_transverse
end interface lattice_forestProjection_edge
end interface crystal_forestProjection_edge
interface lattice_forestProjection_screw
interface crystal_forestProjection_screw
module procedure slipProjection_direction
end interface lattice_forestProjection_screw
end interface crystal_forestProjection_screw
public :: &
lattice_init, &
lattice_isotropic_nu, &
lattice_isotropic_mu, &
lattice_symmetrize_33, &
lattice_symmetrize_C66, &
lattice_SchmidMatrix_slip, &
lattice_SchmidMatrix_twin, &
lattice_SchmidMatrix_trans, &
lattice_SchmidMatrix_cleavage, &
lattice_nonSchmidMatrix, &
lattice_interaction_SlipBySlip, &
lattice_interaction_TwinByTwin, &
lattice_interaction_TransByTrans, &
lattice_interaction_SlipByTwin, &
lattice_interaction_SlipByTrans, &
lattice_interaction_TwinBySlip, &
lattice_characteristicShear_Twin, &
lattice_C66_twin, &
lattice_C66_trans, &
lattice_forestProjection_edge, &
lattice_forestProjection_screw, &
lattice_slip_normal, &
lattice_slip_direction, &
lattice_slip_transverse, &
lattice_labels_slip, &
lattice_labels_twin
crystal_init, &
crystal_selfTest, &
crystal_isotropic_nu, &
crystal_isotropic_mu, &
crystal_symmetrize_33, &
crystal_symmetrize_C66, &
crystal_SchmidMatrix_slip, &
crystal_SchmidMatrix_twin, &
crystal_SchmidMatrix_trans, &
crystal_SchmidMatrix_cleavage, &
crystal_interaction_SlipBySlip, &
crystal_interaction_TwinByTwin, &
crystal_interaction_TransByTrans, &
crystal_interaction_SlipByTwin, &
crystal_interaction_SlipByTrans, &
crystal_interaction_TwinBySlip, &
crystal_characteristicShear_Twin, &
crystal_C66_twin, &
crystal_C66_trans, &
crystal_forestProjection_edge, &
crystal_forestProjection_screw, &
crystal_slip_normal, &
crystal_slip_direction, &
crystal_slip_transverse, &
crystal_labels_slip, &
crystal_labels_twin
contains
!--------------------------------------------------------------------------------------------------
!> @brief Run self test.
!--------------------------------------------------------------------------------------------------
subroutine lattice_init()
subroutine crystal_init()
print'(/,1x,a)', '<<<+- lattice init -+>>>'; flush(IO_STDOUT)
print'(/,1x,a)', '<<<+- crystal init -+>>>'; flush(IO_STDOUT)
call selfTest()
call crystal_selfTest()
end subroutine lattice_init
end subroutine crystal_init
!--------------------------------------------------------------------------------------------------
!> @brief Characteristic shear for twinning
!--------------------------------------------------------------------------------------------------
function lattice_characteristicShear_Twin(Ntwin,lattice,CoverA) result(characteristicShear)
function crystal_characteristicShear_Twin(Ntwin,lattice,CoverA) result(characteristicShear)
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
@ -470,7 +473,7 @@ function lattice_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character
characteristicShear(a) = 0.5_pREAL*sqrt(2.0_pREAL)
case('hP')
if (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL) &
call IO_error(131,ext_msg='lattice_characteristicShear_Twin')
call IO_error(131,ext_msg='crystal_characteristicShear_Twin')
p = sum(HP_NTWINSYSTEM(1:f-1))+s
select case(HP_SHEARTWIN(p)) ! from Christian & Mahajan 1995 p.29
case (1) ! <-10.1>{10.2}
@ -483,24 +486,24 @@ function lattice_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character
characteristicShear(a) = 2.0_pREAL*(cOverA**2-2.0_pREAL)/3.0_pREAL/cOverA
end select
case default
call IO_error(137,ext_msg='lattice_characteristicShear_Twin: '//trim(lattice))
call IO_error(137,ext_msg='crystal_characteristicShear_Twin: '//trim(lattice))
end select
end do mySystems
end do myFamilies
end function lattice_characteristicShear_Twin
end function crystal_characteristicShear_Twin
!--------------------------------------------------------------------------------------------------
!> @brief Rotated elasticity matrices for twinning in 6x6-matrix notation
!--------------------------------------------------------------------------------------------------
function lattice_C66_twin(Ntwin,C66,lattice,CoverA)
function crystal_C66_twin(Ntwin,C66,lattice,CoverA)
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
real(pREAL), dimension(6,6), intent(in) :: C66 !< unrotated parent stiffness matrix
real(pREAL), intent(in) :: cOverA !< c/a ratio
real(pREAL), dimension(6,6,sum(Ntwin)) :: lattice_C66_twin
real(pREAL), dimension(6,6,sum(Ntwin)) :: crystal_C66_twin
real(pREAL), dimension(3,3,sum(Ntwin)):: coordinateSystem
type(tRotation) :: R
@ -518,28 +521,28 @@ function lattice_C66_twin(Ntwin,C66,lattice,CoverA)
coordinateSystem = buildCoordinateSystem(Ntwin,HP_NSLIPSYSTEM,HP_SYSTEMTWIN,&
lattice,cOverA)
case default
call IO_error(137,ext_msg='lattice_C66_twin: '//trim(lattice))
call IO_error(137,ext_msg='crystal_C66_twin: '//trim(lattice))
end select
do i = 1, sum(Ntwin)
call R%fromAxisAngle([coordinateSystem(1:3,2,i),PI],P=1) ! ToDo: Why always 180 deg?
lattice_C66_twin(1:6,1:6,i) = R%rotStiffness(C66)
crystal_C66_twin(1:6,1:6,i) = R%rotStiffness(C66)
end do
end function lattice_C66_twin
end function crystal_C66_twin
!--------------------------------------------------------------------------------------------------
!> @brief Rotated elasticity matrices for transformation in 6x6-matrix notation
!--------------------------------------------------------------------------------------------------
function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
function crystal_C66_trans(Ntrans,C_parent66,crystal_target, &
cOverA_trans,a_cF,a_cI)
integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family
character(len=*), intent(in) :: lattice_target !< Bravais lattice (Pearson symbol)
character(len=*), intent(in) :: crystal_target !< Bravais lattice (Pearson symbol)
real(pREAL), dimension(6,6), intent(in) :: C_parent66
real(pREAL), optional, intent(in) :: cOverA_trans, a_cF, a_cI
real(pREAL), dimension(6,6,sum(Ntrans)) :: lattice_C66_trans
real(pREAL), dimension(6,6,sum(Ntrans)) :: crystal_C66_trans
real(pREAL), dimension(6,6) :: C_bar66, C_target_unrotated66
real(pREAL), dimension(3,3,sum(Ntrans)) :: Q,S
@ -548,11 +551,11 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
!--------------------------------------------------------------------------------------------------
! elasticity matrix of the target phase in cube orientation
if (lattice_target == 'hP' .and. present(cOverA_trans)) then
if (crystal_target == 'hP' .and. present(cOverA_trans)) then
! https://doi.org/10.1063/1.1663858 eq. (16), eq. (18), eq. (19)
! https://doi.org/10.1016/j.actamat.2016.07.032 eq. (47), eq. (48)
if (cOverA_trans < 1.0_pREAL .or. cOverA_trans > 2.0_pREAL) &
call IO_error(131,ext_msg='lattice_C66_trans: '//trim(lattice_target))
call IO_error(131,ext_msg='crystal_C66_trans: '//trim(crystal_target))
C_bar66(1,1) = (C_parent66(1,1) + C_parent66(1,2) + 2.0_pREAL*C_parent66(4,4))/2.0_pREAL
C_bar66(1,2) = (C_parent66(1,1) + 5.0_pREAL*C_parent66(1,2) - 2.0_pREAL*C_parent66(4,4))/6.0_pREAL
C_bar66(3,3) = (C_parent66(1,1) + 2.0_pREAL*C_parent66(1,2) + 4.0_pREAL*C_parent66(4,4))/3.0_pREAL
@ -566,13 +569,13 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
C_target_unrotated66(1,3) = C_bar66(1,3)
C_target_unrotated66(3,3) = C_bar66(3,3)
C_target_unrotated66(4,4) = C_bar66(4,4) - C_bar66(1,4)**2/(0.5_pREAL*(C_bar66(1,1) - C_bar66(1,2)))
C_target_unrotated66 = lattice_symmetrize_C66(C_target_unrotated66,'hP')
elseif (lattice_target == 'cI' .and. present(a_cF) .and. present(a_cI)) then
C_target_unrotated66 = crystal_symmetrize_C66(C_target_unrotated66,'hP')
elseif (crystal_target == 'cI' .and. present(a_cF) .and. present(a_cI)) then
if (a_cI <= 0.0_pREAL .or. a_cF <= 0.0_pREAL) &
call IO_error(134,ext_msg='lattice_C66_trans: '//trim(lattice_target))
call IO_error(134,ext_msg='crystal_C66_trans: '//trim(crystal_target))
C_target_unrotated66 = C_parent66
else
call IO_error(137,ext_msg='lattice_C66_trans : '//trim(lattice_target))
call IO_error(137,ext_msg='crystal_C66_trans : '//trim(crystal_target))
end if
do i = 1,6
@ -584,58 +587,10 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
do i = 1,sum(Ntrans)
call R%fromMatrix(Q(1:3,1:3,i))
lattice_C66_trans(1:6,1:6,i) = R%rotStiffness(C_target_unrotated66)
crystal_C66_trans(1:6,1:6,i) = R%rotStiffness(C_target_unrotated66)
end do
end function lattice_C66_trans
!--------------------------------------------------------------------------------------------------
!> @brief Non-schmid projections for cI with up to 6 coefficients
! https://doi.org/10.1016/j.actamat.2012.03.053, eq. (17)
! https://doi.org/10.1016/j.actamat.2008.07.037, table 1
!--------------------------------------------------------------------------------------------------
function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSchmidMatrix)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
real(pREAL), dimension(:), intent(in) :: nonSchmidCoefficients !< non-Schmid coefficients for projections
integer, intent(in) :: sense !< sense (-1,+1)
real(pREAL), dimension(1:3,1:3,sum(Nslip)) :: nonSchmidMatrix
real(pREAL), dimension(1:3,1:3,sum(Nslip)) :: coordinateSystem !< coordinate system of slip system
real(pREAL), dimension(3) :: direction, normal, np
type(tRotation) :: R
integer :: i
if (abs(sense) /= 1) error stop 'Sense in lattice_nonSchmidMatrix'
coordinateSystem = buildCoordinateSystem(Nslip,CI_NSLIPSYSTEM,CI_SYSTEMSLIP,'cI',0.0_pREAL)
coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip))*real(sense,pREAL) ! convert unidirectional coordinate system
nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'cI',0.0_pREAL) ! Schmid contribution
do i = 1,sum(Nslip)
direction = coordinateSystem(1:3,1,i)
normal = coordinateSystem(1:3,2,i)
call R%fromAxisAngle([direction,60.0_pREAL],degrees=.true.,P=1)
np = R%rotate(normal)
if (size(nonSchmidCoefficients)>0) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(1) * math_outer(direction, np)
if (size(nonSchmidCoefficients)>1) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(2) * math_outer(math_cross(normal, direction), normal)
if (size(nonSchmidCoefficients)>2) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(3) * math_outer(math_cross(np, direction), np)
if (size(nonSchmidCoefficients)>3) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(4) * math_outer(normal, normal)
if (size(nonSchmidCoefficients)>4) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(5) * math_outer(math_cross(normal, direction), &
math_cross(normal, direction))
if (size(nonSchmidCoefficients)>5) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
+ nonSchmidCoefficients(6) * math_outer(direction, direction)
end do
end function lattice_nonSchmidMatrix
end function crystal_C66_trans
!--------------------------------------------------------------------------------------------------
@ -644,7 +599,7 @@ end function lattice_nonSchmidMatrix
!> @details https://doi.org/10.1016/j.actamat.2016.12.040 (cF: Tab S4-1, cI: Tab S5-1)
!> @details https://doi.org/10.1016/j.ijplas.2014.06.010 (hP: Tab 3b)
!--------------------------------------------------------------------------------------------------
function lattice_interaction_SlipBySlip(Nslip,interactionValues,lattice) result(interactionMatrix)
function crystal_interaction_SlipBySlip(Nslip,interactionValues,lattice) result(interactionMatrix)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
real(pREAL), dimension(:), intent(in) :: interactionValues !< values for slip-slip interaction
@ -950,19 +905,19 @@ function lattice_interaction_SlipBySlip(Nslip,interactionValues,lattice) result(
interactionTypes = TI_INTERACTIONSLIPSLIP
NslipMax = TI_NSLIPSYSTEM
case default
call IO_error(137,ext_msg='lattice_interaction_SlipBySlip: '//trim(lattice))
call IO_error(137,ext_msg='crystal_interaction_SlipBySlip: '//trim(lattice))
end select
interactionMatrix = buildInteraction(Nslip,Nslip,NslipMax,NslipMax,interactionValues,interactionTypes)
end function lattice_interaction_SlipBySlip
end function crystal_interaction_SlipBySlip
!--------------------------------------------------------------------------------------------------
!> @brief Twin-twin interaction matrix
!> details only active twin systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_interaction_TwinByTwin(Ntwin,interactionValues,lattice) result(interactionMatrix)
function crystal_interaction_TwinByTwin(Ntwin,interactionValues,lattice) result(interactionMatrix)
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
real(pREAL), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction
@ -1049,19 +1004,19 @@ function lattice_interaction_TwinByTwin(Ntwin,interactionValues,lattice) result(
interactionTypes = HP_INTERACTIONTWINTWIN
NtwinMax = HP_NTWINSYSTEM
case default
call IO_error(137,ext_msg='lattice_interaction_TwinByTwin: '//trim(lattice))
call IO_error(137,ext_msg='crystal_interaction_TwinByTwin: '//trim(lattice))
end select
interactionMatrix = buildInteraction(Ntwin,Ntwin,NtwinMax,NtwinMax,interactionValues,interactionTypes)
end function lattice_interaction_TwinByTwin
end function crystal_interaction_TwinByTwin
!--------------------------------------------------------------------------------------------------
!> @brief Trans-trans interaction matrix
!> details only active trans systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_interaction_TransByTrans(Ntrans,interactionValues,lattice) result(interactionMatrix)
function crystal_interaction_TransByTrans(Ntrans,interactionValues,lattice) result(interactionMatrix)
integer, dimension(:), intent(in) :: Ntrans !< number of active trans systems per family
real(pREAL), dimension(:), intent(in) :: interactionValues !< values for trans-trans interaction
@ -1091,19 +1046,19 @@ function lattice_interaction_TransByTrans(Ntrans,interactionValues,lattice) resu
interactionTypes = CF_INTERACTIONTRANSTRANS
NtransMax = CF_NTRANSSYSTEM
else
call IO_error(137,ext_msg='lattice_interaction_TransByTrans: '//trim(lattice))
call IO_error(137,ext_msg='crystal_interaction_TransByTrans: '//trim(lattice))
end if
interactionMatrix = buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTypes)
end function lattice_interaction_TransByTrans
end function crystal_interaction_TransByTrans
!--------------------------------------------------------------------------------------------------
!> @brief Slip-twin interaction matrix
!> details only active slip and twin systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,lattice) result(interactionMatrix)
function crystal_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,lattice) result(interactionMatrix)
integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family
Ntwin !< number of active twin systems per family
@ -1251,19 +1206,19 @@ function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,lattice) r
NslipMax = HP_NSLIPSYSTEM
NtwinMax = HP_NTWINSYSTEM
case default
call IO_error(137,ext_msg='lattice_interaction_SlipByTwin: '//trim(lattice))
call IO_error(137,ext_msg='crystal_interaction_SlipByTwin: '//trim(lattice))
end select
interactionMatrix = buildInteraction(Nslip,Ntwin,NslipMax,NtwinMax,interactionValues,interactionTypes)
end function lattice_interaction_SlipByTwin
end function crystal_interaction_SlipByTwin
!--------------------------------------------------------------------------------------------------
!> @brief Slip-trans interaction matrix
!> details only active slip and trans systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,lattice) result(interactionMatrix)
function crystal_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,lattice) result(interactionMatrix)
integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family
Ntrans !< number of active trans systems per family
@ -1304,19 +1259,19 @@ function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,lattice)
NslipMax = CF_NSLIPSYSTEM
NtransMax = CF_NTRANSSYSTEM
case default
call IO_error(137,ext_msg='lattice_interaction_SlipByTrans: '//trim(lattice))
call IO_error(137,ext_msg='crystal_interaction_SlipByTrans: '//trim(lattice))
end select
interactionMatrix = buildInteraction(Nslip,Ntrans,NslipMax,NtransMax,interactionValues,interactionTypes)
end function lattice_interaction_SlipByTrans
end function crystal_interaction_SlipByTrans
!--------------------------------------------------------------------------------------------------
!> @brief Twin-slip interaction matrix
!> details only active twin and slip systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,lattice) result(interactionMatrix)
function crystal_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,lattice) result(interactionMatrix)
integer, dimension(:), intent(in) :: Ntwin, & !< number of active twin systems per family
Nslip !< number of active slip systems per family
@ -1380,28 +1335,37 @@ function lattice_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,lattice) r
NtwinMax = HP_NTWINSYSTEM
NslipMax = HP_NSLIPSYSTEM
case default
call IO_error(137,ext_msg='lattice_interaction_TwinBySlip: '//trim(lattice))
call IO_error(137,ext_msg='crystal_interaction_TwinBySlip: '//trim(lattice))
end select
interactionMatrix = buildInteraction(Ntwin,Nslip,NtwinMax,NslipMax,interactionValues,interactionTypes)
end function lattice_interaction_TwinBySlip
end function crystal_interaction_TwinBySlip
!--------------------------------------------------------------------------------------------------
!> @brief Schmid matrix for slip
!> details only active slip systems are considered
! Non-schmid projections for cI with up to 6 coefficients
! https://doi.org/10.1016/j.actamat.2012.03.053, eq. (17)
! https://doi.org/10.1016/j.actamat.2008.07.037, table 1
!--------------------------------------------------------------------------------------------------
function lattice_SchmidMatrix_slip(Nslip,lattice,cOverA) result(SchmidMatrix)
function crystal_SchmidMatrix_slip(Nslip,lattice,cOverA,nonSchmidCoefficients,sense) result(SchmidMatrix)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
real(pREAL), intent(in) :: cOverA
real(pREAL), dimension(3,3,sum(Nslip)) :: SchmidMatrix
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
real(pREAL), intent(in) :: cOverA
real(pREAL), dimension(:,:), optional, intent(in) :: nonSchmidCoefficients !< non-Schmid coefficients for projections
integer, optional, intent(in) :: sense !< sense (-1,+1)
real(pREAL), dimension(3,3,sum(Nslip)) :: SchmidMatrix
real(pREAL), dimension(3,3,sum(Nslip)) :: coordinateSystem
real(pREAL), dimension(:,:), allocatable :: slipSystems
integer, dimension(:), allocatable :: NslipMax
integer, dimension(:), allocatable :: slipFamily
real(pREAL), dimension(3) :: direction, normal, np
real(pREAL), dimension(6) :: coeff !< local nonSchmid coefficient variable
type(tRotation) :: R
integer :: i
select case(lattice)
@ -1419,7 +1383,7 @@ function lattice_SchmidMatrix_slip(Nslip,lattice,cOverA) result(SchmidMatrix)
slipSystems = TI_SYSTEMSLIP
case default
allocate(NslipMax(0))
call IO_error(137,ext_msg='lattice_SchmidMatrix_slip: '//trim(lattice))
call IO_error(137,ext_msg='crystal_SchmidMatrix_slip: '//trim(lattice))
end select
if (any(NslipMax(1:size(Nslip)) - Nslip < 0)) &
@ -1427,27 +1391,56 @@ function lattice_SchmidMatrix_slip(Nslip,lattice,cOverA) result(SchmidMatrix)
if (any(Nslip < 0)) &
call IO_error(144,ext_msg='Nslip '//trim(lattice))
slipFamily = math_expand([(i, i=1,size(Nslip))],Nslip)
coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,lattice,cOverA)
if (present(sense)) then
if (abs(sense) /= 1) error stop 'neither +1 nor -1 sense in crystal_SchmidMatrix_slip'
coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip)) * real(sense,pREAL)
end if
do i = 1, sum(Nslip)
SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i))
do i = 1,sum(Nslip)
direction = coordinateSystem(1:3,1,i)
normal = coordinateSystem(1:3,2,i)
SchmidMatrix(1:3,1:3,i) = math_outer(direction,normal)
if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) &
error stop 'dilatational Schmid matrix for slip'
if (present(nonSchmidCoefficients)) then
select case(lattice)
case('cI')
coeff(:) = 0.0_pREAL
select case(slipFamily(i))
case(1)
coeff(:size(nonSchmidCoefficients(1,:))) = nonSchmidCoefficients(1,:)
call R%fromAxisAngle([direction,60.0_pREAL],degrees=.true.,P=1)
np = R%rotate(normal)
SchmidMatrix(1:3,1:3,i) = SchmidMatrix(1:3,1:3,i) &
+ coeff(1) * math_outer(direction, np) &
+ coeff(2) * math_outer(math_cross(normal, direction), normal) &
+ coeff(3) * math_outer(math_cross(np, direction), np) &
+ coeff(4) * math_outer(normal, normal) &
+ coeff(5) * math_outer(math_cross(normal, direction), &
math_cross(normal, direction)) &
+ coeff(6) * math_outer(direction, direction)
end select
end select
end if
end do
end function lattice_SchmidMatrix_slip
end function crystal_SchmidMatrix_slip
!--------------------------------------------------------------------------------------------------
!> @brief Schmid matrix for twinning
!> details only active twin systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_SchmidMatrix_twin(Ntwin,lattice,cOverA) result(SchmidMatrix)
function crystal_SchmidMatrix_twin(Ntwin,lattice,cOverA) result(SchmidMatrix)
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
real(pREAL), intent(in) :: cOverA !< c/a ratio
real(pREAL), dimension(3,3,sum(Ntwin)) :: SchmidMatrix
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
real(pREAL), intent(in) :: cOverA !< c/a ratio
real(pREAL), dimension(3,3,sum(Ntwin)) :: SchmidMatrix
real(pREAL), dimension(3,3,sum(Ntwin)) :: coordinateSystem
real(pREAL), dimension(:,:), allocatable :: twinSystems
@ -1466,7 +1459,7 @@ function lattice_SchmidMatrix_twin(Ntwin,lattice,cOverA) result(SchmidMatrix)
twinSystems = HP_SYSTEMTWIN
case default
allocate(NtwinMax(0))
call IO_error(137,ext_msg='lattice_SchmidMatrix_twin: '//trim(lattice))
call IO_error(137,ext_msg='crystal_SchmidMatrix_twin: '//trim(lattice))
end select
if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0)) &
@ -1482,48 +1475,48 @@ function lattice_SchmidMatrix_twin(Ntwin,lattice,cOverA) result(SchmidMatrix)
error stop 'dilatational Schmid matrix for twin'
end do
end function lattice_SchmidMatrix_twin
end function crystal_SchmidMatrix_twin
!--------------------------------------------------------------------------------------------------
!> @brief Schmid matrix for transformation
!> details only active twin systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_SchmidMatrix_trans(Ntrans,lattice_target,cOverA,a_cF,a_cI) result(SchmidMatrix)
function crystal_SchmidMatrix_trans(Ntrans,crystal_target,cOverA,a_cF,a_cI) result(SchmidMatrix)
integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family
character(len=*), intent(in) :: lattice_target !< Bravais lattice (Pearson symbol)
character(len=*), intent(in) :: crystal_target !< Bravais lattice (Pearson symbol)
real(pREAL), optional, intent(in) :: cOverA, a_cI, a_cF
real(pREAL), dimension(3,3,sum(Ntrans)) :: SchmidMatrix
real(pREAL), dimension(3,3,sum(Ntrans)) :: devNull
if (lattice_target == 'hP' .and. present(cOverA)) then
if (crystal_target == 'hP' .and. present(cOverA)) then
if (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL) &
call IO_error(131,ext_msg='lattice_SchmidMatrix_trans: '//trim(lattice_target))
call IO_error(131,ext_msg='crystal_SchmidMatrix_trans: '//trim(crystal_target))
call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,cOverA=cOverA)
else if (lattice_target == 'cI' .and. present(a_cF) .and. present(a_cI)) then
else if (crystal_target == 'cI' .and. present(a_cF) .and. present(a_cI)) then
if (a_cI <= 0.0_pREAL .or. a_cF <= 0.0_pREAL) &
call IO_error(134,ext_msg='lattice_SchmidMatrix_trans: '//trim(lattice_target))
call IO_error(134,ext_msg='crystal_SchmidMatrix_trans: '//trim(crystal_target))
call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,a_cF=a_cF,a_cI=a_cI)
else
call IO_error(131,ext_msg='lattice_SchmidMatrix_trans: '//trim(lattice_target))
call IO_error(131,ext_msg='crystal_SchmidMatrix_trans: '//trim(crystal_target))
end if
end function lattice_SchmidMatrix_trans
end function crystal_SchmidMatrix_trans
!--------------------------------------------------------------------------------------------------
!> @brief Schmid matrix for cleavage
!> details only active cleavage systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_SchmidMatrix_cleavage(Ncleavage,lattice,cOverA) result(SchmidMatrix)
function crystal_SchmidMatrix_cleavage(Ncleavage,lattice,cOverA) result(SchmidMatrix)
integer, dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
real(pREAL), intent(in) :: cOverA !< c/a ratio
real(pREAL), dimension(3,3,3,sum(Ncleavage)) :: SchmidMatrix
integer, dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
real(pREAL), intent(in) :: cOverA !< c/a ratio
real(pREAL), dimension(3,3,3,sum(Ncleavage)) :: SchmidMatrix
real(pREAL), dimension(3,3,sum(Ncleavage)) :: coordinateSystem
real(pREAL), dimension(:,:), allocatable :: cleavageSystems
@ -1539,7 +1532,7 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,lattice,cOverA) result(SchmidMa
cleavageSystems = CI_SYSTEMCLEAVAGE
case default
allocate(NcleavageMax(0))
call IO_error(137,ext_msg='lattice_SchmidMatrix_cleavage: '//trim(lattice))
call IO_error(137,ext_msg='crystal_SchmidMatrix_cleavage: '//trim(lattice))
end select
if (any(NcleavageMax(1:size(Ncleavage)) - Ncleavage < 0)) &
@ -1555,13 +1548,13 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,lattice,cOverA) result(SchmidMa
SchmidMatrix(1:3,1:3,3,i) = math_outer(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i))
end do
end function lattice_SchmidMatrix_cleavage
end function crystal_SchmidMatrix_cleavage
!--------------------------------------------------------------------------------------------------
!> @brief Slip direction of slip systems (|| b)
!--------------------------------------------------------------------------------------------------
function lattice_slip_direction(Nslip,lattice,cOverA) result(d)
function crystal_slip_direction(Nslip,lattice,cOverA) result(d)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
@ -1573,13 +1566,13 @@ function lattice_slip_direction(Nslip,lattice,cOverA) result(d)
coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
d = coordinateSystem(1:3,1,1:sum(Nslip))
end function lattice_slip_direction
end function crystal_slip_direction
!--------------------------------------------------------------------------------------------------
!> @brief Normal direction of slip systems (|| n)
!--------------------------------------------------------------------------------------------------
function lattice_slip_normal(Nslip,lattice,cOverA) result(n)
function crystal_slip_normal(Nslip,lattice,cOverA) result(n)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
@ -1591,13 +1584,13 @@ function lattice_slip_normal(Nslip,lattice,cOverA) result(n)
coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
n = coordinateSystem(1:3,2,1:sum(Nslip))
end function lattice_slip_normal
end function crystal_slip_normal
!--------------------------------------------------------------------------------------------------
!> @brief Transverse direction of slip systems (|| t = b x n)
!--------------------------------------------------------------------------------------------------
function lattice_slip_transverse(Nslip,lattice,cOverA) result(t)
function crystal_slip_transverse(Nslip,lattice,cOverA) result(t)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
@ -1609,14 +1602,14 @@ function lattice_slip_transverse(Nslip,lattice,cOverA) result(t)
coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
t = coordinateSystem(1:3,3,1:sum(Nslip))
end function lattice_slip_transverse
end function crystal_slip_transverse
!--------------------------------------------------------------------------------------------------
!> @brief Labels of slip systems
!> details only active slip systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_labels_slip(Nslip,lattice) result(labels)
function crystal_labels_slip(Nslip,lattice) result(labels)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
@ -1640,7 +1633,7 @@ function lattice_labels_slip(Nslip,lattice) result(labels)
NslipMax = TI_NSLIPSYSTEM
slipSystems = TI_SYSTEMSLIP
case default
call IO_error(137,ext_msg='lattice_labels_slip: '//trim(lattice))
call IO_error(137,ext_msg='crystal_labels_slip: '//trim(lattice))
end select
if (any(NslipMax(1:size(Nslip)) - Nslip < 0)) &
@ -1650,13 +1643,13 @@ function lattice_labels_slip(Nslip,lattice) result(labels)
labels = getLabels(Nslip,NslipMax,slipSystems)
end function lattice_labels_slip
end function crystal_labels_slip
!--------------------------------------------------------------------------------------------------
!> @brief Return 3x3 tensor with symmetry according to given Bravais lattice
!--------------------------------------------------------------------------------------------------
pure function lattice_symmetrize_33(T,lattice) result(T_sym)
pure function crystal_symmetrize_33(T,lattice) result(T_sym)
real(pREAL), dimension(3,3) :: T_sym
@ -1677,14 +1670,14 @@ pure function lattice_symmetrize_33(T,lattice) result(T_sym)
T_sym(3,3) = T(3,3)
end select
end function lattice_symmetrize_33
end function crystal_symmetrize_33
!--------------------------------------------------------------------------------------------------
!> @brief Return stiffness matrix in 6x6 notation with symmetry according to given Bravais lattice
!> @details J. A. Rayne and B. S. Chandrasekhar Phys. Rev. 120, 1658 Erratum Phys. Rev. 122, 1962
!--------------------------------------------------------------------------------------------------
pure function lattice_symmetrize_C66(C66,lattice) result(C66_sym)
pure function crystal_symmetrize_C66(C66,lattice) result(C66_sym)
real(pREAL), dimension(6,6) :: C66_sym
@ -1723,14 +1716,14 @@ pure function lattice_symmetrize_C66(C66,lattice) result(C66_sym)
end do
end do
end function lattice_symmetrize_C66
end function crystal_symmetrize_C66
!--------------------------------------------------------------------------------------------------
!> @brief Labels for twin systems
!> details only active twin systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_labels_twin(Ntwin,lattice) result(labels)
function crystal_labels_twin(Ntwin,lattice) result(labels)
integer, dimension(:), intent(in) :: Ntwin !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
@ -1751,7 +1744,7 @@ function lattice_labels_twin(Ntwin,lattice) result(labels)
NtwinMax = HP_NTWINSYSTEM
twinSystems = HP_SYSTEMTWIN
case default
call IO_error(137,ext_msg='lattice_labels_twin: '//trim(lattice))
call IO_error(137,ext_msg='crystal_labels_twin: '//trim(lattice))
end select
if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0)) &
@ -1761,7 +1754,7 @@ function lattice_labels_twin(Ntwin,lattice) result(labels)
labels = getLabels(Ntwin,NtwinMax,twinSystems)
end function lattice_labels_twin
end function crystal_labels_twin
!--------------------------------------------------------------------------------------------------
@ -1778,8 +1771,8 @@ function slipProjection_transverse(Nslip,lattice,cOverA) result(projection)
real(pREAL), dimension(3,sum(Nslip)) :: n, t
integer :: i, j
n = lattice_slip_normal (Nslip,lattice,cOverA)
t = lattice_slip_transverse(Nslip,lattice,cOverA)
n = crystal_slip_normal (Nslip,lattice,cOverA)
t = crystal_slip_transverse(Nslip,lattice,cOverA)
do i=1, sum(Nslip); do j=1, sum(Nslip)
projection(i,j) = abs(math_inner(n(:,i),t(:,j)))
@ -1802,8 +1795,8 @@ function slipProjection_direction(Nslip,lattice,cOverA) result(projection)
real(pREAL), dimension(3,sum(Nslip)) :: n, d
integer :: i, j
n = lattice_slip_normal (Nslip,lattice,cOverA)
d = lattice_slip_direction(Nslip,lattice,cOverA)
n = crystal_slip_normal (Nslip,lattice,cOverA)
d = crystal_slip_direction(Nslip,lattice,cOverA)
do i=1, sum(Nslip); do j=1, sum(Nslip)
projection(i,j) = abs(math_inner(n(:,i),d(:,j)))
@ -1901,9 +1894,9 @@ end function buildInteraction
!> @brief Build a local coordinate system on slip, twin, trans, cleavage systems
!> @details Order: Direction, plane (normal), and common perpendicular
!--------------------------------------------------------------------------------------------------
function buildCoordinateSystem(active,potential,system,lattice,cOverA)
function buildCoordinateSystem(active,potential,system,lattice,cOverA) result(coordinateSystem)
integer, dimension(:), intent(in) :: &
integer, dimension(:), intent(in) :: &
active, & !< # of active systems per family
potential !< # of potential systems per family
real(pREAL), dimension(:,:), intent(in) :: &
@ -1913,7 +1906,7 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
real(pREAL), intent(in) :: &
cOverA
real(pREAL), dimension(3,3,sum(active)) :: &
buildCoordinateSystem
coordinateSystem
real(pREAL), dimension(3) :: &
direction, normal
@ -1936,10 +1929,14 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
select case(lattice)
case ('cF','cI','tI')
case ('cF','cI')
direction = system(1:3,p)
normal = system(4:6,p)
case ('tI')
direction = [ system(1,p), system(2,p), system(3,p)*cOverA ]
normal = [ system(4,p), system(5,p), system(6,p)/cOverA ]
case ('hP')
direction = [ system(1,p)*1.5_pREAL, &
(system(1,p)+2.0_pREAL*system(2,p))*sqrt(0.75_pREAL), &
@ -1953,10 +1950,10 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
end select
buildCoordinateSystem(1:3,1,a) = direction/norm2(direction)
buildCoordinateSystem(1:3,2,a) = normal /norm2(normal)
buildCoordinateSystem(1:3,3,a) = math_cross(direction/norm2(direction),&
normal /norm2(normal))
coordinateSystem(1:3,1,a) = direction/norm2(direction)
coordinateSystem(1:3,2,a) = normal /norm2(normal)
coordinateSystem(1:3,3,a) = math_cross(direction/norm2(direction),&
normal /norm2(normal))
end do activeSystems
end do activeFamilies
@ -2150,7 +2147,7 @@ end function getlabels
!> @brief Equivalent Poisson's ratio (ν)
!> @details https://doi.org/10.1143/JPSJ.20.635
!--------------------------------------------------------------------------------------------------
pure function lattice_isotropic_nu(C,assumption,lattice) result(nu)
pure function crystal_isotropic_nu(C,assumption,lattice) result(nu)
real(pREAL), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
character(len=*), intent(in) :: assumption !< Assumption (isostrain = 'Voigt', isostress = 'Reuss')
@ -2172,10 +2169,10 @@ pure function lattice_isotropic_nu(C,assumption,lattice) result(nu)
error stop 'invalid assumption'
end if
mu = lattice_isotropic_mu(C,assumption,lattice)
mu = crystal_isotropic_mu(C,assumption,lattice)
nu = (1.5_pREAL*K-mu)/(3.0_pREAL*K+mu)
end function lattice_isotropic_nu
end function crystal_isotropic_nu
!--------------------------------------------------------------------------------------------------
@ -2183,7 +2180,7 @@ end function lattice_isotropic_nu
!> @details https://doi.org/10.1143/JPSJ.20.635
!> @details Nonlinear Mechanics of Crystals 10.1007/978-94-007-0350-6, pp 563
!--------------------------------------------------------------------------------------------------
pure function lattice_isotropic_mu(C,assumption,lattice) result(mu)
pure function crystal_isotropic_mu(C,assumption,lattice) result(mu)
real(pREAL), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
character(len=*), intent(in) :: assumption !< Assumption (isostrain = 'Voigt', isostress = 'Reuss')
@ -2220,13 +2217,13 @@ pure function lattice_isotropic_mu(C,assumption,lattice) result(mu)
error stop 'invalid assumption'
end if
end function lattice_isotropic_mu
end function crystal_isotropic_mu
!--------------------------------------------------------------------------------------------------
!> @brief Check correctness of some lattice functions.
!> @brief Check correctness of some crystal functions.
!--------------------------------------------------------------------------------------------------
subroutine selfTest
subroutine crystal_selfTest
real(pREAL), dimension(:,:,:), allocatable :: CoSy
real(pREAL), dimension(:,:), allocatable :: system
@ -2244,12 +2241,18 @@ subroutine selfTest
CoSy = buildCoordinateSystem([1],[1],system,'cF',0.0_pREAL)
if (any(dNeq(CoSy(1:3,1:3,1),math_I3))) error stop 'buildCoordinateSystem'
if (any(dNeq(buildCoordinateSystem(TI_NSLIPSYSTEM,TI_NSLIPSYSTEM,TI_SYSTEMSLIP,'cI',0.0_pReal), &
buildCoordinateSystem(TI_NSLIPSYSTEM,TI_NSLIPSYSTEM,TI_SYSTEMSLIP,'tI',1.0_pReal)))) &
error stop 'cI/tI coordinate system'
if (all(dEq( buildCoordinateSystem(TI_NSLIPSYSTEM,TI_NSLIPSYSTEM,TI_SYSTEMSLIP,'tI',1.1_pReal + r(1)*0.9_pReal), &
buildCoordinateSystem(TI_NSLIPSYSTEM,TI_NSLIPSYSTEM,TI_SYSTEMSLIP,'tI',1.0_pReal)))) &
error stop 'tI coordinate system'
do i = 1, 10
call random_number(C)
C_cF = lattice_symmetrize_C66(C,'cI')
C_cI = lattice_symmetrize_C66(C,'cF')
C_hP = lattice_symmetrize_C66(C,'hP')
C_tI = lattice_symmetrize_C66(C,'tI')
C_cF = crystal_symmetrize_C66(C,'cI')
C_cI = crystal_symmetrize_C66(C,'cF')
C_hP = crystal_symmetrize_C66(C,'hP')
C_tI = crystal_symmetrize_C66(C,'tI')
if (any(dNeq(C_cI,transpose(C_cF)))) error stop 'SymmetryC66/cI-cF'
if (any(dNeq(C_cF,transpose(C_cI)))) error stop 'SymmetryC66/cF-cI'
@ -2269,10 +2272,10 @@ subroutine selfTest
if (any(dNeq(C(4,4),[C_tI(4,4),C_tI(5,5)]))) error stop 'SymmetryC_44-55/tI'
call random_number(T)
T_cF = lattice_symmetrize_33(T,'cI')
T_cI = lattice_symmetrize_33(T,'cF')
T_hP = lattice_symmetrize_33(T,'hP')
T_tI = lattice_symmetrize_33(T,'tI')
T_cF = crystal_symmetrize_33(T,'cI')
T_cI = crystal_symmetrize_33(T,'cF')
T_hP = crystal_symmetrize_33(T,'hP')
T_tI = crystal_symmetrize_33(T,'tI')
if (any(dNeq0(T_cF) .and. math_I3<1.0_pREAL)) error stop 'Symmetry33/c'
if (any(dNeq0(T_hP) .and. math_I3<1.0_pREAL)) error stop 'Symmetry33/hP'
@ -2291,48 +2294,48 @@ subroutine selfTest
C(4,4) = 0.5_pREAL * (C(1,1) - C(1,2))
C(6,6) = C(4,4)
C_cI = lattice_symmetrize_C66(C,'cI')
if (dNeq(C_cI(4,4),lattice_isotropic_mu(C_cI,'isostrain','cI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/cI'
if (dNeq(C_cI(4,4),lattice_isotropic_mu(C_cI,'isostress','cI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/cI'
C_cI = crystal_symmetrize_C66(C,'cI')
if (dNeq(C_cI(4,4),crystal_isotropic_mu(C_cI,'isostrain','cI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/cI'
if (dNeq(C_cI(4,4),crystal_isotropic_mu(C_cI,'isostress','cI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/cI'
lambda = C_cI(1,2)
if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_cI,'isostrain','cI')), &
lattice_isotropic_nu(C_cI,'isostrain','cI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/cI'
if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_cI,'isostress','cI')), &
lattice_isotropic_nu(C_cI,'isostress','cI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/cI'
if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_cI,'isostrain','cI')), &
crystal_isotropic_nu(C_cI,'isostrain','cI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/cI'
if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_cI,'isostress','cI')), &
crystal_isotropic_nu(C_cI,'isostress','cI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/cI'
C_hP = lattice_symmetrize_C66(C,'hP')
if (dNeq(C(4,4),lattice_isotropic_mu(C_hP,'isostrain','hP'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/hP'
if (dNeq(C(4,4),lattice_isotropic_mu(C_hP,'isostress','hP'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/hP'
C_hP = crystal_symmetrize_C66(C,'hP')
if (dNeq(C(4,4),crystal_isotropic_mu(C_hP,'isostrain','hP'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/hP'
if (dNeq(C(4,4),crystal_isotropic_mu(C_hP,'isostress','hP'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/hP'
lambda = C_hP(1,2)
if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_hP,'isostrain','hP')), &
lattice_isotropic_nu(C_hP,'isostrain','hP'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/hP'
if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_hP,'isostress','hP')), &
lattice_isotropic_nu(C_hP,'isostress','hP'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/hP'
if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_hP,'isostrain','hP')), &
crystal_isotropic_nu(C_hP,'isostrain','hP'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/hP'
if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_hP,'isostress','hP')), &
crystal_isotropic_nu(C_hP,'isostress','hP'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/hP'
C_tI = lattice_symmetrize_C66(C,'tI')
if (dNeq(C(6,6),lattice_isotropic_mu(C_tI,'isostrain','tI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/tI'
if (dNeq(C(6,6),lattice_isotropic_mu(C_tI,'isostress','tI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/tI'
C_tI = crystal_symmetrize_C66(C,'tI')
if (dNeq(C(6,6),crystal_isotropic_mu(C_tI,'isostrain','tI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/tI'
if (dNeq(C(6,6),crystal_isotropic_mu(C_tI,'isostress','tI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/tI'
lambda = C_tI(1,2)
if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_tI,'isostrain','tI')), &
lattice_isotropic_nu(C_tI,'isostrain','tI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/tI'
if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_tI,'isostress','tI')), &
lattice_isotropic_nu(C_tI,'isostress','tI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/tI'
if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_tI,'isostrain','tI')), &
crystal_isotropic_nu(C_tI,'isostrain','tI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/tI'
if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_tI,'isostress','tI')), &
crystal_isotropic_nu(C_tI,'isostress','tI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/tI'
call random_number(C)
C = lattice_symmetrize_C66(C+math_eye(6),'cI')
if (dNeq(lattice_isotropic_mu(C,'isostrain','cI'), lattice_isotropic_mu(C,'isostrain','hP'), 1.0e-12_pREAL)) &
C = crystal_symmetrize_C66(C+math_eye(6),'cI')
if (dNeq(crystal_isotropic_mu(C,'isostrain','cI'), crystal_isotropic_mu(C,'isostrain','hP'), 1.0e-12_pREAL)) &
error stop 'isotropic_mu/isostrain/cI-hP'
if (dNeq(lattice_isotropic_nu(C,'isostrain','cF'), lattice_isotropic_nu(C,'isostrain','cI'), 1.0e-12_pREAL)) &
if (dNeq(crystal_isotropic_nu(C,'isostrain','cF'), crystal_isotropic_nu(C,'isostrain','cI'), 1.0e-12_pREAL)) &
error stop 'isotropic_nu/isostrain/cF-tI'
if (dNeq(lattice_isotropic_mu(C,'isostress','cI'), lattice_isotropic_mu(C,'isostress'), 1.0e-12_pREAL)) &
if (dNeq(crystal_isotropic_mu(C,'isostress','cI'), crystal_isotropic_mu(C,'isostress'), 1.0e-12_pREAL)) &
error stop 'isotropic_mu/isostress/cI-hP'
if (dNeq(lattice_isotropic_nu(C,'isostress','cF'), lattice_isotropic_nu(C,'isostress'), 1.0e-12_pREAL)) &
if (dNeq(crystal_isotropic_nu(C,'isostress','cF'), crystal_isotropic_nu(C,'isostress'), 1.0e-12_pREAL)) &
error stop 'isotropic_nu/isostress/cF-tI'
end subroutine selfTest
end subroutine crystal_selfTest
end module lattice
end module crystal

515
src/grid/DAMASK_grid.f90
View File

@ -24,7 +24,7 @@ program DAMASK_grid
use material
use spectral_utilities
use grid_mechanical_spectral_basic
use grid_mechanical_spectral_polarisation
use grid_mechanical_spectral_polarization
use grid_mechanical_FEM
use grid_damage_spectral
use grid_thermal_spectral
@ -75,7 +75,7 @@ program DAMASK_grid
cutBack = .false.,&
sig
integer :: &
i, j, m, field, &
i, j, field, &
errorID = 0, &
cutBackLevel = 0, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
stepFraction = 0, & !< fraction of current time interval
@ -107,21 +107,14 @@ program DAMASK_grid
external :: &
quit
type(tDict), pointer :: &
config_load, &
load, &
num_solver, &
num_grid, &
load_step, &
solver, &
step_bc, &
step_mech, &
step_discretization
type(tList), pointer :: &
#ifdef __INTEL_LLVM_COMPILER
tensor, &
#endif
load_steps
solver
character(len=:), allocatable :: &
fileContent, fname
!--------------------------------------------------------------------------------------------------
! init DAMASK (all modules)
@ -134,25 +127,29 @@ program DAMASK_grid
!-------------------------------------------------------------------------------------------------
! read (and check) field parameters from numerics file
num_grid => config_numerics%get_dict('grid', defaultVal=emptyDict)
stagItMax = num_grid%get_asInt('maxStaggeredIter',defaultVal=10)
maxCutBack = num_grid%get_asInt('maxCutBack',defaultVal=3)
if (stagItMax < 0) call IO_error(301,ext_msg='maxStaggeredIter')
if (maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack')
num_solver => config_numerics%get_dict('solver',defaultVal=emptyDict)
num_grid => num_solver%get_dict('grid',defaultVal=emptyDict)
stagItMax = num_grid%get_asInt('N_staggered_iter_max',defaultVal=10)
maxCutBack = num_grid%get_asInt('N_cutback_max',defaultVal=3)
if (stagItMax < 0) call IO_error(301,ext_msg='N_staggered_iter_max')
if (maxCutBack < 0) call IO_error(301,ext_msg='N_cutback_max')
if (worldrank == 0) then
fileContent = IO_read(CLI_loadFile)
fname = CLI_loadFile
if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:)
call result_openJobFile(parallel=.false.)
call result_writeDataset_str(fileContent,'setup',fname,'load case definition (grid solver)')
call result_addSetupFile(fileContent,fname,'load case definition (grid solver)')
call result_closeJobFile()
end if
call parallelization_bcast_str(fileContent)
config_load => YAML_parse_str_asDict(fileContent)
solver => config_load%get_dict('solver')
load => YAML_parse_str_asDict(fileContent)
solver => load%get_dict('solver')
!--------------------------------------------------------------------------------------------------
! assign mechanics solver depending on selected type
@ -167,11 +164,11 @@ program DAMASK_grid
mechanical_restartWrite => grid_mechanical_spectral_basic_restartWrite
case ('spectral_polarization')
mechanical_init => grid_mechanical_spectral_polarisation_init
mechanical_forward => grid_mechanical_spectral_polarisation_forward
mechanical_solution => grid_mechanical_spectral_polarisation_solution
mechanical_updateCoords => grid_mechanical_spectral_polarisation_updateCoords
mechanical_restartWrite => grid_mechanical_spectral_polarisation_restartWrite
mechanical_init => grid_mechanical_spectral_polarization_init
mechanical_forward => grid_mechanical_spectral_polarization_forward
mechanical_solution => grid_mechanical_spectral_polarization_solution
mechanical_updateCoords => grid_mechanical_spectral_polarization_updateCoords
mechanical_restartWrite => grid_mechanical_spectral_polarization_restartWrite
case ('FEM')
mechanical_init => grid_mechanical_FEM_init
@ -204,13 +201,251 @@ program DAMASK_grid
ID(field) = FIELD_DAMAGE_ID
end if damageActive
!--------------------------------------------------------------------------------------------------
! doing initialization depending on active solvers
call spectral_utilities_init()
do field = 2, nActiveFields
select case (ID(field))
case (FIELD_THERMAL_ID)
call grid_thermal_spectral_init(num_grid)
case (FIELD_DAMAGE_ID)
call grid_damage_spectral_init(num_grid)
end select
end do
call mechanical_init(num_grid)
call config_numerics_deallocate()
!--------------------------------------------------------------------------------------------------
load_steps => config_load%get_list('loadstep')
allocate(loadCases(load_steps%length)) ! array of load cases
! write header of output file
if (worldrank == 0) then
writeHeader: if (CLI_restartInc < 1) then
open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded StagIterationsNeeded' ! statistics file
else writeHeader
open(newunit=statUnit,file=trim(getSolverJobName())//&
'.sta',form='FORMATTED', position='APPEND', status='OLD')
end if writeHeader
end if
writeUndeformed: if (CLI_restartInc < 1) then
print'(/,1x,a)', '... saving initial configuration ..........................................'
flush(IO_STDOUT)
call materialpoint_result(0,0.0_pREAL)
end if writeUndeformed
loadCases = parseLoadSteps(load%get_list('loadstep'))
loadCaseLooping: do l = 1, size(loadCases)
t_0 = t ! load case start time
guess = loadCases(l)%estimate_rate ! change of load case? homogeneous guess for the first inc
incLooping: do inc = 1, loadCases(l)%N
totalIncsCounter = totalIncsCounter + 1
!--------------------------------------------------------------------------------------------------
! forwarding time
Delta_t_prev = Delta_t ! last time intervall that brought former inc to an end
if (dEq(loadCases(l)%r,1.0_pREAL,1.e-9_pREAL)) then ! linear scale
Delta_t = loadCases(l)%t/real(loadCases(l)%N,pREAL)
else
Delta_t = loadCases(l)%t * (loadCases(l)%r**(inc-1)-loadCases(l)%r**inc) &
/ (1.0_pREAL-loadCases(l)%r**loadCases(l)%N)
end if
Delta_t = Delta_t * real(subStepFactor,pREAL)**real(-cutBackLevel,pREAL) ! depending on cut back level, decrease time step
skipping: if (totalIncsCounter <= CLI_restartInc) then ! not yet at restart inc?
t = t + Delta_t ! just advance time, skip already performed calculation
guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference
else skipping
stepFraction = 0 ! fraction scaled by stepFactor**cutLevel
subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel)
t_remaining = loadCases(l)%t + t_0 - t
t = t + Delta_t ! forward target time
stepFraction = stepFraction + 1 ! count step
!--------------------------------------------------------------------------------------------------
! report beginning of new step
print'(/,1x,a)', '###########################################################################'
print'(1x,a,1x,es12.5,6(a,i0))', &
'Time', t, &
's: Increment ', inc,'/',loadCases(l)%N,&
'-', stepFraction,'/',subStepFactor**cutBackLevel,&
' of load case ', l,'/',size(loadCases)
write(incInfo,'(4(a,i0))') &
'Increment ',totalIncsCounter,'/',sum(loadCases%N),&
'-', stepFraction,'/',subStepFactor**cutBackLevel
flush(IO_STDOUT)
!--------------------------------------------------------------------------------------------------
! forward fields
do field = 1, nActiveFields
select case(ID(field))
case(FIELD_MECH_ID)
call mechanical_forward (&
cutBack,guess,Delta_t,Delta_t_prev,t_remaining, &
deformation_BC = loadCases(l)%deformation, &
stress_BC = loadCases(l)%stress, &
rotation_BC = loadCases(l)%rot)
case(FIELD_THERMAL_ID); call grid_thermal_spectral_forward(cutBack)
case(FIELD_DAMAGE_ID); call grid_damage_spectral_forward(cutBack)
end select
end do
if (.not. cutBack) call materialpoint_forward
!--------------------------------------------------------------------------------------------------
! solve fields
stagIter = 1
stagIterate = .true.
do while (stagIterate)
if (nActiveFields > 1) print'(/,1x,a,i0)', 'Staggered Iteration ',stagIter
do field = 1, nActiveFields
select case(ID(field))
case(FIELD_MECH_ID)
solres(field) = mechanical_solution(incInfo)
case(FIELD_THERMAL_ID)
solres(field) = grid_thermal_spectral_solution(Delta_t)
case(FIELD_DAMAGE_ID)
solres(field) = grid_damage_spectral_solution(Delta_t)
end select
if (.not. solres(field)%converged) exit ! no solution found
end do
stagIter = stagIter + 1
stagIterate = stagIter <= stagItMax &
.and. all(solres(:)%converged) &
.and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration
end do
!--------------------------------------------------------------------------------------------------
! check solution and either advance or retry with smaller timestep
if ( (all(solres(:)%converged .and. solres(:)%stagConverged)) & ! converged
.and. .not. solres(1)%termIll) then ! and acceptable solution found
call mechanical_updateCoords()
Delta_t_prev = Delta_t
cutBack = .false.
guess = .true. ! start guessing after first converged (sub)inc
if (worldrank == 0) then
write(statUnit,*) totalIncsCounter, t, cutBackLevel, &
solres(1)%converged, solres(1)%iterationsNeeded, StagIter
flush(statUnit)
end if
elseif (cutBackLevel < maxCutBack) then ! further cutbacking tolerated?
cutBack = .true.
stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1
t = t - Delta_t
Delta_t = Delta_t/real(subStepFactor,pREAL) ! cut timestep
print'(/,1x,a)', 'cutting back '
else ! no more options to continue
if (worldrank == 0) close(statUnit)
call IO_error(950)
end if
end do subStepLooping
cutBackLevel = max(0, cutBackLevel - 1) ! try half number of subincs next inc
if (all(solres(:)%converged)) then
print'(/,1x,a,1x,i0,1x,a)', 'increment', totalIncsCounter, 'converged'
else
print'(/,1x,a,1x,i0,1x,a)', 'increment', totalIncsCounter, 'NOT converged'
end if; flush(IO_STDOUT)
call MPI_Allreduce(signal_SIGUSR1,sig,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (mod(inc,loadCases(l)%f_out) == 0 .or. sig) then
print'(/,1x,a)', '... saving results ........................................................'
flush(IO_STDOUT)
call materialpoint_result(totalIncsCounter,t)
end if
if (sig) call signal_setSIGUSR1(.false.)
call MPI_Allreduce(signal_SIGUSR2,sig,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (mod(inc,loadCases(l)%f_restart) == 0 .or. sig) then
do field = 1, nActiveFields
select case (ID(field))
case(FIELD_MECH_ID)
call mechanical_restartWrite()
case(FIELD_THERMAL_ID)
call grid_thermal_spectral_restartWrite()
case(FIELD_DAMAGE_ID)
call grid_damage_spectral_restartWrite()
end select
end do
call materialpoint_restartWrite()
end if
if (sig) call signal_setSIGUSR2(.false.)
call MPI_Allreduce(signal_SIGINT,sig,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (sig) exit loadCaseLooping
end if skipping
end do incLooping
end do loadCaseLooping
!--------------------------------------------------------------------------------------------------
! report summary of whole calculation
print'(/,1x,a)', '###########################################################################'
if (worldrank == 0) close(statUnit)
call quit(0) ! no complains ;)
contains
subroutine getMaskedTensor(values,mask,tensor)
real(pREAL), intent(out), dimension(3,3) :: values
logical, intent(out), dimension(3,3) :: mask
type(tList), pointer :: tensor
type(tList), pointer :: row
integer :: i,j
values = 0.0_pREAL
do i = 1,3
row => tensor%get_list(i)
do j = 1,3
mask(i,j) = row%get_asStr(j) == 'x'
if (.not. mask(i,j)) values(i,j) = row%get_asReal(j)
end do
end do
end subroutine getMaskedTensor
function parseLoadsteps(load_steps) result(loadCases)
type(tList), intent(in), target :: load_steps
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
integer :: l,m
type(tDict), pointer :: &
load_step, &
step_bc, &
step_mech, &
step_discretization
#ifdef __INTEL_LLVM_COMPILER
type(tList), pointer :: &
tensor
#endif
allocate(loadCases(load_steps%length))
do l = 1, load_steps%length
load_step => load_steps%get_dict(l)
step_bc => load_step%get_dict('boundary_conditions')
step_mech => step_bc%get_dict('mechanical')
@ -310,226 +545,6 @@ program DAMASK_grid
end if reportAndCheck
end do
!--------------------------------------------------------------------------------------------------
! doing initialization depending on active solvers
call spectral_Utilities_init()
do field = 2, nActiveFields
select case (ID(field))
case (FIELD_THERMAL_ID)
call grid_thermal_spectral_init()
case (FIELD_DAMAGE_ID)
call grid_damage_spectral_init()
end select
end do
call mechanical_init()
call config_numerics_deallocate()
!--------------------------------------------------------------------------------------------------
! write header of output file
if (worldrank == 0) then
writeHeader: if (CLI_restartInc < 1) then
open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file
else writeHeader
open(newunit=statUnit,file=trim(getSolverJobName())//&
'.sta',form='FORMATTED', position='APPEND', status='OLD')
end if writeHeader
end if
writeUndeformed: if (CLI_restartInc < 1) then
print'(/,1x,a)', '... saving initial configuration ..........................................'
flush(IO_STDOUT)
call materialpoint_result(0,0.0_pREAL)
end if writeUndeformed
loadCaseLooping: do l = 1, size(loadCases)
t_0 = t ! load case start time
guess = loadCases(l)%estimate_rate ! change of load case? homogeneous guess for the first inc
incLooping: do inc = 1, loadCases(l)%N
totalIncsCounter = totalIncsCounter + 1
!--------------------------------------------------------------------------------------------------
! forwarding time
Delta_t_prev = Delta_t ! last time intervall that brought former inc to an end
if (dEq(loadCases(l)%r,1.0_pREAL,1.e-9_pREAL)) then ! linear scale
Delta_t = loadCases(l)%t/real(loadCases(l)%N,pREAL)
else
Delta_t = loadCases(l)%t * (loadCases(l)%r**(inc-1)-loadCases(l)%r**inc) &
/ (1.0_pREAL-loadCases(l)%r**loadCases(l)%N)
end if
Delta_t = Delta_t * real(subStepFactor,pREAL)**real(-cutBackLevel,pREAL) ! depending on cut back level, decrease time step
skipping: if (totalIncsCounter <= CLI_restartInc) then ! not yet at restart inc?
t = t + Delta_t ! just advance time, skip already performed calculation
guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference
else skipping
stepFraction = 0 ! fraction scaled by stepFactor**cutLevel
subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel)
t_remaining = loadCases(l)%t + t_0 - t
t = t + Delta_t ! forward target time
stepFraction = stepFraction + 1 ! count step
!--------------------------------------------------------------------------------------------------
! report beginning of new step
print'(/,1x,a)', '###########################################################################'
print'(1x,a,1x,es12.5,6(a,i0))', &
'Time', t, &
's: Increment ', inc,'/',loadCases(l)%N,&
'-', stepFraction,'/',subStepFactor**cutBackLevel,&
' of load case ', l,'/',size(loadCases)
write(incInfo,'(4(a,i0))') &
'Increment ',totalIncsCounter,'/',sum(loadCases%N),&
'-', stepFraction,'/',subStepFactor**cutBackLevel
flush(IO_STDOUT)
!--------------------------------------------------------------------------------------------------
! forward fields
do field = 1, nActiveFields
select case(ID(field))
case(FIELD_MECH_ID)
call mechanical_forward (&
cutBack,guess,Delta_t,Delta_t_prev,t_remaining, &
deformation_BC = loadCases(l)%deformation, &
stress_BC = loadCases(l)%stress, &
rotation_BC = loadCases(l)%rot)
case(FIELD_THERMAL_ID); call grid_thermal_spectral_forward(cutBack)
case(FIELD_DAMAGE_ID); call grid_damage_spectral_forward(cutBack)
end select
end do
if (.not. cutBack) call materialpoint_forward
!--------------------------------------------------------------------------------------------------
! solve fields
stagIter = 0
stagIterate = .true.
do while (stagIterate)
do field = 1, nActiveFields
select case(ID(field))
case(FIELD_MECH_ID)
solres(field) = mechanical_solution(incInfo)
case(FIELD_THERMAL_ID)
solres(field) = grid_thermal_spectral_solution(Delta_t)
case(FIELD_DAMAGE_ID)
solres(field) = grid_damage_spectral_solution(Delta_t)
end select
if (.not. solres(field)%converged) exit ! no solution found
end do
stagIter = stagIter + 1
stagIterate = stagIter < stagItMax &
.and. all(solres(:)%converged) &
.and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration
end do
!--------------------------------------------------------------------------------------------------
! check solution and either advance or retry with smaller timestep
if ( (all(solres(:)%converged .and. solres(:)%stagConverged)) & ! converged
.and. .not. solres(1)%termIll) then ! and acceptable solution found
call mechanical_updateCoords()
Delta_t_prev = Delta_t
cutBack = .false.
guess = .true. ! start guessing after first converged (sub)inc
if (worldrank == 0) then
write(statUnit,*) totalIncsCounter, t, cutBackLevel, &
solres(1)%converged, solres(1)%iterationsNeeded
flush(statUnit)
end if
elseif (cutBackLevel < maxCutBack) then ! further cutbacking tolerated?
cutBack = .true.
stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1
t = t - Delta_t
Delta_t = Delta_t/real(subStepFactor,pREAL) ! cut timestep
print'(/,1x,a)', 'cutting back '
else ! no more options to continue
if (worldrank == 0) close(statUnit)
call IO_error(950)
end if
end do subStepLooping
cutBackLevel = max(0, cutBackLevel - 1) ! try half number of subincs next inc
if (all(solres(:)%converged)) then
print'(/,1x,a,1x,i0,1x,a)', 'increment', totalIncsCounter, 'converged'
else
print'(/,1x,a,1x,i0,1x,a)', 'increment', totalIncsCounter, 'NOT converged'
end if; flush(IO_STDOUT)
call MPI_Allreduce(signal_SIGUSR1,sig,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (mod(inc,loadCases(l)%f_out) == 0 .or. sig) then
print'(/,1x,a)', '... saving results ........................................................'
flush(IO_STDOUT)
call materialpoint_result(totalIncsCounter,t)
end if
if (sig) call signal_setSIGUSR1(.false.)
call MPI_Allreduce(signal_SIGUSR2,sig,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (mod(inc,loadCases(l)%f_restart) == 0 .or. sig) then
do field = 1, nActiveFields
select case (ID(field))
case(FIELD_MECH_ID)
call mechanical_restartWrite()
case(FIELD_THERMAL_ID)
call grid_thermal_spectral_restartWrite()
case(FIELD_DAMAGE_ID)
call grid_damage_spectral_restartWrite()
end select
end do
call materialpoint_restartWrite()
end if
if (sig) call signal_setSIGUSR2(.false.)
call MPI_Allreduce(signal_SIGINT,sig,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (sig) exit loadCaseLooping
end if skipping
end do incLooping
end do loadCaseLooping
!--------------------------------------------------------------------------------------------------
! report summary of whole calculation
print'(/,1x,a)', '###########################################################################'
if (worldrank == 0) close(statUnit)
call quit(0) ! no complains ;)
contains
subroutine getMaskedTensor(values,mask,tensor)
real(pREAL), intent(out), dimension(3,3) :: values
logical, intent(out), dimension(3,3) :: mask
type(tList), pointer :: tensor
type(tList), pointer :: row
integer :: i,j
values = 0.0_pREAL
do i = 1,3
row => tensor%get_list(i)
do j = 1,3
mask(i,j) = row%get_asStr(j) == 'x'
if (.not. mask(i,j)) values(i,j) = row%get_asReal(j)
end do
end do
end subroutine getMaskedTensor
end function parseLoadsteps
end program DAMASK_grid

14
src/grid/discretization_grid.f90
View File

@ -68,7 +68,7 @@ subroutine discretization_grid_init(restart)
j
integer(MPI_INTEGER_KIND) :: err_MPI
integer(C_INTPTR_T) :: &
devNull, z, z_offset
devNull, cells3_, cells3Offset_
integer, dimension(worldsize) :: &
displs, sendcounts
character(len=:), allocatable :: &
@ -89,7 +89,7 @@ subroutine discretization_grid_init(restart)
fname = CLI_geomFile
if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:)
call result_openJobFile(parallel=.false.)
call result_writeDataset_str(fileContent,'setup',fname,'geometry definition (grid solver)')
call result_addSetupFile(fileContent,fname,'geometry definition (grid solver)')
call result_closeJobFile()
else
allocate(materialAt_global(0)) ! needed for IntelMPI
@ -113,12 +113,12 @@ subroutine discretization_grid_init(restart)
call fftw_mpi_init()
devNull = fftw_mpi_local_size_3d(int(cells(3),C_INTPTR_T),int(cells(2),C_INTPTR_T),int(cells(1)/2+1,C_INTPTR_T), &
PETSC_COMM_WORLD, &
z, & ! domain cells size along z
z_offset) ! domain cells offset along z
if (z==0_C_INTPTR_T) call IO_error(894, ext_msg='Cannot distribute MPI processes')
cells3_, & ! domain cells size along z
cells3Offset_) ! domain cells offset along z
if (cells3_==0_C_INTPTR_T) call IO_error(894, ext_msg='Cannot distribute MPI processes')
cells3 = int(z)
cells3Offset = int(z_offset)
cells3 = int(cells3_)
cells3Offset = int(cells3Offset_)
size3 = geomSize(3)*real(cells3,pREAL) /real(cells(3),pREAL)
size3Offset = geomSize(3)*real(cells3Offset,pREAL)/real(cells(3),pREAL)
myGrid = [cells(1:2),cells3]

228
src/grid/grid_damage_spectral.f90
View File

@ -16,6 +16,7 @@ module grid_damage_spectral
use prec
use parallelization
use IO
use misc
use CLI
use HDF5_utilities
use HDF5
@ -47,9 +48,8 @@ module grid_damage_spectral
!--------------------------------------------------------------------------------------------------
! PETSc data
SNES :: SNES_damage
Vec :: solution_vec
Vec :: phi_PETSc
real(pREAL), dimension(:,:,:), allocatable :: &
phi, & !< field of current damage
phi_lastInc, & !< field of previous damage
phi_stagInc !< field of staggered damage
@ -68,24 +68,28 @@ module grid_damage_spectral
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields and fills them with data
!> @brief Allocate all necessary fields and fill them with data, potentially from restart file.
!--------------------------------------------------------------------------------------------------
subroutine grid_damage_spectral_init()
subroutine grid_damage_spectral_init(num_grid)
PetscInt, dimension(0:worldsize-1) :: localK
integer :: i, j, k, ce
DM :: damage_grid
real(pREAL), dimension(:,:,:), pointer :: phi_PETSc
type(tDict), pointer, intent(in) :: num_grid
integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global
DM :: DM_damage
real(pREAL), dimension(:,:,:), pointer :: phi ! 0-indexed
Vec :: uBound, lBound
integer(MPI_INTEGER_KIND) :: err_MPI
PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle
real(pREAL), dimension(1,product(cells(1:2))*cells3) :: tempN
type(tDict), pointer :: &
num_grid, &
num_generic
num_grid_damage
character(len=pSTRLEN) :: &
snes_type
character(len=:), allocatable :: &
extmsg, &
petsc_options
print'(/,1x,a)', '<<<+- grid_spectral_damage init -+>>>'
@ -96,32 +100,27 @@ subroutine grid_damage_spectral_init()
!-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks
num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
num%eps_damage_atol = num_grid%get_asReal ('eps_damage_atol',defaultVal=1.0e-2_pREAL)
num%eps_damage_rtol = num_grid%get_asReal ('eps_damage_rtol',defaultVal=1.0e-6_pREAL)
num_grid_damage => num_grid%get_dict('damage',defaultVal=emptyDict)
num_generic => config_numerics%get_dict('generic',defaultVal=emptyDict)
num%phi_min = num_generic%get_asReal('phi_min', defaultVal=1.0e-6_pREAL)
num%itmax = num_grid_damage%get_asInt ('N_iter_max', defaultVal=100)
num%eps_damage_atol = num_grid_damage%get_asReal('eps_abs_phi',defaultVal=1.0e-2_pREAL)
num%eps_damage_rtol = num_grid_damage%get_asReal('eps_rel_phi',defaultVal=1.0e-6_pREAL)
num%phi_min = num_grid_damage%get_asReal('phi_min', defaultVal=1.0e-6_pREAL)
if (num%phi_min < 0.0_pREAL) call IO_error(301,ext_msg='phi_min')
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax')
if (num%eps_damage_atol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_damage_atol')
if (num%eps_damage_rtol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_damage_rtol')
extmsg = ''
if (num%eps_damage_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_phi'
if (num%eps_damage_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_phi'
if (num%phi_min <= 0.0_pREAL) extmsg = trim(extmsg)//' phi_min'
if (num%itmax < 1) extmsg = trim(extmsg)//' N_iter_max'
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
!--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-damage_snes_type newtonls -damage_snes_mf &
&-damage_snes_ksp_ew -damage_ksp_type fgmres',err_PETSc)
CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
! init fields
phi = discretization_grid_getInitialCondition('phi')
phi_lastInc = phi
phi_stagInc = phi
petsc_options = misc_prefixOptions('-snes_type newtonls -snes_mf -snes_ksp_ew -ksp_type fgmres '// &
num_grid_damage%get_asStr('PETSc_options',defaultVal=''),'damage_')
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
@ -129,28 +128,27 @@ subroutine grid_damage_spectral_init()
CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_damage,'damage_',err_PETSc)
CHKERRQ(err_PETSc)
localK = 0_pPetscInt
localK(worldrank) = int(cells3,pPetscInt)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
call MPI_Allgather(int(cells3,MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3D(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), &
1_pPetscInt, 0_pPetscInt, & ! #dof (phi, scalar), ghost boundary width (domain overlap)
[int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells
damage_grid,err_PETSc) ! handle, error
int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
1_pPETSCINT, 0_pPETSCINT, & ! #dof (phi, scalar), ghost boundary width (domain overlap)
[int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],int(cells3_global,pPETSCINT), & ! local cells
DM_damage,err_PETSc) ! handle, error
CHKERRQ(err_PETSc)
call DMsetFromOptions(damage_grid,err_PETSc)
call DMsetFromOptions(DM_damage,err_PETSc)
CHKERRQ(err_PETSc)
call DMsetUp(damage_grid,err_PETSc)
call DMsetUp(DM_damage,err_PETSc)
CHKERRQ(err_PETSc)
call DMCreateGlobalVector(damage_grid,solution_vec,err_PETSc) ! global solution vector (cells x 1, i.e. every def grad tensor)
call DMCreateGlobalVector(DM_damage,phi_PETSc,err_PETSc) ! global solution vector (cells x 1, i.e. every def grad tensor)
CHKERRQ(err_PETSc)
call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,formResidual,PETSC_NULL_SNES,err_PETSc) ! residual vector of same shape as solution vector
call DMDASNESSetFunctionLocal(DM_damage,INSERT_VALUES,formResidual,PETSC_NULL_SNES,err_PETSc) ! residual vector of same shape as solution vector
CHKERRQ(err_PETSc)
call SNESSetDM(SNES_damage,damage_grid,err_PETSc)
call SNESSetDM(SNES_damage,DM_damage,err_PETSc)
CHKERRQ(err_PETSc)
call SNESSetFromOptions(SNES_damage,err_PETSc) ! pull it all together with additional CLI arguments
CHKERRQ(err_PETSc)
@ -158,9 +156,9 @@ subroutine grid_damage_spectral_init()
CHKERRQ(err_PETSc)
if (trim(snes_type) == 'vinewtonrsls' .or. &
trim(snes_type) == 'vinewtonssls') then
call DMGetGlobalVector(damage_grid,lBound,err_PETSc)
call DMGetGlobalVector(DM_damage,lBound,err_PETSc)
CHKERRQ(err_PETSc)
call DMGetGlobalVector(damage_grid,uBound,err_PETSc)
call DMGetGlobalVector(DM_damage,uBound,err_PETSc)
CHKERRQ(err_PETSc)
call VecSet(lBound,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
@ -168,12 +166,15 @@ subroutine grid_damage_spectral_init()
CHKERRQ(err_PETSc)
call SNESVISetVariableBounds(SNES_damage,lBound,uBound,err_PETSc) ! variable bounds for variational inequalities
CHKERRQ(err_PETSc)
call DMRestoreGlobalVector(damage_grid,lBound,err_PETSc)
call DMRestoreGlobalVector(DM_damage,lBound,err_PETSc)
CHKERRQ(err_PETSc)
call DMRestoreGlobalVector(damage_grid,uBound,err_PETSc)
call DMRestoreGlobalVector(DM_damage,uBound,err_PETSc)
CHKERRQ(err_PETSc)
end if
call DMDAVecGetArrayF90(DM_damage,phi_PETSc,phi,err_PETSc) ! returns 0-indexed phi
CHKERRQ(err_PETSc)
restartRead: if (CLI_restartInc > 0) then
print'(/,1x,a,1x,i0)', 'loading restart data of increment', CLI_restartInc
@ -184,18 +185,16 @@ subroutine grid_damage_spectral_init()
phi = reshape(tempN,[cells(1),cells(2),cells3])
call HDF5_read(tempN,groupHandle,'phi_lastInc',.false.)
phi_lastInc = reshape(tempN,[cells(1),cells(2),cells3])
phi_stagInc = phi_lastInc
else
phi = discretization_grid_getInitialCondition('phi')
phi_lastInc = phi(0:,0:,0:)
phi_stagInc = phi_lastInc
end if restartRead
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1, cells(1)
ce = ce + 1
call homogenization_set_phi(phi(i,j,k),ce)
end do; end do; end do
call homogenization_set_phi(reshape(phi,[product(cells(1:2))*cells3]))
call DMDAVecGetArrayF90(damage_grid,solution_vec,phi_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
phi_PETSc = phi
call DMDAVecRestoreArrayF90(damage_grid,solution_vec,phi_PETSc,err_PETSc)
call DMDAVecRestoreArrayF90(DM_damage,phi_PETSc,phi,err_PETSc)
CHKERRQ(err_PETSc)
call updateReference()
@ -210,53 +209,49 @@ function grid_damage_spectral_solution(Delta_t) result(solution)
real(pREAL), intent(in) :: &
Delta_t !< increment in time for current solution
integer :: i, j, k, ce
type(tSolutionState) :: solution
PetscInt :: devNull
PetscReal :: phi_min, phi_max, stagNorm
DM :: DM_damage
real(pREAL), dimension(:,:,:), pointer :: phi ! 0-indexed
integer(MPI_INTEGER_KIND) :: err_MPI
PetscErrorCode :: err_PETSc
SNESConvergedReason :: reason
solution%converged = .false.
!--------------------------------------------------------------------------------------------------
! set module wide availabe data
params%Delta_t = Delta_t
call SNESSolve(SNES_damage,PETSC_NULL_VEC,solution_vec,err_PETSc)
call SNESSolve(SNES_damage,PETSC_NULL_VEC,phi_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
call SNESGetConvergedReason(SNES_damage,reason,err_PETSc)
CHKERRQ(err_PETSc)
if (reason < 1) then
solution%converged = .false.
solution%iterationsNeeded = num%itmax
else
solution%converged = .true.
solution%iterationsNeeded = totalIter
end if
solution%converged = reason > 0
solution%iterationsNeeded = merge(totalIter,num%itmax,solution%converged)
call SNESGetDM(SNES_damage,DM_damage,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(DM_damage,phi_PETSc,phi,err_PETSc) ! returns 0-indexed phi
CHKERRQ(err_PETSc)
phi_min = minval(phi)
phi_max = maxval(phi)
stagNorm = maxval(abs(phi - phi_stagInc))
call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_MAX,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
solution%stagConverged = stagNorm < max(num%eps_damage_atol, num%eps_damage_rtol*maxval(phi))
solution%stagConverged = stagNorm < max(num%eps_damage_atol, num%eps_damage_rtol*phi_max)
call MPI_Allreduce(MPI_IN_PLACE,solution%stagConverged,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LAND,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
phi_stagInc = phi
!--------------------------------------------------------------------------------------------------
! updating damage state
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
call homogenization_set_phi(phi(i,j,k),ce)
end do; end do; end do
call homogenization_set_phi(reshape(phi,[product(cells(1:2))*cells3]))
call VecMin(solution_vec,devNull,phi_min,err_PETSc)
CHKERRQ(err_PETSc)
call VecMax(solution_vec,devNull,phi_max,err_PETSc)
call DMDAVecRestoreArrayF90(DM_damage,phi_PETSc,phi,err_PETSc)
CHKERRQ(err_PETSc)
if (solution%converged) &
print'(/,1x,a)', '... nonlocal damage converged .....................................'
print'(/,1x,a,f8.6,2x,f8.6,2x,e11.4)', 'Minimum|Maximum|Delta Damage = ', phi_min, phi_max, stagNorm
@ -267,35 +262,26 @@ end function grid_damage_spectral_solution
!--------------------------------------------------------------------------------------------------
!> @brief spectral damage forwarding routine
!> @brief Set DAMASK data to current solver status.
!--------------------------------------------------------------------------------------------------
subroutine grid_damage_spectral_forward(cutBack)
logical, intent(in) :: cutBack
integer :: i, j, k, ce
DM :: dm_local
real(pREAL), dimension(:,:,:), pointer :: phi_PETSc
DM :: DM_damage
real(pREAL), dimension(:,:,:), pointer :: phi ! 0-indexed
PetscErrorCode :: err_PETSc
call SNESGetDM(SNES_damage,DM_damage,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(DM_damage,phi_PETSc,phi,err_PETSc) ! returns 0-indexed T
CHKERRQ(err_PETSc)
if (cutBack) then
call homogenization_set_phi(reshape(phi_lastInc,[product(cells(1:2))*cells3]))
phi = phi_lastInc
phi_stagInc = phi_lastInc
!--------------------------------------------------------------------------------------------------
! reverting damage field state
call SNESGetDM(SNES_damage,dm_local,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(dm_local,solution_vec,phi_PETSc,err_PETSc) !< get the data out of PETSc to work with
CHKERRQ(err_PETSc)
phi_PETSc = phi
call DMDAVecRestoreArrayF90(dm_local,solution_vec,phi_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
call homogenization_set_phi(phi(i,j,k),ce)
end do; end do; end do
else
phi_lastInc = phi
call updateReference()
@ -307,16 +293,17 @@ end subroutine grid_damage_spectral_forward
!--------------------------------------------------------------------------------------------------
!> @brief Write current solver and constitutive data for restart to file.
!--------------------------------------------------------------------------------------------------
subroutine grid_damage_spectral_restartWrite
subroutine grid_damage_spectral_restartWrite()
PetscErrorCode :: err_PETSc
DM :: dm_local
DM :: DM_damage
integer(HID_T) :: fileHandle, groupHandle
PetscScalar, dimension(:,:,:), pointer :: phi
real(pREAL), dimension(:,:,:), pointer :: phi ! 0-indexed
call SNESGetDM(SNES_damage,dm_local,err_PETSc);
call SNESGetDM(SNES_damage,DM_damage,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(dm_local,solution_vec,phi,err_PETSc);
call DMDAVecGetArrayReadF90(DM_damage,phi_PETSc,phi,err_PETSc) ! returns 0-indexed T
CHKERRQ(err_PETSc)
print'(1x,a)', 'saving damage solver data required for restart'; flush(IO_STDOUT)
@ -328,7 +315,7 @@ subroutine grid_damage_spectral_restartWrite
call HDF5_closeGroup(groupHandle)
call HDF5_closeFile(fileHandle)
call DMDAVecRestoreArrayF90(dm_local,solution_vec,phi,err_PETSc);
call DMDAVecRestoreArrayReadF90(DM_damage,phi_PETSc,phi,err_PETSc);
CHKERRQ(err_PETSc)
end subroutine grid_damage_spectral_restartWrite
@ -352,24 +339,25 @@ subroutine formResidual(residual_subdomain,x_scal,r,dummy,err_PETSc)
real(pREAL), dimension(3,cells(1),cells(2),cells3) :: vectorField
phi = x_scal
vectorField = utilities_ScalarGradient(phi)
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
vectorField(1:3,i,j,k) = matmul(homogenization_K_phi(ce) - K_ref, vectorField(1:3,i,j,k))
end do; end do; end do
r = utilities_VectorDivergence(vectorField)
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
r(i,j,k) = params%Delta_t*(r(i,j,k) + homogenization_f_phi(phi(i,j,k),ce)) &
+ homogenization_mu_phi(ce)*(phi_lastInc(i,j,k) - phi(i,j,k)) &
+ mu_ref*phi(i,j,k)
end do; end do; end do
associate(phi => x_scal)
vectorField = utilities_ScalarGradient(phi)
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
vectorField(1:3,i,j,k) = matmul(homogenization_K_phi(ce) - K_ref, vectorField(1:3,i,j,k))
end do; end do; end do
r = utilities_VectorDivergence(vectorField)
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
r(i,j,k) = params%Delta_t*(r(i,j,k) + homogenization_f_phi(phi(i,j,k),ce)) &
+ homogenization_mu_phi(ce)*(phi_lastInc(i,j,k) - phi(i,j,k)) &
+ mu_ref*phi(i,j,k)
end do; end do; end do
r = max(min(utilities_GreenConvolution(r, K_ref, mu_ref, params%Delta_t),phi_lastInc),num%phi_min) &
- phi
r = max(min(utilities_GreenConvolution(r, K_ref, mu_ref, params%Delta_t),phi_lastInc),num%phi_min) &
- phi
end associate
err_PETSc = 0
end subroutine formResidual

167
src/grid/grid_mech_FEM.f90
View File

@ -15,8 +15,9 @@ module grid_mechanical_FEM
use prec
use parallelization
use CLI
use IO
use misc
use CLI
use HDF5
use HDF5_utilities
use math
@ -52,9 +53,9 @@ module grid_mechanical_FEM
!--------------------------------------------------------------------------------------------------
! PETSc data
DM :: mechanical_grid
SNES :: SNES_mechanical
Vec :: solution_current, solution_lastInc, solution_rate
DM :: DM_mech
SNES :: SNES_mech
Vec :: u_PETSc, u_lastInc_PETSc, uDot_PETSc
!--------------------------------------------------------------------------------------------------
! common pointwise data
@ -94,9 +95,11 @@ module grid_mechanical_FEM
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
!> @brief Allocate all necessary fields and fill them with data, potentially from restart info.
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_FEM_init
subroutine grid_mechanical_FEM_init(num_grid)
type(tDict), pointer, intent(in) :: num_grid
real(pREAL), parameter :: HGCoeff = 0.0e-2_pREAL
real(pREAL), parameter, dimension(4,8) :: &
@ -115,44 +118,44 @@ subroutine grid_mechanical_FEM_init
integer(MPI_INTEGER_KIND) :: err_MPI
PetscScalar, pointer, dimension(:,:,:,:) :: &
u,u_lastInc
PetscInt, dimension(0:worldsize-1) :: localK
integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global
integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: &
num_grid
character(len=pSTRLEN) :: &
extmsg = ''
num_grid_mech
character(len=:), allocatable :: &
extmsg, &
petsc_options
print'(/,1x,a)', '<<<+- grid_mechanical_FEM init -+>>>'; flush(IO_STDOUT)
!-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks
num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
num_grid_mech => num_grid%get_dict('mechanical',defaultVal=emptyDict)
num%eps_div_atol = num_grid%get_asReal('eps_div_atol', defaultVal=1.0e-4_pREAL)
num%eps_div_rtol = num_grid%get_asReal('eps_div_rtol', defaultVal=5.0e-4_pREAL)
num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL)
num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL)
num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
num%itmin = num_grid_mech%get_asInt('N_iter_min',defaultVal=1)
num%itmax = num_grid_mech%get_asInt('N_iter_max',defaultVal=100)
num%eps_div_atol = num_grid_mech%get_asReal('eps_abs_div(P)',defaultVal=1.0e-4_pREAL)
num%eps_div_rtol = num_grid_mech%get_asReal('eps_rel_div(P)',defaultVal=5.0e-4_pREAL)
num%eps_stress_atol = num_grid_mech%get_asReal('eps_abs_P', defaultVal=1.0e3_pREAL)
num%eps_stress_rtol = num_grid_mech%get_asReal('eps_rel_P', defaultVal=1.0e-3_pREAL)
if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_atol'
if (num%eps_div_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_rtol'
if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_atol'
if (num%eps_stress_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_rtol'
if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin'
extmsg = ''
if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_div(P)'
if (num%eps_div_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_div(P)'
if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_P'
if (num%eps_stress_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_P'
if (num%itmax < 1) extmsg = trim(extmsg)//' N_iter_max'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' N_iter_min'
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
!--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS, &
'-mechanical_snes_type newtonls -mechanical_ksp_type fgmres &
&-mechanical_ksp_max_it 25', &
err_PETSc)
CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
petsc_options = misc_prefixOptions('-snes_type newtonls -ksp_type fgmres -ksp_max_it 25 '// &
num_grid_mech%get_asStr('PETSc_options',defaultVal='') ,'mechanical_')
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
@ -163,59 +166,58 @@ subroutine grid_mechanical_FEM_init
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,SNES_mechanical,err_PETSc)
call SNESCreate(PETSC_COMM_WORLD,SNES_mech,err_PETSc)
CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc)
call SNESSetOptionsPrefix(SNES_mech,'mechanical_',err_PETSc)
CHKERRQ(err_PETSc)
localK = 0_pPetscInt
localK(worldrank) = int(cells3,pPetscInt)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
call MPI_Allgather(int(cells3,MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, &
DMDA_STENCIL_BOX, &
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), &
3_pPetscInt, 1_pPetscInt, & ! #dof (u, vector), ghost boundary width (domain overlap)
[int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells
mechanical_grid,err_PETSc)
int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
3_pPETSCINT, 1_pPETSCINT, & ! #dof (u, vector), ghost boundary width (domain overlap)
[int(cells(1),pPETSCINT)],[int(cells(2),pPETSCINT)],int(cells3_global,pPETSCINT), & ! local cells
DM_mech,err_PETSc)
CHKERRQ(err_PETSc)
call DMsetFromOptions(mechanical_grid,err_PETSc)
call DMsetFromOptions(DM_mech,err_PETSc)
CHKERRQ(err_PETSc)
call DMsetUp(mechanical_grid,err_PETSc)
call DMsetUp(DM_mech,err_PETSc)
CHKERRQ(err_PETSc)
call DMDASetUniformCoordinates(mechanical_grid,0.0_pREAL,geomSize(1),0.0_pREAL,geomSize(2),0.0_pREAL,geomSize(3),err_PETSc)
call DMDASetUniformCoordinates(DM_mech,0.0_pREAL,geomSize(1),0.0_pREAL,geomSize(2),0.0_pREAL,geomSize(3),err_PETSc)
CHKERRQ(err_PETSc)
call DMCreateGlobalVector(mechanical_grid,solution_current,err_PETSc)
call DMCreateGlobalVector(DM_mech,u_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
call DMCreateGlobalVector(mechanical_grid,solution_lastInc,err_PETSc)
call DMCreateGlobalVector(DM_mech,u_lastInc_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
call DMCreateGlobalVector(mechanical_grid,solution_rate ,err_PETSc)
call DMCreateGlobalVector(DM_mech,uDot_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
call DMSNESSetFunctionLocal(mechanical_grid,formResidual,PETSC_NULL_SNES,err_PETSc)
call DMSNESSetFunctionLocal(DM_mech,formResidual,PETSC_NULL_SNES,err_PETSc)
CHKERRQ(err_PETSc)
call DMSNESSetJacobianLocal(mechanical_grid,formJacobian,PETSC_NULL_SNES,err_PETSc)
call DMSNESSetJacobianLocal(DM_mech,formJacobian,PETSC_NULL_SNES,err_PETSc)
CHKERRQ(err_PETSc)
call SNESSetConvergenceTest(SNES_mechanical,converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,err_PETSc) ! specify custom convergence check function "_converged"
call SNESSetConvergenceTest(SNES_mech,converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,err_PETSc) ! specify custom convergence check function "_converged"
CHKERRQ(err_PETSc)
call SNESSetMaxLinearSolveFailures(SNES_mechanical, huge(1_pPetscInt), err_PETSc) ! ignore linear solve failures
call SNESSetMaxLinearSolveFailures(SNES_mech, huge(1_pPETSCINT), err_PETSc) ! ignore linear solve failures
CHKERRQ(err_PETSc)
call SNESSetDM(SNES_mechanical,mechanical_grid,err_PETSc)
call SNESSetDM(SNES_mech,DM_mech,err_PETSc)
CHKERRQ(err_PETSc)
call SNESSetFromOptions(SNES_mechanical,err_PETSc) ! pull it all together with additional cli arguments
call SNESSetFromOptions(SNES_mech,err_PETSc) ! pull it all together with additional cli arguments
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
! init fields
call VecSet(solution_current,0.0_pREAL,err_PETSc)
call VecSet(u_PETSc,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
call VecSet(solution_lastInc,0.0_pREAL,err_PETSc)
call VecSet(u_lastInc_PETSc,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
call VecSet(solution_rate ,0.0_pREAL,err_PETSc)
call VecSet(uDot_PETSc ,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(mechanical_grid,solution_current,u,err_PETSc)
call DMDAVecGetArrayF90(DM_mech,u_PETSc,u,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc)
call DMDAVecGetArrayF90(DM_mech,u_lastInc_PETSc,u_lastInc,err_PETSc)
CHKERRQ(err_PETSc)
delta = geomSize/real(cells,pREAL) ! grid spacing
@ -272,9 +274,9 @@ subroutine grid_mechanical_FEM_init
call utilities_constitutiveResponse(P_current,P_av,C_volAvg,devNull, & ! stress field, stress avg, global average of stiffness and (min+max)/2
F, & ! target F
0.0_pREAL) ! time increment
call DMDAVecRestoreArrayF90(mechanical_grid,solution_current,u,err_PETSc)
call DMDAVecRestoreArrayF90(DM_mech,u_PETSc,u,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecRestoreArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc)
call DMDAVecRestoreArrayF90(DM_mech,u_lastInc_PETSc,u_lastInc,err_PETSc)
CHKERRQ(err_PETSc)
restartRead2: if (CLI_restartInc > 0) then
@ -316,9 +318,9 @@ function grid_mechanical_FEM_solution(incInfoIn) result(solution)
! update stiffness (and gamma operator)
S = utilities_maskedCompliance(params%rotation_BC,params%stress_mask,C_volAvg)
call SNESsolve(SNES_mechanical,PETSC_NULL_VEC,solution_current,err_PETSc)
call SNESsolve(SNES_mech,PETSC_NULL_VEC,u_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
call SNESGetConvergedReason(SNES_mechanical,reason,err_PETSc)
call SNESGetConvergedReason(SNES_mech,reason,err_PETSc)
CHKERRQ(err_PETSc)
solution%converged = reason > 0
@ -351,15 +353,8 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai
rotation_BC
PetscErrorCode :: err_PETSc
PetscScalar, pointer, dimension(:,:,:,:) :: &
u,u_lastInc
call DMDAVecGetArrayF90(mechanical_grid,solution_current,u,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc)
CHKERRQ(err_PETSc)
if (cutBack) then
C_volAvg = C_volAvgLastInc
else
@ -382,15 +377,15 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai
end if
if (guess) then
call VecWAXPY(solution_rate,-1.0_pREAL,solution_lastInc,solution_current,err_PETSc)
call VecWAXPY(uDot_PETSc,-1.0_pREAL,u_lastInc_PETSc,u_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
call VecScale(solution_rate,1.0_pREAL/Delta_t_old,err_PETSc)
call VecScale(uDot_PETSc,1.0_pREAL/Delta_t_old,err_PETSc)
CHKERRQ(err_PETSc)
else
call VecSet(solution_rate,0.0_pREAL,err_PETSc)
call VecSet(uDot_PETSc,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
end if
call VecCopy(solution_current,solution_lastInc,err_PETSc)
call VecCopy(u_PETSc,u_lastInc_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
F_lastInc = F
@ -406,11 +401,7 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai
if (stress_BC%myType=='dot_P') P_aim = P_aim &
+ merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t
call VecAXPY(solution_current,Delta_t,solution_rate,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecRestoreArrayF90(mechanical_grid,solution_current,u,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecRestoreArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc)
call VecAXPY(u_PETSc,Delta_t,uDot_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
@ -425,7 +416,7 @@ end subroutine grid_mechanical_FEM_forward
!--------------------------------------------------------------------------------------------------
!> @brief Update coordinates
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_FEM_updateCoords
subroutine grid_mechanical_FEM_updateCoords()
call utilities_updateCoords(F)
@ -435,16 +426,16 @@ end subroutine grid_mechanical_FEM_updateCoords
!--------------------------------------------------------------------------------------------------
!> @brief Write current solver and constitutive data for restart to file
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_FEM_restartWrite
subroutine grid_mechanical_FEM_restartWrite()
PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle
PetscScalar, dimension(:,:,:,:), pointer :: u,u_lastInc
call DMDAVecGetArrayF90(mechanical_grid,solution_current,u,err_PETSc)
call DMDAVecGetArrayReadF90(DM_mech,u_PETSc,u,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc)
call DMDAVecGetArrayReadF90(DM_mech,u_lastInc_PETSc,u_lastInc,err_PETSc)
CHKERRQ(err_PETSc)
print'(1x,a)', 'saving solver data required for restart'; flush(IO_STDOUT)
@ -471,9 +462,9 @@ subroutine grid_mechanical_FEM_restartWrite
call HDF5_closeFile(fileHandle)
end if
call DMDAVecRestoreArrayF90(mechanical_grid,solution_current,u,err_PETSc)
call DMDAVecRestoreArrayReadF90(DM_mech,u_PETSc,u,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecRestoreArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc)
call DMDAVecRestoreArrayReadF90(DM_mech,u_lastInc_PETSc,u_lastInc,err_PETSc)
CHKERRQ(err_PETSc)
end subroutine grid_mechanical_FEM_restartWrite
@ -543,9 +534,9 @@ subroutine formResidual(da_local,x_local, &
integer(MPI_INTEGER_KIND) :: err_MPI
real(pREAL), dimension(3,3,3,3) :: devNull
call SNESGetNumberFunctionEvals(SNES_mechanical,nfuncs,err_PETSc)
call SNESGetNumberFunctionEvals(SNES_mech,nfuncs,err_PETSc)
CHKERRQ(err_PETSc)
call SNESGetIterationNumber(SNES_mechanical,PETScIter,err_PETSc)
call SNESGetIterationNumber(SNES_mech,PETScIter,err_PETSc)
CHKERRQ(err_PETSc)
@ -566,7 +557,7 @@ subroutine formResidual(da_local,x_local, &
!--------------------------------------------------------------------------------------------------
! get deformation gradient
call DMDAVecGetArrayF90(da_local,x_local,x_scal,err_PETSc)
call DMDAVecGetArrayReadF90(da_local,x_local,x_scal,err_PETSc)
CHKERRQ(err_PETSc)
do k = cells3Offset+1, cells3Offset+cells3; do j = 1, cells(2); do i = 1, cells(1)
ctr = 0
@ -576,7 +567,7 @@ subroutine formResidual(da_local,x_local, &
end do; end do; end do
F(1:3,1:3,i,j,k-cells3Offset) = params%rotation_BC%rotate(F_aim,active=.true.) + transpose(matmul(BMat,x_elem))
end do; end do; end do
call DMDAVecRestoreArrayF90(da_local,x_local,x_scal,err_PETSc)
call DMDAVecRestoreArrayReadF90(da_local,x_local,x_scal,err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
@ -596,7 +587,7 @@ subroutine formResidual(da_local,x_local, &
! constructing residual
call DMDAVecGetArrayF90(da_local,f_local,r,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(da_local,x_local,x_scal,err_PETSc)
call DMDAVecGetArrayReadF90(da_local,x_local,x_scal,err_PETSc)
CHKERRQ(err_PETSc)
ele = 0
r = 0.0_pREAL
@ -617,7 +608,7 @@ subroutine formResidual(da_local,x_local, &
r(0:2,i+ii,j+jj,k+kk) = r(0:2,i+ii,j+jj,k+kk) + f_elem(ctr,1:3)
end do; end do; end do
end do; end do; end do
call DMDAVecRestoreArrayF90(da_local,x_local,x_scal,err_PETSc)
call DMDAVecRestoreArrayReadF90(da_local,x_local,x_scal,err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------

135
src/grid/grid_mech_spectral_basic.f90
View File

@ -16,13 +16,13 @@ module grid_mechanical_spectral_basic
use prec
use parallelization
use CLI
use misc
use IO
use HDF5
use HDF5_utilities
use math
use rotations
use spectral_utilities
use config
use homogenization
use discretization_grid
@ -51,9 +51,9 @@ module grid_mechanical_spectral_basic
!--------------------------------------------------------------------------------------------------
! PETSc data
DM :: da
SNES :: SNES_mechanical
Vec :: solution_vec
DM :: DM_mech
SNES :: SNES_mech
Vec :: F_PETSc
!--------------------------------------------------------------------------------------------------
! common pointwise data
@ -82,12 +82,6 @@ module grid_mechanical_spectral_basic
err_BC, & !< deviation from stress BC
err_div !< RMS of div of P
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY)
type(MPI_Status) :: status
#else
integer, dimension(MPI_STATUS_SIZE) :: status
#endif
integer :: &
totalIter = 0 !< total iteration in current increment
@ -101,22 +95,26 @@ module grid_mechanical_spectral_basic
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
!> @brief Allocate all necessary fields and fill them with data, potentially from restart info.
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_spectral_basic_init()
subroutine grid_mechanical_spectral_basic_init(num_grid)
type(tDict), pointer, intent(in) :: num_grid
real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: P
PetscErrorCode :: err_PETSc
integer(MPI_INTEGER_KIND) :: err_MPI
real(pREAL), pointer, dimension(:,:,:,:) :: &
F ! pointer to solution data
PetscInt, dimension(0:worldsize-1) :: localK
integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global
real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: &
num_grid
character(len=pSTRLEN) :: &
extmsg = ''
num_grid_fft, &
num_grid_mech
character(len=:), allocatable :: &
extmsg, &
petsc_options
print'(/,1x,a)', '<<<+- grid_mechanical_spectral_basic init -+>>>'; flush(IO_STDOUT)
@ -129,30 +127,32 @@ subroutine grid_mechanical_spectral_basic_init()
!-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks
num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
num_grid_fft => num_grid%get_dict('FFT',defaultVal=emptyDict)
num_grid_mech => num_grid%get_dict('mechanical',defaultVal=emptyDict)
num%update_gamma = num_grid%get_asBool('update_gamma', defaultVal=.false.)
num%eps_div_atol = num_grid%get_asReal('eps_div_atol', defaultVal=1.0e-4_pREAL)
num%eps_div_rtol = num_grid%get_asReal('eps_div_rtol', defaultVal=5.0e-4_pREAL)
num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL)
num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL)
num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
num%itmin = num_grid_mech%get_asInt('N_iter_min',defaultVal=1)
num%itmax = num_grid_mech%get_asInt('N_iter_max',defaultVal=100)
num%update_gamma = num_grid_mech%get_asBool('update_gamma',defaultVal=.false.)
num%eps_div_atol = num_grid_mech%get_asReal('eps_abs_div(P)', defaultVal=1.0e-4_pREAL)
num%eps_div_rtol = num_grid_mech%get_asReal('eps_rel_div(P)', defaultVal=5.0e-4_pREAL)
num%eps_stress_atol = num_grid_mech%get_asReal('eps_abs_P', defaultVal=1.0e3_pREAL)
num%eps_stress_rtol = num_grid_mech%get_asReal('eps_rel_P', defaultVal=1.0e-3_pREAL)
if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_atol'
if (num%eps_div_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_rtol'
if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_atol'
if (num%eps_stress_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_rtol'
if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin'
extmsg = ''
if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_div(P)'
if (num%eps_div_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_div(P)'
if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_P'
if (num%eps_stress_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_P'
if (num%itmax < 1) extmsg = trim(extmsg)//' N_iter_max'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' N_iter_min'
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
!--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',err_PETSc)
CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
petsc_options = misc_prefixOptions('-snes_type ngmres '//num_grid_mech%get_asStr('PETSc_options',defaultVal=''), &
'mechanical_')
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
@ -162,41 +162,40 @@ subroutine grid_mechanical_spectral_basic_init()
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,SNES_mechanical,err_PETSc)
call SNESCreate(PETSC_COMM_WORLD,SNES_mech,err_PETSc)
CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc)
call SNESSetOptionsPrefix(SNES_mech,'mechanical_',err_PETSc)
CHKERRQ(err_PETSc)
localK = 0_pPetscInt
localK(worldrank) = int(cells3,pPetscInt)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
call MPI_Allgather(int(cells3,MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), &
9_pPetscInt, 0_pPetscInt, & ! #dof (F, tensor), ghost boundary width (domain overlap)
[int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells
da,err_PETSc) ! handle, error
int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
9_pPETSCINT, 0_pPETSCINT, & ! #dof (F, tensor), ghost boundary width (domain overlap)
[int(cells(1),pPETSCINT)],[int(cells(2),pPETSCINT)],int(cells3_global,pPETSCINT), & ! local cells
DM_mech,err_PETSc) ! handle, error
CHKERRQ(err_PETSc)
call DMsetFromOptions(da,err_PETSc)
call DMsetFromOptions(DM_mech,err_PETSc)
CHKERRQ(err_PETSc)
call DMsetUp(da,err_PETSc)
call DMsetUp(DM_mech,err_PETSc)
CHKERRQ(err_PETSc)
call DMcreateGlobalVector(da,solution_vec,err_PETSc) ! global solution vector (cells x 9, i.e. every def grad tensor)
call DMcreateGlobalVector(DM_mech,F_PETSc,err_PETSc) ! global solution vector (cells x 9, i.e. every def grad tensor)
CHKERRQ(err_PETSc)
call DMDASNESsetFunctionLocal(da,INSERT_VALUES,formResidual,PETSC_NULL_SNES,err_PETSc) ! residual vector of same shape as solution vector
call DMDASNESsetFunctionLocal(DM_mech,INSERT_VALUES,formResidual,PETSC_NULL_SNES,err_PETSc) ! residual vector of same shape as solution vector
CHKERRQ(err_PETSc)
call SNESsetConvergenceTest(SNES_mechanical,converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,err_PETSc) ! specify custom convergence check function "converged"
call SNESsetConvergenceTest(SNES_mech,converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,err_PETSc) ! specify custom convergence check function "converged"
CHKERRQ(err_PETSc)
call SNESSetDM(SNES_mechanical,da,err_PETSc)
call SNESSetDM(SNES_mech,DM_mech,err_PETSc)
CHKERRQ(err_PETSc)
call SNESsetFromOptions(SNES_mechanical,err_PETSc) ! pull it all together with additional CLI arguments
call SNESsetFromOptions(SNES_mech,err_PETSc) ! pull it all together with additional CLI arguments
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
! init fields
call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc) ! places pointer on PETSc data
call DMDAVecGetArrayF90(DM_mech,F_PETSc,F,err_PETSc) ! places pointer on PETSc data
CHKERRQ(err_PETSc)
restartRead: if (CLI_restartInc > 0) then
@ -232,7 +231,7 @@ subroutine grid_mechanical_spectral_basic_init()
call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2
reshape(F,shape(F_lastInc)), & ! target F
0.0_pREAL) ! time increment
call DMDAVecRestoreArrayF90(da,solution_vec,F,err_PETSc) ! deassociate pointer
call DMDAVecRestoreArrayF90(DM_mech,F_PETSc,F,err_PETSc) ! deassociate pointer
CHKERRQ(err_PETSc)
restartRead2: if (CLI_restartInc > 0) then
@ -281,9 +280,9 @@ function grid_mechanical_spectral_basic_solution(incInfoIn) result(solution)
S = utilities_maskedCompliance(params%rotation_BC,params%stress_mask,C_volAvg)
if (num%update_gamma) call utilities_updateGamma(C_minMaxAvg)
call SNESsolve(SNES_mechanical,PETSC_NULL_VEC,solution_vec,err_PETSc)
call SNESsolve(SNES_mech,PETSC_NULL_VEC,F_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
call SNESGetConvergedReason(SNES_mechanical,reason,err_PETSc)
call SNESGetConvergedReason(SNES_mech,reason,err_PETSc)
CHKERRQ(err_PETSc)
solution%converged = reason > 0
@ -318,7 +317,7 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
real(pREAL), pointer, dimension(:,:,:,:) :: F
call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc)
call DMDAVecGetArrayF90(DM_mech,F_PETSc,F,err_PETSc)
CHKERRQ(err_PETSc)
if (cutBack) then
@ -360,9 +359,9 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
if (stress_BC%myType=='dot_P') P_aim = P_aim &
+ merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t
F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, & ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
F = reshape(utilities_forwardTensorField(Delta_t,F_lastInc,Fdot, & ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
rotation_BC%rotate(F_aim,active=.true.)),[9,cells(1),cells(2),cells3])
call DMDAVecRestoreArrayF90(da,solution_vec,F,err_PETSc)
call DMDAVecRestoreArrayF90(DM_mech,F_PETSc,F,err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
@ -375,32 +374,32 @@ end subroutine grid_mechanical_spectral_basic_forward
!--------------------------------------------------------------------------------------------------
!> @brief Update coordinates
!> @brief Update coordinates.
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_spectral_basic_updateCoords
subroutine grid_mechanical_spectral_basic_updateCoords()
PetscErrorCode :: err_PETSc
real(pREAL), dimension(:,:,:,:), pointer :: F
call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc)
call DMDAVecGetArrayReadF90(DM_mech,F_PETSc,F,err_PETSc)
CHKERRQ(err_PETSc)
call utilities_updateCoords(F)
call DMDAVecRestoreArrayF90(da,solution_vec,F,err_PETSc)
call utilities_updateCoords(reshape(F,[3,3,size(F,2),size(F,3),size(F,4)]))
call DMDAVecRestoreArrayReadF90(DM_mech,F_PETSc,F,err_PETSc)
CHKERRQ(err_PETSc)
end subroutine grid_mechanical_spectral_basic_updateCoords
!--------------------------------------------------------------------------------------------------
!> @brief Write current solver and constitutive data for restart to file
!> @brief Write current solver and constitutive data for restart to file.
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_spectral_basic_restartWrite
subroutine grid_mechanical_spectral_basic_restartWrite()
PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle
real(pREAL), dimension(:,:,:,:), pointer :: F
call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc)
call DMDAVecGetArrayReadF90(DM_mech,F_PETSc,F,err_PETSc)
CHKERRQ(err_PETSc)
if (num%update_gamma) C_minMaxAvgRestart = C_minMaxAvg
@ -428,7 +427,7 @@ subroutine grid_mechanical_spectral_basic_restartWrite
call HDF5_closeFile(fileHandle)
end if
call DMDAVecRestoreArrayF90(da,solution_vec,F,err_PETSc)
call DMDAVecRestoreArrayReadF90(DM_mech,F_PETSc,F,err_PETSc)
CHKERRQ(err_PETSc)
end subroutine grid_mechanical_spectral_basic_restartWrite
@ -499,9 +498,9 @@ subroutine formResidual(residual_subdomain, F, &
integer(MPI_INTEGER_KIND) :: err_MPI
call SNESGetNumberFunctionEvals(SNES_mechanical,nfuncs,err_PETSc)
call SNESGetNumberFunctionEvals(SNES_mech,nfuncs,err_PETSc)
CHKERRQ(err_PETSc)
call SNESGetIterationNumber(SNES_mechanical,PETScIter,err_PETSc)
call SNESGetIterationNumber(SNES_mech,PETScIter,err_PETSc)
CHKERRQ(err_PETSc)
if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1 ! new increment

179
src/grid/grid_mech_spectral_polarisation.f90 → src/grid/grid_mech_spectral_polarization.f90
View File

@ -4,7 +4,7 @@
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Grid solver for mechanics: Spectral Polarisation
!--------------------------------------------------------------------------------------------------
module grid_mechanical_spectral_polarisation
module grid_mechanical_spectral_polarization
#include <petsc/finclude/petscsnes.h>
#include <petsc/finclude/petscdmda.h>
use PETScDMDA
@ -16,6 +16,7 @@ module grid_mechanical_spectral_polarisation
use prec
use parallelization
use CLI
use misc
use IO
use HDF5
use HDF5_utilities
@ -56,9 +57,9 @@ module grid_mechanical_spectral_polarisation
!--------------------------------------------------------------------------------------------------
! PETSc data
DM :: da
SNES :: SNES_mechanical
Vec :: solution_vec
DM :: DM_mech
SNES :: SNES_mech
Vec :: FandF_tau_PETSc
!--------------------------------------------------------------------------------------------------
! common pointwise data
@ -93,28 +94,24 @@ module grid_mechanical_spectral_polarisation
err_curl, & !< RMS of curl of F
err_div !< RMS of div of P
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY)
type(MPI_Status) :: status
#else
integer, dimension(MPI_STATUS_SIZE) :: status
#endif
integer :: &
totalIter = 0 !< total iteration in current increment
public :: &
grid_mechanical_spectral_polarisation_init, &
grid_mechanical_spectral_polarisation_solution, &
grid_mechanical_spectral_polarisation_forward, &
grid_mechanical_spectral_polarisation_updateCoords, &
grid_mechanical_spectral_polarisation_restartWrite
grid_mechanical_spectral_polarization_init, &
grid_mechanical_spectral_polarization_solution, &
grid_mechanical_spectral_polarization_forward, &
grid_mechanical_spectral_polarization_updateCoords, &
grid_mechanical_spectral_polarization_restartWrite
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
!> @brief Allocate all necessary fields and fill them with data, potentially from restart info.
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_spectral_polarisation_init()
subroutine grid_mechanical_spectral_polarization_init(num_grid)
type(tDict), pointer, intent(in) :: num_grid
real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: P
PetscErrorCode :: err_PETSc
@ -123,13 +120,15 @@ subroutine grid_mechanical_spectral_polarisation_init()
FandF_tau, & ! overall pointer to solution data
F, & ! specific (sub)pointer
F_tau ! specific (sub)pointer
PetscInt, dimension(0:worldsize-1) :: localK
integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global
real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: &
num_grid
character(len=pSTRLEN) :: &
extmsg = ''
num_grid_fft,&
num_grid_mech
character(len=:), allocatable :: &
extmsg, &
petsc_options
print '(/,1x,a)', '<<<+- grid_mechanical_spectral_polarization init -+>>>'; flush(IO_STDOUT)
@ -137,41 +136,42 @@ subroutine grid_mechanical_spectral_polarisation_init()
print '(/,1x,a)', 'P. Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
print '( 1x,a)', 'https://doi.org/10.1016/j.ijplas.2014.02.006'
!-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks
num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
num_grid_fft => num_grid%get_dict('FFT',defaultVal=emptyDict)
num_grid_mech => num_grid%get_dict('mechanical',defaultVal=emptyDict)
num%update_gamma = num_grid%get_asBool('update_gamma', defaultVal=.false.)
num%eps_div_atol = num_grid%get_asReal('eps_div_atol', defaultVal=1.0e-4_pREAL)
num%eps_div_rtol = num_grid%get_asReal('eps_div_rtol', defaultVal=5.0e-4_pREAL)
num%eps_curl_atol = num_grid%get_asReal('eps_curl_atol', defaultVal=1.0e-10_pREAL)
num%eps_curl_rtol = num_grid%get_asReal('eps_curl_rtol', defaultVal=5.0e-4_pREAL)
num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL)
num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL)
num%itmin = num_grid%get_asInt ('itmin', defaultVal=1)
num%itmax = num_grid%get_asInt ('itmax', defaultVal=250)
num%alpha = num_grid%get_asReal('alpha', defaultVal=1.0_pREAL)
num%beta = num_grid%get_asReal('beta', defaultVal=1.0_pREAL)
num%itmin = num_grid_mech%get_asInt('N_iter_min',defaultVal=1)
num%itmax = num_grid_mech%get_asInt('N_iter_max',defaultVal=100)
num%update_gamma = num_grid_mech%get_asBool('update_gamma',defaultVal=.false.)
num%eps_div_atol = num_grid_mech%get_asReal('eps_abs_div(P)', defaultVal=1.0e-4_pREAL)
num%eps_div_rtol = num_grid_mech%get_asReal('eps_rel_div(P)', defaultVal=5.0e-4_pREAL)
num%eps_curl_atol = num_grid_mech%get_asReal('eps_abs_curl(F)',defaultVal=1.0e-10_pREAL)
num%eps_curl_rtol = num_grid_mech%get_asReal('eps_rel_curl(F)',defaultVal=5.0e-4_pREAL)
num%eps_stress_atol = num_grid_mech%get_asReal('eps_abs_P', defaultVal=1.0e3_pREAL)
num%eps_stress_rtol = num_grid_mech%get_asReal('eps_rel_P', defaultVal=1.0e-3_pREAL)
num%alpha = num_grid_mech%get_asReal('alpha', defaultVal=1.0_pREAL)
num%beta = num_grid_mech%get_asReal('beta', defaultVal=1.0_pREAL)
if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_atol'
if (num%eps_div_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_rtol'
if (num%eps_curl_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_curl_atol'
if (num%eps_curl_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_curl_rtol'
if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_atol'
if (num%eps_stress_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_rtol'
if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin'
extmsg = ''
if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_div(P)'
if (num%eps_div_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_div(P)'
if (num%eps_curl_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_curl(F)'
if (num%eps_curl_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_curl(F)'
if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_P'
if (num%eps_stress_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_P'
if (num%alpha <= 0.0_pREAL .or. num%alpha > 2.0_pREAL) extmsg = trim(extmsg)//' alpha'
if (num%beta < 0.0_pREAL .or. num%beta > 2.0_pREAL) extmsg = trim(extmsg)//' beta'
if (num%itmax < 1) extmsg = trim(extmsg)//' N_iter_max'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' N_iter_min'
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
!--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',err_PETSc)
CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
petsc_options = misc_prefixOptions('-snes_type ngmres '//num_grid_mech%get_asStr('PETSc_options',defaultVal=''), &
'mechanical_')
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
@ -183,41 +183,40 @@ subroutine grid_mechanical_spectral_polarisation_init()
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,SNES_mechanical,err_PETSc)
call SNESCreate(PETSC_COMM_WORLD,SNES_mech,err_PETSc)
CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc)
call SNESSetOptionsPrefix(SNES_mech,'mechanical_',err_PETSc)
CHKERRQ(err_PETSc)
localK = 0_pPetscInt
localK(worldrank) = int(cells3,pPetscInt)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
call MPI_Allgather(int(cells3,pPetscInt),1_MPI_INTEGER_KIND,MPI_INTEGER,&
cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), &
18_pPetscInt, 0_pPetscInt, & ! #dof (2xtensor), ghost boundary width (domain overlap)
[int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells
da,err_PETSc) ! handle, error
int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
18_pPETSCINT, 0_pPETSCINT, & ! #dof (2xtensor), ghost boundary width (domain overlap)
[int(cells(1),pPETSCINT)],[int(cells(2),pPETSCINT)],int(cells3_global,pPETSCINT), & ! local cells
DM_mech,err_PETSc) ! handle, error
CHKERRQ(err_PETSc)
call DMsetFromOptions(da,err_PETSc)
call DMsetFromOptions(DM_mech,err_PETSc)
CHKERRQ(err_PETSc)
call DMsetUp(da,err_PETSc)
call DMsetUp(DM_mech,err_PETSc)
CHKERRQ(err_PETSc)
call DMcreateGlobalVector(da,solution_vec,err_PETSc) ! global solution vector (cells x 18, i.e. every def grad tensor)
call DMcreateGlobalVector(DM_mech,FandF_tau_PETSc,err_PETSc) ! global solution vector (cells x 18, i.e. every def grad tensor)
CHKERRQ(err_PETSc)
call DMDASNESsetFunctionLocal(da,INSERT_VALUES,formResidual,PETSC_NULL_SNES,err_PETSc) ! residual vector of same shape as solution vector
call DMDASNESsetFunctionLocal(DM_mech,INSERT_VALUES,formResidual,PETSC_NULL_SNES,err_PETSc) ! residual vector of same shape as solution vector
CHKERRQ(err_PETSc)
call SNESsetConvergenceTest(SNES_mechanical,converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,err_PETSc) ! specify custom convergence check function "converged"
call SNESsetConvergenceTest(SNES_mech,converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,err_PETSc) ! specify custom convergence check function "converged"
CHKERRQ(err_PETSc)
call SNESSetDM(SNES_mechanical,da,err_PETSc)
call SNESSetDM(SNES_mech,DM_mech,err_PETSc)
CHKERRQ(err_PETSc)
call SNESsetFromOptions(SNES_mechanical,err_PETSc) ! pull it all together with additional CLI arguments
call SNESsetFromOptions(SNES_mech,err_PETSc) ! pull it all together with additional CLI arguments
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
! init fields
call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc) ! places pointer on PETSc data
call DMDAVecGetArrayF90(DM_mech,FandF_tau_PETSc,FandF_tau,err_PETSc) ! places pointer on PETSc data
CHKERRQ(err_PETSc)
F => FandF_tau(0: 8,:,:,:)
F_tau => FandF_tau(9:17,:,:,:)
@ -261,7 +260,7 @@ subroutine grid_mechanical_spectral_polarisation_init()
call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2
reshape(F,shape(F_lastInc)), & ! target F
0.0_pREAL) ! time increment
call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,err_PETSc) ! deassociate pointer
call DMDAVecRestoreArrayF90(DM_mech,FandF_tau_PETSc,FandF_tau,err_PETSc) ! deassociate pointer
CHKERRQ(err_PETSc)
restartRead2: if (CLI_restartInc > 0) then
@ -286,13 +285,13 @@ subroutine grid_mechanical_spectral_polarisation_init()
C_scale = C_minMaxAvg
S_scale = math_invSym3333(C_minMaxAvg)
end subroutine grid_mechanical_spectral_polarisation_init
end subroutine grid_mechanical_spectral_polarization_init
!--------------------------------------------------------------------------------------------------
!> @brief solution for the Polarisation scheme with internal iterations
!--------------------------------------------------------------------------------------------------
function grid_mechanical_spectral_polarisation_solution(incInfoIn) result(solution)
function grid_mechanical_spectral_polarization_solution(incInfoIn) result(solution)
!--------------------------------------------------------------------------------------------------
! input data for solution
@ -316,9 +315,9 @@ function grid_mechanical_spectral_polarisation_solution(incInfoIn) result(soluti
S_scale = math_invSym3333(C_minMaxAvg)
end if
call SNESSolve(SNES_mechanical,PETSC_NULL_VEC,solution_vec,err_PETSc)
call SNESSolve(SNES_mech,PETSC_NULL_VEC,FandF_tau_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
call SNESGetConvergedReason(SNES_mechanical,reason,err_PETSc)
call SNESGetConvergedReason(SNES_mech,reason,err_PETSc)
CHKERRQ(err_PETSc)
solution%converged = reason > 0
@ -327,14 +326,14 @@ function grid_mechanical_spectral_polarisation_solution(incInfoIn) result(soluti
terminallyIll = .false.
P_aim = merge(P_av,P_aim,params%stress_mask)
end function grid_mechanical_spectral_polarisation_solution
end function grid_mechanical_spectral_polarization_solution
!--------------------------------------------------------------------------------------------------
!> @brief forwarding routine
!> @details find new boundary conditions and best F estimate for end of current timestep
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,&
subroutine grid_mechanical_spectral_polarization_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,&
deformation_BC,stress_BC,rotation_BC)
logical, intent(in) :: &
@ -355,7 +354,7 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
real(pREAL), dimension(3,3) :: F_lambda33
call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc)
call DMDAVecGetArrayF90(DM_mech,FandF_tau_PETSc,FandF_tau,err_PETSc)
CHKERRQ(err_PETSc)
F => FandF_tau(0: 8,:,:,:)
F_tau => FandF_tau(9:17,:,:,:)
@ -403,11 +402,11 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
if (stress_BC%myType=='dot_P') P_aim = P_aim &
+ merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t
F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, & ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
rotation_BC%rotate(F_aim,active=.true.)),&
F = reshape(utilities_forwardTensorField(Delta_t,F_lastInc,Fdot, & ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
rotation_BC%rotate(F_aim,active=.true.)),&
[9,cells(1),cells(2),cells3])
if (guess) then
F_tau = reshape(Utilities_forwardField(Delta_t,F_tau_lastInc,F_taudot), &
F_tau = reshape(Utilities_forwardTensorField(Delta_t,F_tau_lastInc,F_taudot), &
[9,cells(1),cells(2),cells3]) ! does not have any average value as boundary condition
else
do k = 1, cells3; do j = 1, cells(2); do i = 1, cells(1)
@ -419,7 +418,7 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
end do; end do; end do
end if
call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,err_PETSc)
call DMDAVecRestoreArrayF90(DM_mech,FandF_tau_PETSc,FandF_tau,err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
@ -428,36 +427,36 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
params%rotation_BC = rotation_BC
params%Delta_t = Delta_t
end subroutine grid_mechanical_spectral_polarisation_forward
end subroutine grid_mechanical_spectral_polarization_forward
!--------------------------------------------------------------------------------------------------
!> @brief Update coordinates
!> @brief Update coordinates.
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_spectral_polarisation_updateCoords
subroutine grid_mechanical_spectral_polarization_updateCoords()
PetscErrorCode :: err_PETSc
real(pREAL), dimension(:,:,:,:), pointer :: FandF_tau
call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc)
call DMDAVecGetArrayReadF90(DM_mech,FandF_tau_PETSc,FandF_tau,err_PETSc)
CHKERRQ(err_PETSc)
call utilities_updateCoords(FandF_tau(0:8,:,:,:))
call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,err_PETSc)
call utilities_updateCoords(reshape(FandF_tau(0:8,:,:,:),[3,3,size(FandF_tau,2),size(FandF_tau,3),size(FandF_tau,4)]))
call DMDAVecRestoreArrayReadF90(DM_mech,FandF_tau_PETSc,FandF_tau,err_PETSc)
CHKERRQ(err_PETSc)
end subroutine grid_mechanical_spectral_polarisation_updateCoords
end subroutine grid_mechanical_spectral_polarization_updateCoords
!--------------------------------------------------------------------------------------------------
!> @brief Write current solver and constitutive data for restart to file
!> @brief Write current solver and constitutive data for restart to file.
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_spectral_polarisation_restartWrite
subroutine grid_mechanical_spectral_polarization_restartWrite()
PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle
real(pREAL), dimension(:,:,:,:), pointer :: FandF_tau, F, F_tau
call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc)
call DMDAVecGetArrayReadF90(DM_mech,FandF_tau_PETSc,FandF_tau,err_PETSc)
CHKERRQ(err_PETSc)
F => FandF_tau(0: 8,:,:,:)
F_tau => FandF_tau(9:17,:,:,:)
@ -489,10 +488,10 @@ subroutine grid_mechanical_spectral_polarisation_restartWrite
call HDF5_closeFile(fileHandle)
end if
call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,err_PETSc)
call DMDAVecRestoreArrayReadF90(DM_mech,FandF_tau_PETSc,FandF_tau,err_PETSc)
CHKERRQ(err_PETSc)
end subroutine grid_mechanical_spectral_polarisation_restartWrite
end subroutine grid_mechanical_spectral_polarization_restartWrite
!--------------------------------------------------------------------------------------------------
@ -577,9 +576,9 @@ subroutine formResidual(residual_subdomain, FandF_tau, &
call MPI_Allreduce(MPI_IN_PLACE,F_av,9_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call SNESGetNumberFunctionEvals(SNES_mechanical,nfuncs,err_PETSc)
call SNESGetNumberFunctionEvals(SNES_mech,nfuncs,err_PETSc)
CHKERRQ(err_PETSc)
call SNESGetIterationNumber(SNES_mechanical,PETScIter,err_PETSc)
call SNESGetIterationNumber(SNES_mech,PETScIter,err_PETSc)
CHKERRQ(err_PETSc)
if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1 ! new increment
@ -645,4 +644,4 @@ subroutine formResidual(residual_subdomain, FandF_tau, &
end subroutine formResidual
end module grid_mechanical_spectral_polarisation
end module grid_mechanical_spectral_polarization

226
src/grid/grid_thermal_spectral.f90
View File

@ -16,6 +16,7 @@ module grid_thermal_spectral
use prec
use parallelization
use IO
use misc
use CLI
use HDF5_utilities
use HDF5
@ -46,9 +47,8 @@ module grid_thermal_spectral
!--------------------------------------------------------------------------------------------------
! PETSc data
SNES :: SNES_thermal
Vec :: solution_vec
Vec :: T_PETSc
real(pREAL), dimension(:,:,:), allocatable :: &
T, & !< field of current temperature
T_lastInc, & !< field of previous temperature
T_stagInc, & !< field of staggered temperature
dotT_lastInc
@ -67,20 +67,26 @@ module grid_thermal_spectral
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields and fills them with data
!> @brief Allocate all necessary fields and fill them with data, potentially from restart info.
!--------------------------------------------------------------------------------------------------
subroutine grid_thermal_spectral_init()
subroutine grid_thermal_spectral_init(num_grid)
PetscInt, dimension(0:worldsize-1) :: localK
integer :: i, j, k, ce
DM :: thermal_grid
real(pREAL), dimension(:,:,:), pointer :: T_PETSc
type(tDict), pointer, intent(in) :: num_grid
integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global
integer :: ce
DM :: DM_thermal
real(pREAL), dimension(:,:,:), pointer :: T ! 0-indexed
integer(MPI_INTEGER_KIND) :: err_MPI
PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle
real(pREAL), dimension(1,product(cells(1:2))*cells3) :: tempN
type(tDict), pointer :: &
num_grid
num_grid_thermal
character(len=:), allocatable :: &
extmsg, &
petsc_options
print'(/,1x,a)', '<<<+- grid_thermal_spectral init -+>>>'
@ -91,29 +97,24 @@ subroutine grid_thermal_spectral_init()
!-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks
num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
num%itmax = num_grid%get_asInt ('itmax', defaultVal=250)
num%eps_thermal_atol = num_grid%get_asReal('eps_thermal_atol',defaultVal=1.0e-2_pREAL)
num%eps_thermal_rtol = num_grid%get_asReal('eps_thermal_rtol',defaultVal=1.0e-6_pREAL)
num_grid_thermal => num_grid%get_dict('thermal',defaultVal=emptyDict)
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax')
if (num%eps_thermal_atol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_thermal_atol')
if (num%eps_thermal_rtol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_thermal_rtol')
num%itmax = num_grid_thermal%get_asInt('N_iter_max', defaultVal=100)
num%eps_thermal_atol = num_grid_thermal%get_asReal('eps_abs_T', defaultVal=1.0e-2_pREAL)
num%eps_thermal_rtol = num_grid_thermal%get_asReal('eps_rel_T', defaultVal=1.0e-6_pREAL)
extmsg = ''
if (num%eps_thermal_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_T'
if (num%eps_thermal_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_T'
if (num%itmax < 1) extmsg = trim(extmsg)//' N_iter_max'
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
!--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-thermal_snes_type newtonls -thermal_snes_mf &
&-thermal_snes_ksp_ew -thermal_ksp_type fgmres',err_PETSc)
CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
! init fields
T = discretization_grid_getInitialCondition('T')
T_lastInc = T
T_stagInc = T
dotT_lastInc = 0.0_pREAL * T
petsc_options = misc_prefixOptions('-snes_type newtonls -snes_mf -snes_ksp_ew -ksp_type fgmres '// &
num_grid_thermal%get_asStr('PETSc_options',defaultVal=''), 'thermal_')
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
@ -121,32 +122,33 @@ subroutine grid_thermal_spectral_init()
CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_thermal,'thermal_',err_PETSc)
CHKERRQ(err_PETSc)
localK = 0_pPetscInt
localK(worldrank) = int(cells3,pPetscInt)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
call MPI_Allgather(int(cells3,pPETSCINT),1_MPI_INTEGER_KIND,MPI_INTEGER,&
cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3D(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), &
1_pPetscInt, 0_pPetscInt, & ! #dof (T, scalar), ghost boundary width (domain overlap)
[int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells
thermal_grid,err_PETSc) ! handle, error
int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
1_pPETSCINT, 0_pPETSCINT, & ! #dof (T, scalar), ghost boundary width (domain overlap)
[int(cells(1),pPETSCINT)],[int(cells(2),pPETSCINT)],int(cells3_global,pPETSCINT), & ! local cells
DM_thermal,err_PETSc) ! handle, error
CHKERRQ(err_PETSc)
call DMsetFromOptions(thermal_grid,err_PETSc)
call DMsetFromOptions(DM_thermal,err_PETSc)
CHKERRQ(err_PETSc)
call DMsetUp(thermal_grid,err_PETSc)
call DMsetUp(DM_thermal,err_PETSc)
CHKERRQ(err_PETSc)
call DMCreateGlobalVector(thermal_grid,solution_vec,err_PETSc) ! global solution vector (cells x 1, i.e. every def grad tensor)
call DMCreateGlobalVector(DM_thermal,T_PETSc,err_PETSc) ! global solution vector (cells x 1, i.e. every def grad tensor)
CHKERRQ(err_PETSc)
call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,formResidual,PETSC_NULL_SNES,err_PETSc) ! residual vector of same shape as solution vector
call DMDASNESSetFunctionLocal(DM_thermal,INSERT_VALUES,formResidual,PETSC_NULL_SNES,err_PETSc) ! residual vector of same shape as solution vector
CHKERRQ(err_PETSc)
call SNESSetDM(SNES_thermal,thermal_grid,err_PETSc)
call SNESSetDM(SNES_thermal,DM_thermal,err_PETSc)
CHKERRQ(err_PETSc)
call SNESSetFromOptions(SNES_thermal,err_PETSc) ! pull it all together with additional CLI arguments
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(DM_thermal,T_PETSc,T,err_PETSc) ! returns 0-indexed T
CHKERRQ(err_PETSc)
restartRead: if (CLI_restartInc > 0) then
print'(/,1x,a,1x,i0)', 'loading restart data of increment', CLI_restartInc
@ -158,20 +160,20 @@ subroutine grid_thermal_spectral_init()
T = reshape(tempN,[cells(1),cells(2),cells3])
call HDF5_read(tempN,groupHandle,'T_lastInc',.false.)
T_lastInc = reshape(tempN,[cells(1),cells(2),cells3])
T_stagInc = T_lastInc
call HDF5_read(tempN,groupHandle,'dotT_lastInc',.false.)
dotT_lastInc = reshape(tempN,[cells(1),cells(2),cells3])
else
T = discretization_grid_getInitialCondition('T')
T_lastInc = T(0:,0:,0:)
T_stagInc = T_lastInc
dotT_lastInc = 0.0_pREAL * T_lastInc
end if restartRead
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1, cells(1)
ce = ce + 1
call homogenization_thermal_setField(T(i,j,k),0.0_pREAL,ce)
end do; end do; end do
call homogenization_thermal_setField(reshape(T,[product(cells(1:2))*cells3]), &
[(0.0_pReal, ce = 1,product(cells(1:2))*cells3)])
call DMDAVecGetArrayF90(thermal_grid,solution_vec,T_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
T_PETSc = T
call DMDAVecRestoreArrayF90(thermal_grid,solution_vec,T_PETSc,err_PETSc)
call DMDAVecRestoreArrayF90(DM_thermal,T_PETSc,T,err_PETSc)
CHKERRQ(err_PETSc)
call updateReference()
@ -186,53 +188,50 @@ function grid_thermal_spectral_solution(Delta_t) result(solution)
real(pREAL), intent(in) :: &
Delta_t !< increment in time for current solution
integer :: i, j, k, ce
type(tSolutionState) :: solution
PetscInt :: devNull
PetscReal :: T_min, T_max, stagNorm
DM :: DM_thermal
real(pREAL), dimension(:,:,:), pointer :: T ! 0-indexed
integer(MPI_INTEGER_KIND) :: err_MPI
PetscErrorCode :: err_PETSc
SNESConvergedReason :: reason
solution%converged = .false.
!--------------------------------------------------------------------------------------------------
! set module wide availabe data
params%Delta_t = Delta_t
call SNESSolve(SNES_thermal,PETSC_NULL_VEC,solution_vec,err_PETSc)
call SNESSolve(SNES_thermal,PETSC_NULL_VEC,T_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
call SNESGetConvergedReason(SNES_thermal,reason,err_PETSc)
CHKERRQ(err_PETSc)
if (reason < 1) then
solution%converged = .false.
solution%iterationsNeeded = num%itmax
else
solution%converged = .true.
solution%iterationsNeeded = totalIter
end if
solution%converged = reason > 0
solution%iterationsNeeded = merge(totalIter,num%itmax,solution%converged)
call SNESGetDM(SNES_thermal,DM_thermal,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(DM_thermal,T_PETSc,T,err_PETSc) ! returns 0-indexed T
CHKERRQ(err_PETSc)
T_min = minval(T)
T_max = maxval(T)
stagNorm = maxval(abs(T - T_stagInc))
call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_MAX,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
solution%stagConverged = stagNorm < max(num%eps_thermal_atol, num%eps_thermal_rtol*maxval(T))
solution%stagConverged = stagNorm < max(num%eps_thermal_atol, num%eps_thermal_rtol*T_max)
call MPI_Allreduce(MPI_IN_PLACE,solution%stagConverged,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LAND,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
T_stagInc = T
!--------------------------------------------------------------------------------------------------
! updating thermal state
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
call homogenization_thermal_setField(T(i,j,k),(T(i,j,k)-T_lastInc(i,j,k))/params%Delta_t,ce)
end do; end do; end do
call homogenization_thermal_setField(reshape(T,[product(cells(1:2))*cells3]), &
reshape(T-T_lastInc,[product(cells(1:2))*cells3])/params%Delta_t)
call VecMin(solution_vec,devNull,T_min,err_PETSc)
CHKERRQ(err_PETSc)
call VecMax(solution_vec,devNull,T_max,err_PETSc)
call DMDAVecRestoreArrayF90(DM_thermal,T_PETSc,T,err_PETSc)
CHKERRQ(err_PETSc)
if (solution%converged) &
print'(/,1x,a)', '... thermal conduction converged ..................................'
print'(/,1x,a,f8.4,2x,f8.4,2x,f8.4)', 'Minimum|Maximum|Delta Temperature / K = ', T_min, T_max, stagNorm
@ -243,58 +242,53 @@ end function grid_thermal_spectral_solution
!--------------------------------------------------------------------------------------------------
!> @brief forwarding routine
!> @brief Set DAMASK data to current solver status.
!--------------------------------------------------------------------------------------------------
subroutine grid_thermal_spectral_forward(cutBack)
logical, intent(in) :: cutBack
integer :: i, j, k, ce
DM :: dm_local
real(pREAL), dimension(:,:,:), pointer :: T_PETSc
DM :: DM_thermal
real(pREAL), dimension(:,:,:), pointer :: T ! 0-indexed
PetscErrorCode :: err_PETSc
call SNESGetDM(SNES_thermal,DM_thermal,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(DM_thermal,T_PETSc,T,err_PETSc) ! returns 0-indexed T
CHKERRQ(err_PETSc)
if (cutBack) then
call homogenization_thermal_setField(reshape(T_lastInc,[product(cells(1:2))*cells3]), &
reshape(dotT_lastInc,[product(cells(1:2))*cells3]))
T = T_lastInc
T_stagInc = T_lastInc
!--------------------------------------------------------------------------------------------------
! reverting thermal field state
call SNESGetDM(SNES_thermal,dm_local,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(dm_local,solution_vec,T_PETSc,err_PETSc) !< get the data out of PETSc to work with
CHKERRQ(err_PETSc)
T_PETSc = T
call DMDAVecRestoreArrayF90(dm_local,solution_vec,T_PETSc,err_PETSc)
CHKERRQ(err_PETSc)
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
call homogenization_thermal_setField(T(i,j,k),dotT_lastInc(i,j,k),ce)
end do; end do; end do
else
dotT_lastInc = (T - T_lastInc)/params%Delta_t
T_lastInc = T
call updateReference()
end if
call DMDAVecRestoreArrayF90(DM_thermal,T_PETSc,T,err_PETSc)
CHKERRQ(err_PETSc)
end subroutine grid_thermal_spectral_forward
!--------------------------------------------------------------------------------------------------
!> @brief Write current solver and constitutive data for restart to file.
!--------------------------------------------------------------------------------------------------
subroutine grid_thermal_spectral_restartWrite
subroutine grid_thermal_spectral_restartWrite()
PetscErrorCode :: err_PETSc
DM :: dm_local
DM :: DM_thermal
integer(HID_T) :: fileHandle, groupHandle
real(pREAL), dimension(:,:,:), pointer :: T
real(pREAL), dimension(:,:,:), pointer :: T ! 0-indexed
call SNESGetDM(SNES_thermal,dm_local,err_PETSc);
call SNESGetDM(SNES_thermal,DM_thermal,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(dm_local,solution_vec,T,err_PETSc);
call DMDAVecGetArrayReadF90(DM_thermal,T_PETSc,T,err_PETSc) ! returns 0-indexed T
CHKERRQ(err_PETSc)
print'(1x,a)', 'saving thermal solver data required for restart'; flush(IO_STDOUT)
@ -307,13 +301,12 @@ subroutine grid_thermal_spectral_restartWrite
call HDF5_closeGroup(groupHandle)
call HDF5_closeFile(fileHandle)
call DMDAVecRestoreArrayF90(dm_local,solution_vec,T,err_PETSc);
call DMDAVecRestoreArrayReadF90(DM_thermal,T_PETSc,T,err_PETSc);
CHKERRQ(err_PETSc)
end subroutine grid_thermal_spectral_restartWrite
!--------------------------------------------------------------------------------------------------
!> @brief Construct the residual vector.
!--------------------------------------------------------------------------------------------------
@ -324,7 +317,7 @@ subroutine formResidual(residual_subdomain,x_scal,r,dummy,err_PETSc)
real(pREAL), dimension(cells(1),cells(2),cells3), intent(in) :: &
x_scal
real(pREAL), dimension(cells(1),cells(2),cells3), intent(out) :: &
r !< residual
r !< residual
PetscObject :: dummy
PetscErrorCode, intent(out) :: err_PETSc
@ -332,24 +325,25 @@ subroutine formResidual(residual_subdomain,x_scal,r,dummy,err_PETSc)
real(pREAL), dimension(3,cells(1),cells(2),cells3) :: vectorField
T = x_scal
vectorField = utilities_ScalarGradient(T)
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
vectorField(1:3,i,j,k) = matmul(homogenization_K_T(ce) - K_ref, vectorField(1:3,i,j,k))
end do; end do; end do
r = utilities_VectorDivergence(vectorField)
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
r(i,j,k) = params%Delta_t*(r(i,j,k) + homogenization_f_T(ce)) &
+ homogenization_mu_T(ce) * (T_lastInc(i,j,k) - T(i,j,k)) &
+ mu_ref*T(i,j,k)
end do; end do; end do
associate(T => x_scal)
vectorField = utilities_ScalarGradient(T)
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
vectorField(1:3,i,j,k) = matmul(homogenization_K_T(ce) - K_ref, vectorField(1:3,i,j,k))
end do; end do; end do
r = utilities_VectorDivergence(vectorField)
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
r(i,j,k) = params%Delta_t*(r(i,j,k) + homogenization_f_T(ce)) &
+ homogenization_mu_T(ce) * (T_lastInc(i,j,k) - T(i,j,k)) &
+ mu_ref*T(i,j,k)
end do; end do; end do
r = T &
- utilities_GreenConvolution(r, K_ref, mu_ref, params%Delta_t)
r = T &
- utilities_GreenConvolution(r, K_ref, mu_ref, params%Delta_t)
end associate
err_PETSc = 0
end subroutine formResidual

73
src/grid/spectral_utilities.f90
View File

@ -100,12 +100,18 @@ module spectral_utilities
enum, bind(c); enumerator :: &
DERIVATIVE_CONTINUOUS_ID, &
DERIVATIVE_CENTRAL_DIFF_ID, &
DERIVATIVE_FWBW_DIFF_ID
DERIVATIVE_FWBW_DIFF_ID, &
DIVERGENCE_CORRECTION_NONE_ID, &
DIVERGENCE_CORRECTION_SIZE_ID, &
DIVERGENCE_CORRECTION_SIZE_GRID_ID
end enum
integer(kind(DERIVATIVE_CONTINUOUS_ID)) :: &
spectral_derivative_ID
integer(kind(DIVERGENCE_CORRECTION_NONE_ID)) :: &
divergence_correction_ID
public :: &
spectral_utilities_init, &
utilities_updateGamma, &
@ -118,7 +124,7 @@ module spectral_utilities
utilities_maskedCompliance, &
utilities_constitutiveResponse, &
utilities_calculateRate, &
utilities_forwardField, &
utilities_forwardTensorField, &
utilities_updateCoords
contains
@ -146,8 +152,9 @@ subroutine spectral_utilities_init()
vectorSize = 3_C_INTPTR_T, &
tensorSize = 9_C_INTPTR_T
type(tDict) , pointer :: &
num_grid
num_solver, &
num_grid, &
num_grid_fft
print'(/,1x,a)', '<<<+- spectral_utilities init -+>>>'
@ -163,8 +170,10 @@ subroutine spectral_utilities_init()
print'( 1x,a)', 'P. Shanthraj et al., Handbook of Mechanics of Materials, 2019'
print'( 1x,a)', 'https://doi.org/10.1007/978-981-10-6855-3_80'
num_solver => config_numerics%get_dict('solver',defaultVal=emptyDict)
num_grid => num_solver%get_dict('grid',defaultVal=emptyDict)
num_grid_fft => num_grid%get_dict('FFT',defaultVal=emptyDict)
num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
call PetscOptionsClear(PETSC_NULL_OPTIONS,err_PETSc)
CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,&
@ -174,13 +183,21 @@ subroutine spectral_utilities_init()
cells1Red = cells(1)/2 + 1
wgt = real(product(cells),pREAL)**(-1)
num%memory_efficient = num_grid%get_asInt('memory_efficient', defaultVal=1) > 0 ! ToDo: should be logical in YAML file
num%divergence_correction = num_grid%get_asInt('divergence_correction', defaultVal=2)
num%memory_efficient = num_grid_fft%get_asBool('memory_efficient', defaultVal=.true.)
if (num%divergence_correction < 0 .or. num%divergence_correction > 2) &
call IO_error(301,ext_msg='divergence_correction')
select case (num_grid_fft%get_asStr('divergence_correction',defaultVal='grid+size'))
case ('none')
divergence_correction_ID = DIVERGENCE_CORRECTION_NONE_ID
case ('size')
divergence_correction_ID = DIVERGENCE_CORRECTION_SIZE_ID
case ('grid+size', 'size+grid')
divergence_correction_ID = DIVERGENCE_CORRECTION_SIZE_GRID_ID
case default
call IO_error(301,ext_msg=trim(num_grid_fft%get_asStr('divergence_correction')))
end select
select case (num_grid%get_asStr('derivative',defaultVal='continuous'))
select case (num_grid_fft%get_asStr('derivative',defaultVal='continuous'))
case ('continuous')
spectral_derivative_ID = DERIVATIVE_CONTINUOUS_ID
case ('central_difference')
@ -188,18 +205,18 @@ subroutine spectral_utilities_init()
case ('FWBW_difference')
spectral_derivative_ID = DERIVATIVE_FWBW_DIFF_ID
case default
call IO_error(892,ext_msg=trim(num_grid%get_asStr('derivative')))
call IO_error(892,ext_msg=trim(num_grid_fft%get_asStr('derivative')))
end select
!--------------------------------------------------------------------------------------------------
! scale dimension to calculate either uncorrected, dimension-independent, or dimension- and
! resolution-independent divergence
if (num%divergence_correction == 1) then
if (divergence_correction_ID == DIVERGENCE_CORRECTION_NONE_ID) then
do j = 1, 3
if (j /= minloc(geomSize,1) .and. j /= maxloc(geomSize,1)) &
scaledGeomSize = geomSize/geomSize(j)
end do
elseif (num%divergence_correction == 2) then
elseif (divergence_correction_ID == DIVERGENCE_CORRECTION_SIZE_GRID_ID) then
do j = 1, 3
if ( j /= int(minloc(geomSize/real(cells,pREAL),1)) &
.and. j /= int(maxloc(geomSize/real(cells,pREAL),1))) &
@ -209,24 +226,24 @@ subroutine spectral_utilities_init()
scaledGeomSize = geomSize
end if
select case(IO_lc(num_grid%get_asStr('fftw_plan_mode',defaultVal='FFTW_MEASURE')))
case('fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution
select case(IO_lc(num_grid_fft%get_asStr('FFTW_plan_mode',defaultVal='FFTW_MEASURE')))
case('fftw_estimate', 'FFTW_ESTIMATE') ! ordered from slow execution (but fast plan creation) to fast execution
FFTW_planner_flag = FFTW_ESTIMATE
case('fftw_measure')
case('fftw_measure', 'FFTW_MEASURE')
FFTW_planner_flag = FFTW_MEASURE
case('fftw_patient')
case('fftw_patient', 'FFTW_PATIENT')
FFTW_planner_flag = FFTW_PATIENT
case('fftw_exhaustive')
case('fftw_exhaustive', 'FFTW_EXHAUSTIVE')
FFTW_planner_flag = FFTW_EXHAUSTIVE
case default
call IO_warning(47,'using default FFTW_MEASURE instead of "'//trim(num_grid%get_asStr('fftw_plan_mode'))//'"')
call IO_warning(47,'using default FFTW_MEASURE instead of "'//trim(num_grid_fft%get_asStr('plan_mode'))//'"')
FFTW_planner_flag = FFTW_MEASURE
end select
!--------------------------------------------------------------------------------------------------
! general initialization of FFTW (see manual on fftw.org for more details)
if (pREAL /= C_DOUBLE .or. kind(1) /= C_INT) error stop 'C and Fortran datatypes do not match'
call fftw_set_timelimit(num_grid%get_asReal('fftw_timelimit',defaultVal=300.0_pREAL))
call fftw_set_timelimit(num_grid_fft%get_asReal('FFTW_timelimit',defaultVal=300.0_pREAL))
print'(/,1x,a)', 'FFTW initialized'; flush(IO_STDOUT)
@ -657,6 +674,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
logical :: errmatinv
character(len=pSTRLEN):: formatString
mask_stressVector = .not. reshape(transpose(mask_stress), [9])
size_reduced = count(mask_stressVector)
if (size_reduced > 0) then
@ -679,6 +697,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
write(formatString, '(i2)') size_reduced
formatString = '(/,1x,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))'
print trim(formatString), 'C * S (load) ', transpose(matmul(c_reduced,s_reduced))
print trim(formatString), 'C (load) ', transpose(c_reduced)
print trim(formatString), 'S (load) ', transpose(s_reduced)
if (errmatinv) error stop 'matrix inversion error'
end if
@ -847,7 +866,7 @@ end function utilities_calculateRate
!> @brief forwards a field with a pointwise given rate, if aim is given,
!> ensures that the average matches the aim
!--------------------------------------------------------------------------------------------------
function utilities_forwardField(Delta_t,field_lastInc,rate,aim)
function utilities_forwardTensorField(Delta_t,field_lastInc,rate,aim)
real(pREAL), intent(in) :: &
Delta_t !< Delta_t of current step
@ -858,22 +877,22 @@ function utilities_forwardField(Delta_t,field_lastInc,rate,aim)
aim !< average field value aim
real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: &
utilities_forwardField
utilities_forwardTensorField
real(pREAL), dimension(3,3) :: fieldDiff !< <a + adot*t> - aim
integer(MPI_INTEGER_KIND) :: err_MPI
utilities_forwardField = field_lastInc + rate*Delta_t
utilities_forwardTensorField = field_lastInc + rate*Delta_t
if (present(aim)) then !< correct to match average
fieldDiff = sum(sum(sum(utilities_forwardField,dim=5),dim=4),dim=3)*wgt
fieldDiff = sum(sum(sum(utilities_forwardTensorField,dim=5),dim=4),dim=3)*wgt
call MPI_Allreduce(MPI_IN_PLACE,fieldDiff,9_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
fieldDiff = fieldDiff - aim
utilities_forwardField = utilities_forwardField &
- spread(spread(spread(fieldDiff,3,cells(1)),4,cells(2)),5,cells3)
utilities_forwardTensorField = utilities_forwardTensorField &
- spread(spread(spread(fieldDiff,3,cells(1)),4,cells(2)),5,cells3)
end if
end function utilities_forwardField
end function utilities_forwardTensorField
!--------------------------------------------------------------------------------------------------

36
src/homogenization.f90
View File

@ -16,7 +16,7 @@ module homogenization
use HDF5
use HDF5_utilities
use result
use lattice
use crystal
implicit none(type,external)
private
@ -59,15 +59,6 @@ module homogenization
real(pREAL), dimension(:,:,:,:,:), allocatable, public :: & !, protected :: &
homogenization_dPdF !< tangent of first P--K stress at IP
!--------------------------------------------------------------------------------------------------
type :: tNumerics
integer :: &
nMPstate !< materialpoint state loop limit
end type tNumerics
type(tNumerics) :: num
!--------------------------------------------------------------------------------------------------
interface
@ -145,9 +136,8 @@ module homogenization
real(pREAL) :: f
end function homogenization_f_T
module subroutine homogenization_thermal_setField(T,dot_T, ce)
integer, intent(in) :: ce
real(pREAL), intent(in) :: T, dot_T
module subroutine homogenization_thermal_setField(T,dot_T)
real(pREAL), dimension(:), intent(in) :: T, dot_T
end subroutine homogenization_thermal_setField
module function homogenization_damage_active() result(active)
@ -170,10 +160,8 @@ module homogenization
real(pREAL) :: f
end function homogenization_f_phi
module subroutine homogenization_set_phi(phi,ce)
integer, intent(in) :: ce
real(pREAL), intent(in) :: &
phi
module subroutine homogenization_set_phi(phi)
real(pREAL), dimension(:), intent(in) :: phi
end subroutine homogenization_set_phi
end interface
@ -217,12 +205,6 @@ subroutine homogenization_init()
allocate(damageState_h (size(material_name_homogenization)))
call parseHomogenization()
num_homog => config_numerics%get_dict('homogenization',defaultVal=emptyDict)
num_homogGeneric => num_homog%get_dict('generic',defaultVal=emptyDict)
num%nMPstate = num_homogGeneric%get_asInt('nMPstate',defaultVal=10)
if (num%nMPstate < 1) call IO_error(301,ext_msg='nMPstate')
call mechanical_init()
call thermal_init()
call damage_init()
@ -239,7 +221,6 @@ subroutine homogenization_mechanical_response(Delta_t,cell_start,cell_end)
integer, intent(in) :: &
cell_start, cell_end
integer :: &
NiterationMPstate, &
co, ce, ho, en
logical :: &
converged
@ -247,7 +228,7 @@ subroutine homogenization_mechanical_response(Delta_t,cell_start,cell_end)
doneAndHappy
!$OMP PARALLEL DO PRIVATE(en,ho,co,NiterationMPstate,converged,doneAndHappy)
!$OMP PARALLEL DO PRIVATE(en,ho,co,converged,doneAndHappy)
do ce = cell_start, cell_end
en = material_entry_homogenization(ce)
@ -261,10 +242,7 @@ subroutine homogenization_mechanical_response(Delta_t,cell_start,cell_end)
doneAndHappy = [.false.,.true.]
NiterationMPstate = 0
convergenceLooping: do while (.not. (terminallyIll .or. doneAndHappy(1)) &
.and. NiterationMPstate < num%nMPstate)
NiterationMPstate = NiterationMPstate + 1
convergenceLooping: do while (.not. (terminallyIll .or. doneAndHappy(1)))
call mechanical_partition(homogenization_F(1:3,1:3,ce),ce)
converged = all([(phase_mechanical_constitutive(Delta_t,co,ce),co=1,homogenization_Nconstituents(ho))])

19
src/homogenization_damage.f90
View File

@ -151,20 +151,19 @@ end function homogenization_f_phi
!--------------------------------------------------------------------------------------------------
!> @brief Set damage field.
!--------------------------------------------------------------------------------------------------
module subroutine homogenization_set_phi(phi,ce)
module subroutine homogenization_set_phi(phi)
integer, intent(in) :: ce
real(pREAL), intent(in) :: phi
real(pREAL), dimension(:), intent(in) :: phi
integer :: &
ho, &
en
integer :: ho, en, ce
ho = material_ID_homogenization(ce)
en = material_entry_homogenization(ce)
damagestate_h(ho)%state(1,en) = phi
current(ho)%phi(en) = phi
do ce=lbound(phi,1), ubound(phi,1)
ho = material_ID_homogenization(ce)
en = material_entry_homogenization(ce)
damagestate_h(ho)%state(1,en) = phi(ce)
current(ho)%phi(en) = phi(ce)
end do
end subroutine homogenization_set_phi

56
src/homogenization_mechanical_RGC.f90
View File

@ -8,7 +8,7 @@
!--------------------------------------------------------------------------------------------------
submodule(homogenization:mechanical) RGC
use rotations
use lattice
use crystal
type :: tParameters
integer, dimension(:), allocatable :: &
@ -108,33 +108,33 @@ module subroutine RGC_init()
num_mechanical => num_homogenization%get_dict('mechanical',defaultVal=emptyDict)
num_RGC => num_mechanical%get_dict('RGC',defaultVal=emptyDict)
num%atol = num_RGC%get_asReal('atol', defaultVal=1.0e+4_pREAL)
num%rtol = num_RGC%get_asReal('rtol', defaultVal=1.0e-3_pREAL)
num%absMax = num_RGC%get_asReal('amax', defaultVal=1.0e+10_pREAL)
num%relMax = num_RGC%get_asReal('rmax', defaultVal=1.0e+2_pREAL)
num%pPert = num_RGC%get_asReal('perturbpenalty', defaultVal=1.0e-7_pREAL)
num%xSmoo = num_RGC%get_asReal('relvantmismatch', defaultVal=1.0e-5_pREAL)
num%viscPower = num_RGC%get_asReal('viscositypower', defaultVal=1.0e+0_pREAL)
num%viscModus = num_RGC%get_asReal('viscositymodulus', defaultVal=0.0e+0_pREAL)
num%refRelaxRate = num_RGC%get_asReal('refrelaxationrate', defaultVal=1.0e-3_pREAL)
num%maxdRelax = num_RGC%get_asReal('maxrelaxationrate', defaultVal=1.0e+0_pREAL)
num%maxVolDiscr = num_RGC%get_asReal('maxvoldiscrepancy', defaultVal=1.0e-5_pREAL)
num%volDiscrMod = num_RGC%get_asReal('voldiscrepancymod', defaultVal=1.0e+12_pREAL)
num%volDiscrPow = num_RGC%get_asReal('dicrepancypower', defaultVal=5.0_pREAL)
num%atol = num_RGC%get_asReal('eps_abs_P', defaultVal=1.0e+4_pREAL)
num%rtol = num_RGC%get_asReal('eps_rel_P', defaultVal=1.0e-3_pREAL)
num%absMax = num_RGC%get_asReal('eps_abs_max', defaultVal=1.0e+10_pREAL)
num%relMax = num_RGC%get_asReal('eps_rel_max', defaultVal=1.0e+2_pREAL)
num%pPert = num_RGC%get_asReal('Delta_a', defaultVal=1.0e-7_pREAL)
num%xSmoo = num_RGC%get_asReal('relevant_mismatch', defaultVal=1.0e-5_pREAL)
num%viscPower = num_RGC%get_asReal('viscosity_exponent', defaultVal=1.0e+0_pREAL)
num%viscModus = num_RGC%get_asReal('viscosity_modulus', defaultVal=0.0e+0_pREAL)
num%refRelaxRate = num_RGC%get_asReal('dot_a_ref', defaultVal=1.0e-3_pREAL)
num%maxdRelax = num_RGC%get_asReal('dot_a_max', defaultVal=1.0e+0_pREAL)
num%maxVolDiscr = num_RGC%get_asReal('Delta_V_max', defaultVal=1.0e-5_pREAL)
num%volDiscrMod = num_RGC%get_asReal('Delta_V_modulus', defaultVal=1.0e+12_pREAL)
num%volDiscrPow = num_RGC%get_asReal('Delta_V_exponent', defaultVal=5.0_pREAL)
if (num%atol <= 0.0_pREAL) call IO_error(301,ext_msg='absTol_RGC')
if (num%rtol <= 0.0_pREAL) call IO_error(301,ext_msg='relTol_RGC')
if (num%absMax <= 0.0_pREAL) call IO_error(301,ext_msg='absMax_RGC')
if (num%relMax <= 0.0_pREAL) call IO_error(301,ext_msg='relMax_RGC')
if (num%pPert <= 0.0_pREAL) call IO_error(301,ext_msg='pPert_RGC')
if (num%xSmoo <= 0.0_pREAL) call IO_error(301,ext_msg='xSmoo_RGC')
if (num%viscPower < 0.0_pREAL) call IO_error(301,ext_msg='viscPower_RGC')
if (num%viscModus < 0.0_pREAL) call IO_error(301,ext_msg='viscModus_RGC')
if (num%refRelaxRate <= 0.0_pREAL) call IO_error(301,ext_msg='refRelaxRate_RGC')
if (num%maxdRelax <= 0.0_pREAL) call IO_error(301,ext_msg='maxdRelax_RGC')
if (num%maxVolDiscr <= 0.0_pREAL) call IO_error(301,ext_msg='maxVolDiscr_RGC')
if (num%volDiscrMod < 0.0_pREAL) call IO_error(301,ext_msg='volDiscrMod_RGC')
if (num%volDiscrPow <= 0.0_pREAL) call IO_error(301,ext_msg='volDiscrPw_RGC')
if (num%atol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_abs_P')
if (num%rtol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_rel_P')
if (num%absMax <= 0.0_pREAL) call IO_error(301,ext_msg='eps_abs_max')
if (num%relMax <= 0.0_pREAL) call IO_error(301,ext_msg='eps_rel_max')
if (num%pPert <= 0.0_pREAL) call IO_error(301,ext_msg='Delta_a')
if (num%xSmoo <= 0.0_pREAL) call IO_error(301,ext_msg='relevant_mismatch')
if (num%viscPower < 0.0_pREAL) call IO_error(301,ext_msg='viscosity_exponent')
if (num%viscModus < 0.0_pREAL) call IO_error(301,ext_msg='viscosity_modulus')
if (num%refRelaxRate <= 0.0_pREAL) call IO_error(301,ext_msg='dot_a_ref')
if (num%maxdRelax <= 0.0_pREAL) call IO_error(301,ext_msg='dot_a_max')
if (num%maxVolDiscr <= 0.0_pREAL) call IO_error(301,ext_msg='Delta_V_max')
if (num%volDiscrMod < 0.0_pREAL) call IO_error(301,ext_msg='Delta_V_modulus')
if (num%volDiscrPow <= 0.0_pREAL) call IO_error(301,ext_msg='Delta_V_exponent')
do ho = 1, size(mechanical_type)
@ -654,7 +654,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
C = phase_homogenizedC66(material_ID_phase(co,ce),material_entry_phase(co,ce)) ! damage not included!
equivalentMu = lattice_isotropic_mu(C,'isostrain')
equivalentMu = crystal_isotropic_mu(C,'isostrain')
end function equivalentMu

17
src/homogenization_thermal.f90
View File

@ -173,15 +173,20 @@ end function homogenization_f_T
!--------------------------------------------------------------------------------------------------
!> @brief Set thermal field and its rate (T and dot_T).
!--------------------------------------------------------------------------------------------------
module subroutine homogenization_thermal_setField(T,dot_T, ce)
module subroutine homogenization_thermal_setField(T,dot_T)
integer, intent(in) :: ce
real(pREAL), intent(in) :: T, dot_T
real(pREAL), dimension(:), intent(in) :: T, dot_T
integer :: ho, en, ce
current(material_ID_homogenization(ce))%T(material_entry_homogenization(ce)) = T
current(material_ID_homogenization(ce))%dot_T(material_entry_homogenization(ce)) = dot_T
call thermal_partition(ce)
do ce=max(lbound(T,1),lbound(dot_T,1)), min(ubound(T,1),ubound(dot_T,1))
ho = material_ID_homogenization(ce)
en = material_entry_homogenization(ce)
current(ho)%T(en) = T(ce)
current(ho)%dot_T(en) = dot_T(ce)
call thermal_partition(ce)
end do
end subroutine homogenization_thermal_setField

4
src/materialpoint.f90
View File

@ -20,7 +20,7 @@ module materialpoint
use rotations
use polynomials
use tables
use lattice
use crystal
use material
use phase
use homogenization
@ -64,7 +64,7 @@ subroutine materialpoint_initAll()
call rotations_init()
call polynomials_init()
call tables_init()
call lattice_init()
call crystal_init()
#if defined(MESH)
call discretization_mesh_init(restart=CLI_restartInc>0)
#elif defined(GRID)

88
src/math.f90
View File

@ -24,11 +24,19 @@ module math
implicit none(type,external)
public
interface math_expand
module procedure math_expand_int
module procedure math_expand_real
end interface math_expand
#if __INTEL_COMPILER >= 1900
! do not make use of associated entities available to other modules
private :: &
misc, &
IO, &
config
config, &
parallelization
#endif
real(pREAL), parameter :: &
@ -38,11 +46,11 @@ module math
INRAD = TAU/360.0_pREAL !< conversion from degree to radian
real(pREAL), dimension(3,3), parameter :: &
math_I3 = reshape([&
1.0_pREAL,0.0_pREAL,0.0_pREAL, &
0.0_pREAL,1.0_pREAL,0.0_pREAL, &
0.0_pREAL,0.0_pREAL,1.0_pREAL &
],shape(math_I3)) !< 3x3 Identity
math_I3 = real(reshape([&
1, 0, 0, &
0, 1, 0, &
0, 0, 1 &
],shape(math_I3)),pREAL) !< 3x3 Identity
real(pREAL), dimension(*), parameter, private :: &
NRMMANDEL = [1.0_pREAL, 1.0_pREAL,1.0_pREAL, sqrt(2.0_pREAL), sqrt(2.0_pREAL), sqrt(2.0_pREAL)] !< forward weighting for Mandel notation
@ -83,9 +91,6 @@ module math
3,3 &
],shape(MAPPLAIN)) !< arrangement in Plain notation
!---------------------------------------------------------------------------------------------------
private :: &
selfTest
contains
@ -109,20 +114,21 @@ subroutine math_init()
allocate(seed(randSize))
if (num_generic%contains('random_seed')) then
seed = num_generic%get_as1dInt('random_seed',requiredSize=randSize)
seed = num_generic%get_as1dInt('random_seed',requiredSize=randSize) &
+ worldrank*42_MPI_INTEGER_KIND
else
call random_seed()
call random_seed(get = seed)
end if
call random_seed(put = seed + worldrank*42_MPI_INTEGER_KIND)
call random_seed(put = seed)
call random_number(randTest)
print'(/,a,i2)', ' size of random seed: ', randSize
print*, 'value of random seed: ', seed
print'( a,4(/,26x,f17.14))', ' start of random sequence: ', randTest
call selfTest()
call math_selfTest()
end subroutine math_init
@ -136,7 +142,7 @@ end subroutine math_init
pure recursive subroutine math_sort(a, istart, iend, sortDim)
integer, dimension(:,:), intent(inout) :: a
integer, intent(in),optional :: istart,iend, sortDim
integer, optional, intent(in) :: istart,iend, sortDim
integer :: ipivot,s,e,d
@ -198,12 +204,13 @@ end subroutine math_sort
!> @brief vector expansion
!> @details takes a set of numbers (a,b,c,...) and corresponding multiples (x,y,z,...)
!> to return a vector of x times a, y times b, z times c, ...
!> If there are more multiples than numbers, the numbers are treated as a ring, i.e. looped modulo their size
!--------------------------------------------------------------------------------------------------
pure function math_expand(what,how)
pure function math_expand_int(what,how)
real(pREAL), dimension(:), intent(in) :: what
integer, dimension(:), intent(in) :: how
real(pREAL), dimension(sum(how)) :: math_expand
integer, dimension(:), intent(in) :: what
integer, dimension(:), intent(in) :: how
integer, dimension(sum(how)) :: math_expand_int
integer :: i
@ -211,10 +218,34 @@ pure function math_expand(what,how)
if (sum(how) == 0) return
do i = 1, size(how)
math_expand(sum(how(1:i-1))+1:sum(how(1:i))) = what(mod(i-1,size(what))+1)
math_expand_int(sum(how(1:i-1))+1:sum(how(1:i))) = what(mod(i-1,size(what))+1)
end do
end function math_expand
end function math_expand_int
!--------------------------------------------------------------------------------------------------
!> @brief vector expansion
!> @details takes a set of numbers (a,b,c,...) and corresponding multiples (x,y,z,...)
!> to return a vector of x times a, y times b, z times c, ...
!> If there are more multiples than numbers, the numbers are treated as a ring, i.e. looped modulo their size
!--------------------------------------------------------------------------------------------------
pure function math_expand_real(what,how)
real(pREAL), dimension(:), intent(in) :: what
integer, dimension(:), intent(in) :: how
real(pREAL), dimension(sum(how)) :: math_expand_real
integer :: i
if (sum(how) == 0) return
do i = 1, size(how)
math_expand_real(sum(how(1:i-1))+1:sum(how(1:i))) = what(mod(i-1,size(what))+1)
end do
end function math_expand_real
!--------------------------------------------------------------------------------------------------
@ -1018,26 +1049,16 @@ pure subroutine math_eigh33(w,v,m)
U = max(T, T**2)
threshold = sqrt(5.68e-14_pREAL * U**2)
#ifndef __INTEL_LLVM_COMPILER
v(1:3,1) = [m(1,3)*w(1) + v(1,2), &
m(2,3)*w(1) + v(2,2), &
#else
v(1:3,1) = [IEEE_FMA(m(1,3),w(1),v(1,2)), &
IEEE_FMA(m(2,3),w(1),v(2,2)), &
#endif
(m(1,1) - w(1)) * (m(2,2) - w(1)) - v(3,2)]
norm = norm2(v(1:3, 1))
fallback1: if (norm < threshold) then
call math_eigh(w,v,error,m)
else fallback1
v(1:3,1) = v(1:3, 1) / norm
#ifndef __INTEL_LLVM_COMPILER
v(1:3,2) = [m(1,3)*w(2) + v(1,2), &
m(2,3)*w(2) + v(2,2), &
#else
v(1:3,2) = [IEEE_FMA(m(1,3),w(2),v(1,2)), &
IEEE_FMA(m(2,3),w(2),v(2,2)), &
#endif
(m(1,1) - w(2)) * (m(2,2) - w(2)) - v(3,2)]
norm = norm2(v(1:3, 2))
fallback2: if (norm < threshold) then
@ -1275,7 +1296,7 @@ end function math_clip
!--------------------------------------------------------------------------------------------------
!> @brief Check correctness of some math functions.
!--------------------------------------------------------------------------------------------------
subroutine selfTest()
subroutine math_selfTest()
integer, dimension(2,4) :: &
sort_in_ = reshape([+1,+5, +5,+6, -1,-1, +3,-2],[2,4])
@ -1309,7 +1330,10 @@ subroutine selfTest()
if (any(abs([1.0_pREAL,2.0_pREAL,2.0_pREAL,1.0_pREAL,1.0_pREAL,1.0_pREAL] - &
math_expand([1.0_pREAL,2.0_pREAL],[1,2,3])) > tol_math_check)) &
error stop 'math_expand [1,2] by [1,2,3] => [1,2,2,1,1,1]'
error stop 'math_expand_real [1,2] by [1,2,3] => [1,2,2,1,1,1]'
if (any(abs([1,2,2,1,1,1] - math_expand([1,2],[1,2,3])) /= 0)) &
error stop 'math_expand_int [1,2] by [1,2,3] => [1,2,2,1,1,1]'
call math_sort(sort_in_,1,3,2)
if (any(sort_in_ /= sort_out_)) &
@ -1447,6 +1471,6 @@ subroutine selfTest()
error stop 'math_normal(sigma)'
end block normal_distribution
end subroutine selfTest
end subroutine math_selfTest
end module math

16
src/mesh/DAMASK_mesh.f90
View File

@ -66,6 +66,7 @@ program DAMASK_mesh
stagIter, &
component
type(tDict), pointer :: &
num_solver, &
num_mesh
character(len=pSTRLEN), dimension(:), allocatable :: fileContent
character(len=pSTRLEN) :: &
@ -90,12 +91,13 @@ program DAMASK_mesh
!---------------------------------------------------------------------
! reading field information from numerics file and do sanity checks
num_mesh => config_numerics%get_dict('mesh', defaultVal=emptyDict)
stagItMax = num_mesh%get_asInt('maxStaggeredIter',defaultVal=10)
maxCutBack = num_mesh%get_asInt('maxCutBack',defaultVal=3)
num_solver => config_numerics%get_dict('solver',defaultVal=emptyDict)
num_mesh => num_solver%get_dict('mesh',defaultVal=emptyDict)
stagItMax = num_mesh%get_asInt('N_staggered_iter_max',defaultVal=10)
maxCutBack = num_mesh%get_asInt('N_cutback_max',defaultVal=3)
if (stagItMax < 0) call IO_error(301,ext_msg='maxStaggeredIter')
if (maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack')
if (stagItMax < 0) call IO_error(301,ext_msg='N_staggered_iter_max')
if (maxCutBack < 0) call IO_error(301,ext_msg='N_cutback_max')
! reading basic information from load case file and allocate data structure containing load cases
call DMGetDimension(geomMesh,dimPlex,err_PETSc) !< dimension of mesh (2D or 3D)
@ -229,8 +231,8 @@ program DAMASK_mesh
!--------------------------------------------------------------------------------------------------
! doing initialization depending on active solvers
call FEM_Utilities_init()
call FEM_mechanical_init(loadCases(1)%fieldBC(1))
call FEM_Utilities_init(num_mesh)
call FEM_mechanical_init(loadCases(1)%fieldBC(1),num_mesh)
call config_numerics_deallocate()
if (worldrank == 0) then

32
src/mesh/FEM_utilities.f90
View File

@ -16,6 +16,7 @@ module FEM_utilities
use prec
use config
use math
use misc
use IO
use discretization_mesh
use homogenization
@ -90,11 +91,16 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief Allocate all neccessary fields.
!--------------------------------------------------------------------------------------------------
subroutine FEM_utilities_init
subroutine FEM_utilities_init(num_mesh)
character(len=pSTRLEN) :: petsc_optionsOrder
type(tDict), pointer :: &
type(tDict), pointer, intent(in) :: &
num_mesh
type(tDict), pointer :: &
num_mech
character(len=pSTRLEN) :: petsc_optionsOrder
character(len=:), allocatable :: &
petsc_options
integer :: &
p_s, & !< order of shape functions
p_i !< integration order (quadrature rule)
@ -103,7 +109,7 @@ subroutine FEM_utilities_init
print'(/,1x,a)', '<<<+- FEM_utilities init -+>>>'
num_mesh => config_numerics%get_dict('mesh',defaultVal=emptyDict)
num_mech => num_mesh%get_dict('mechanical', defaultVal=emptyDict)
p_s = num_mesh%get_asInt('p_s',defaultVal = 2)
p_i = num_mesh%get_asInt('p_i',defaultVal = p_s)
@ -117,20 +123,20 @@ subroutine FEM_utilities_init
call PetscOptionsClear(PETSC_NULL_OPTIONS,err_PETSc)
CHKERRQ(err_PETSc)
CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type newtonls &
&-mechanical_snes_linesearch_type cp -mechanical_snes_ksp_ew &
&-mechanical_snes_ksp_ew_rtol0 0.01 -mechanical_snes_ksp_ew_rtolmax 0.01 &
&-mechanical_ksp_type fgmres -mechanical_ksp_max_it 25', err_PETSc)
CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_mesh%get_asStr('PETSc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc)
petsc_options = misc_prefixOptions('-snes_type newtonls &
&-snes_linesearch_type cp -snes_ksp_ew &
&-snes_ksp_ew_rtol0 0.01 -snes_ksp_ew_rtolmax 0.01 &
&-ksp_type fgmres -ksp_max_it 25 ' // &
num_mech%get_asStr('PETSc_options',defaultVal=''), 'mechanical_')
write(petsc_optionsOrder,'(a,i0)') '-mechFE_petscspace_degree ', p_s
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsOrder),err_PETSc)
petsc_options = petsc_options // ' ' // petsc_optionsOrder
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc)
CHKERRQ(err_PETSc)
wgt = real(mesh_maxNips*mesh_NcpElemsGlobal,pREAL)**(-1)
end subroutine FEM_utilities_init

8
src/mesh/discretization_mesh.f90
View File

@ -56,7 +56,7 @@ module discretization_mesh
real(pREAL), dimension(:,:,:), allocatable :: &
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!)
#ifdef PETSC_USE_64BIT_INDICES
#if defined(PETSC_USE_64BIT_INDICES) || PETSC_VERSION_MINOR < 17
external :: &
DMDestroy
#endif
@ -89,6 +89,7 @@ subroutine discretization_mesh_init(restart)
PetscInt, dimension(:), allocatable :: &
materialAt
type(tDict), pointer :: &
num_solver, &
num_mesh
integer :: p_i, dim !< integration order (quadrature rule)
type(tvec) :: coords_node0
@ -99,8 +100,9 @@ subroutine discretization_mesh_init(restart)
!--------------------------------------------------------------------------------
! read numerics parameter
num_mesh => config_numerics%get_dict('mesh',defaultVal=emptyDict)
p_i = num_mesh%get_asInt('p_i',defaultVal = 2)
num_solver => config_numerics%get_dict('solver',defaultVal=emptyDict)
num_mesh => num_solver%get_dict('mesh',defaultVal=emptyDict)
p_i = num_mesh%get_asInt('p_i',defaultVal=2)
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>16)
call DMPlexCreateFromFile(PETSC_COMM_WORLD,CLI_geomFile,'n/a',PETSC_TRUE,globalMesh,err_PETSc)

38
src/mesh/mesh_mech_FEM.f90
View File

@ -47,7 +47,7 @@ module mesh_mechanical_FEM
p_i, & !< integration order (quadrature rule)
itmax
logical :: &
BBarStabilisation
BBarStabilization
real(pREAL) :: &
eps_struct_atol, & !< absolute tolerance for mechanical equilibrium
eps_struct_rtol !< relative tolerance for mechanical equilibrium
@ -72,7 +72,7 @@ module mesh_mechanical_FEM
real(pREAL), parameter :: eps = 1.0e-18_pREAL
external :: & ! ToDo: write interfaces
#ifdef PETSC_USE_64BIT_INDICES
#if defined(PETSC_USE_64BIT_INDICES) || PETSC_VERSION_MINOR < 17
ISDestroy, &
#endif
PetscSectionGetNumFields, &
@ -94,9 +94,10 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields and fills them with data
!--------------------------------------------------------------------------------------------------
subroutine FEM_mechanical_init(fieldBC)
subroutine FEM_mechanical_init(fieldBC,num_mesh)
type(tFieldBC), intent(in) :: fieldBC
type(tFieldBC), intent(in) :: fieldBC
type(tDict), pointer, intent(in) :: num_mesh
DM :: mechanical_mesh
PetscFE :: mechFE
@ -126,23 +127,24 @@ subroutine FEM_mechanical_init(fieldBC)
character(len=*), parameter :: prefix = 'mechFE_'
PetscErrorCode :: err_PETSc
real(pREAL), dimension(3,3) :: devNull
type(tDict), pointer :: &
num_mesh
type(tDict), pointer :: num_mech
print'(/,1x,a)', '<<<+- FEM_mech init -+>>>'; flush(IO_STDOUT)
!-----------------------------------------------------------------------------
! read numerical parametes and do sanity checks
num_mesh => config_numerics%get_dict('mesh',defaultVal=emptyDict)
num%p_i = int(num_mesh%get_asInt('p_i',defaultVal = 2),pPETSCINT)
num%itmax = int(num_mesh%get_asInt('itmax',defaultVal=250),pPETSCINT)
num%BBarStabilisation = num_mesh%get_asBool('bbarstabilisation',defaultVal = .false.)
num%eps_struct_atol = num_mesh%get_asReal('eps_struct_atol', defaultVal = 1.0e-10_pREAL)
num%eps_struct_rtol = num_mesh%get_asReal('eps_struct_rtol', defaultVal = 1.0e-4_pREAL)
num_mech => num_mesh%get_dict('mechanical', defaultVal=emptyDict)
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax')
if (num%eps_struct_rtol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_struct_rtol')
if (num%eps_struct_atol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_struct_atol')
num%p_i = int(num_mesh%get_asInt('p_i',defaultVal=2),pPETSCINT)
num%BBarStabilization = num_mesh%get_asBool('bbarstabilization',defaultVal=.false.)
num%itmax = int(num_mech%get_asInt('N_iter_max',defaultVal=250),pPETSCINT)
num%eps_struct_atol = num_mech%get_asReal('eps_abs_div(P)', defaultVal=1.0e-10_pREAL)
num%eps_struct_rtol = num_mech%get_asReal('eps_rel_div(P)', defaultVal=1.0e-4_pREAL)
if (num%itmax <= 1) call IO_error(301,ext_msg='N_iter_max')
if (num%eps_struct_rtol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_rel_div(P)')
if (num%eps_struct_atol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_abs_div(P)')
!--------------------------------------------------------------------------------------------------
! Setup FEM mech mesh
@ -437,7 +439,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
end do
homogenization_F(1:dimPlex,1:dimPlex,m) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1])
end do
if (num%BBarStabilisation) then
if (num%BBarStabilization) then
detFAvg = math_det33(sum(homogenization_F(1:3,1:3,cell*nQuadrature+1:(cell+1)*nQuadrature),dim=3)/real(nQuadrature,pREAL))
do qPt = 0, nQuadrature-1
m = cell*nQuadrature + qPt+1
@ -588,7 +590,7 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
MatA = matmul(reshape(reshape(homogenization_dPdF(1:dimPlex,1:dimPlex,1:dimPlex,1:dimPlex,m), &
shape=[dimPlex,dimPlex,dimPlex,dimPlex], order=[2,1,4,3]), &
shape=[dimPlex*dimPlex,dimPlex*dimPlex]),BMat)*qWeights(qPt+1_pPETSCINT)
if (num%BBarStabilisation) then
if (num%BBarStabilization) then
F(1:dimPlex,1:dimPlex) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex])
FInv = math_inv33(F)
K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0_pREAL/real(dimPlex,pREAL))
@ -604,7 +606,7 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
K_eA = K_eA + matmul(transpose(BMat),MatA)
end if
end do
if (num%BBarStabilisation) then
if (num%BBarStabilization) then
FInv = math_inv33(FAvg)
K_e = K_eA*math_det33(FAvg/real(nQuadrature,pREAL))**(1.0_pREAL/real(dimPlex,pREAL)) + &
(matmul(matmul(transpose(BMatAvg), &

33
src/misc.f90
View File

@ -5,6 +5,7 @@
!--------------------------------------------------------------------------------------------------
module misc
use prec
use constants
implicit none(type,external)
private
@ -18,7 +19,9 @@ module misc
public :: &
misc_init, &
misc_optional
misc_selfTest, &
misc_optional, &
misc_prefixOptions
contains
@ -110,6 +113,28 @@ pure function misc_optional_str(given,default) result(var)
end function misc_optional_str
!--------------------------------------------------------------------------------------------------
!> @brief Add prefix to options in string.
!> @detail An option starts with a dash followed by at least one letter.
!--------------------------------------------------------------------------------------------------
pure function misc_prefixOptions(string,prefix) result(prefixed)
character(len=*), intent(in) :: string,prefix
character(len=:), allocatable :: prefixed
integer :: i,N
prefixed = ''
N = len(string)
do i = 1, N
prefixed = prefixed//string(i:i)
if (string(i:i) == '-' .and. verify(string(min(i+1,N):min(i+1,N)),LOWER//UPPER) == 0) &
prefixed = prefixed//prefix
end do
end function misc_prefixOptions
!--------------------------------------------------------------------------------------------------
!> @brief Check correctness of some misc functions.
@ -117,6 +142,8 @@ end function misc_optional_str
subroutine misc_selfTest()
real(pREAL) :: r
character(len=:), allocatable :: str,out
call random_number(r)
if (test_str('DAMASK') /= 'DAMASK') error stop 'optional_str, present'
@ -132,6 +159,10 @@ subroutine misc_selfTest()
if (.not. test_bool()) error stop 'optional_bool, not present'
if (misc_optional(default=r>0.5_pREAL) .neqv. r>0.5_pREAL) error stop 'optional_bool, default only'
str='-a -1 -more 123 -flag -'
out=misc_prefixOptions(str,'p_')
if (out /= '-p_a -1 -p_more 123 -p_flag -') error stop 'misc_prefixOptions'
contains
function test_str(str_in) result(str_out)

95
src/phase.f90
View File

@ -14,7 +14,7 @@ module phase
use config
use material
use result
use lattice
use crystal
use discretization
use parallelization
use HDF5
@ -49,6 +49,29 @@ module phase
type(tState), dimension(:), allocatable :: p !< tState for each active source mechanism in a phase
end type
enum, bind(c); enumerator :: &
UNDEFINED, &
MECHANICAL_PLASTICITY_NONE, &
MECHANICAL_PLASTICITY_ISOTROPIC, &
MECHANICAL_PLASTICITY_PHENOPOWERLAW, &
MECHANICAL_PLASTICITY_KINEHARDENING, &
MECHANICAL_PLASTICITY_DISLOTWIN, &
MECHANICAL_PLASTICITY_DISLOTUNGSTEN, &
MECHANICAL_PLASTICITY_NONLOCAL, &
MECHANICAL_EIGEN_THERMALEXPANSION, &
DAMAGE_ISOBRITTLE, &
DAMAGE_ANISOBRITTLE, &
THERMAL_SOURCE_DISSIPATION, &
THERMAL_SOURCE_EXTERNALHEAT
end enum
integer(kind(UNDEFINED)), dimension(:), allocatable :: &
mechanical_plasticity_type, & !< plasticity of each phase
damage_type !< damage type of each phase
integer(kind(UNDEFINED)), dimension(:,:), allocatable :: &
thermal_source_type, &
mechanical_eigen_kinematics_type
character(len=2), allocatable, dimension(:) :: phase_lattice
real(pREAL), allocatable, dimension(:) :: phase_cOverA
@ -61,17 +84,21 @@ module phase
type :: tNumerics
integer :: &
iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp
iJacoLiresiduum, & !< frequency of Jacobian update of residuum in Li
nState, & !< state loop limit
nStress !< stress loop limit
nStress_Lp, & !< stress loop limit for Lp
nStress_Li !< stress loop limit for Li
real(pREAL) :: &
subStepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback
subStepSizeCryst, & !< size of first substep when cutback
subStepSizeLp, & !< size of first substep when cutback in Lp calculation
subStepSizeLi, & !< size of first substep when cutback in Li calculation
stepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback
stepSizeCryst, & !< size of first substep when cutback
stepSizeLp, & !< size of first substep when cutback in Lp calculation
stepSizeLi, & !< size of first substep when cutback in Li calculation
stepIncreaseCryst, & !< increase of next substep size when previous substep converged
rtol_crystalliteState, & !< relative tolerance in state loop
rtol_crystalliteStress, & !< relative tolerance in stress loop
atol_crystalliteStress !< absolute tolerance in stress loop
rtol_crystalliteState, &
rtol_Lp, & !< relative tolerance in stress loop for Lp
atol_Lp, & !< absolute tolerance in stress loop for Lp
rtol_Li, & !< relative tolerance in stress loop for Li
atol_Li !< absolute tolerance in stress loop for Li
end type tNumerics
type(tNumerics) :: num ! numerics parameters. Better name?
@ -85,8 +112,8 @@ module phase
interface
! == cleaned:begin =================================================================================
module subroutine mechanical_init(phases)
type(tDict), pointer :: phases
module subroutine mechanical_init(phases,num_mech)
type(tDict), pointer :: phases, num_mech
end subroutine mechanical_init
module subroutine damage_init
@ -336,7 +363,7 @@ module phase
config, &
material, &
result, &
lattice, &
crystal, &
discretization, &
HDF5_utilities
#endif
@ -381,7 +408,9 @@ subroutine phase_init
ph, ce, co, ma
type(tDict), pointer :: &
phases, &
phase
phase, &
num_phase, &
num_mech
character(len=:), allocatable :: refs
@ -398,12 +427,12 @@ subroutine phase_init
phase => phases%get_dict(ph)
refs = config_listReferences(phase,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs
phase_rho(ph) = phase%get_asReal('rho',defaultVal=0.0_pREAL)
phase_lattice(ph) = phase%get_asStr('lattice')
if (all(phase_lattice(ph) /= ['cF','cI','hP','tI'])) &
call IO_error(130,ext_msg='phase_init: '//phase%get_asStr('lattice'))
if (any(phase_lattice(ph) == ['hP','tI'])) &
phase_cOverA(ph) = phase%get_asReal('c/a')
phase_rho(ph) = phase%get_asReal('rho',defaultVal=0.0_pREAL)
allocate(phase_O_0(ph)%data(count(material_ID_phase==ph)))
end do
@ -420,7 +449,10 @@ subroutine phase_init
phase_O(ph)%data = phase_O_0(ph)%data
end do
call mechanical_init(phases)
num_phase => config_numerics%get_dict('phase',defaultVal=emptyDict)
num_mech => num_phase%get_dict('mechanical', defaultVal=emptyDict)
call mechanical_init(phases,num_mech)
call damage_init()
call thermal_init(phases)
@ -531,39 +563,8 @@ subroutine crystallite_init()
el, & !< counter in element loop
en, ph
type(tDict), pointer :: &
num_crystallite, &
num_phase, &
phases
character(len=:), allocatable :: extmsg
num_crystallite => config_numerics%get_dict('crystallite',defaultVal=emptyDict)
num%subStepMinCryst = num_crystallite%get_asReal ('subStepMin', defaultVal=1.0e-3_pREAL)
num%subStepSizeCryst = num_crystallite%get_asReal ('subStepSize', defaultVal=0.25_pREAL)
num%stepIncreaseCryst = num_crystallite%get_asReal ('stepIncrease', defaultVal=1.5_pREAL)
num%subStepSizeLp = num_crystallite%get_asReal ('subStepSizeLp', defaultVal=0.5_pREAL)
num%subStepSizeLi = num_crystallite%get_asReal ('subStepSizeLi', defaultVal=0.5_pREAL)
num%rtol_crystalliteState = num_crystallite%get_asReal ('rtol_State', defaultVal=1.0e-6_pREAL)
num%rtol_crystalliteStress = num_crystallite%get_asReal ('rtol_Stress', defaultVal=1.0e-6_pREAL)
num%atol_crystalliteStress = num_crystallite%get_asReal ('atol_Stress', defaultVal=1.0e-8_pREAL)
num%iJacoLpresiduum = num_crystallite%get_asInt ('iJacoLpresiduum', defaultVal=1)
num%nState = num_crystallite%get_asInt ('nState', defaultVal=20)
num%nStress = num_crystallite%get_asInt ('nStress', defaultVal=40)
extmsg = ''
if (num%subStepMinCryst <= 0.0_pREAL) extmsg = trim(extmsg)//' subStepMinCryst'
if (num%subStepSizeCryst <= 0.0_pREAL) extmsg = trim(extmsg)//' subStepSizeCryst'
if (num%stepIncreaseCryst <= 0.0_pREAL) extmsg = trim(extmsg)//' stepIncreaseCryst'
if (num%subStepSizeLp <= 0.0_pREAL) extmsg = trim(extmsg)//' subStepSizeLp'
if (num%subStepSizeLi <= 0.0_pREAL) extmsg = trim(extmsg)//' subStepSizeLi'
if (num%rtol_crystalliteState <= 0.0_pREAL) extmsg = trim(extmsg)//' rtol_crystalliteState'
if (num%rtol_crystalliteStress <= 0.0_pREAL) extmsg = trim(extmsg)//' rtol_crystalliteStress'
if (num%atol_crystalliteStress <= 0.0_pREAL) extmsg = trim(extmsg)//' atol_crystalliteStress'
if (num%iJacoLpresiduum < 1) extmsg = trim(extmsg)//' iJacoLpresiduum'
if (num%nState < 1) extmsg = trim(extmsg)//' nState'
if (num%nStress < 1) extmsg = trim(extmsg)//' nStress'
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
phases => config_material%get_dict('phase')

56
src/phase_damage.f90
View File

@ -9,23 +9,14 @@ submodule(phase) damage
l_c = 0.0_pREAL !< characteristic length
end type tDamageParameters
enum, bind(c); enumerator :: &
DAMAGE_UNDEFINED_ID, &
DAMAGE_ISOBRITTLE_ID, &
DAMAGE_ANISOBRITTLE_ID
end enum
integer :: phase_damage_maxSizeDotState
type :: tDataContainer
type :: tFieldQuantities
real(pREAL), dimension(:), allocatable :: phi
end type tDataContainer
end type tFieldQuantities
integer(kind(DAMAGE_UNDEFINED_ID)), dimension(:), allocatable :: &
phase_damage !< active sources mechanisms of each phase
type(tDataContainer), dimension(:), allocatable :: current
type(tFieldQuantities), dimension(:), allocatable :: current
type(tDamageParameters), dimension(:), allocatable :: param
@ -114,11 +105,11 @@ module subroutine damage_init()
end do
allocate(phase_damage(phases%length), source = DAMAGE_UNDEFINED_ID)
allocate(damage_type(phases%length), source = UNDEFINED)
if (damage_active) then
where(isobrittle_init() ) phase_damage = DAMAGE_ISOBRITTLE_ID
where(anisobrittle_init()) phase_damage = DAMAGE_ANISOBRITTLE_ID
where(isobrittle_init() ) damage_type = DAMAGE_ISOBRITTLE
where(anisobrittle_init()) damage_type = DAMAGE_ANISOBRITTLE
end if
phase_damage_maxSizeDotState = maxval(damageState%sizeDotState)
@ -159,8 +150,8 @@ module function phase_damage_C66(C66,ph,en) result(C66_degraded)
real(pREAL), dimension(6,6) :: C66_degraded
damageType: select case (phase_damage(ph))
case (DAMAGE_ISOBRITTLE_ID) damageType
damageType: select case (damage_type(ph))
case (DAMAGE_ISOBRITTLE) damageType
C66_degraded = C66 * damage_phi(ph,en)**2
case default damageType
C66_degraded = C66
@ -204,13 +195,14 @@ module function phase_f_phi(phi,co,ce) result(f)
ph, &
en
ph = material_ID_phase(co,ce)
en = material_entry_phase(co,ce)
select case(phase_damage(ph))
case(DAMAGE_ISOBRITTLE_ID,DAMAGE_ANISOBRITTLE_ID)
select case(damage_type(ph))
case(DAMAGE_ISOBRITTLE,DAMAGE_ANISOBRITTLE)
f = 1.0_pREAL &
- 2.0_pREAL * phi*damageState(ph)%state(1,en)
- 2.0_pREAL * phi*damageState(ph)%state(1,en) ! ToDo: MD: seems to be phi**2
case default
f = 0.0_pREAL
end select
@ -318,8 +310,8 @@ module subroutine damage_restartWrite(groupHandle,ph)
integer, intent(in) :: ph
select case(phase_damage(ph))
case(DAMAGE_ISOBRITTLE_ID,DAMAGE_ANISOBRITTLE_ID)
select case(damage_type(ph))
case(DAMAGE_ISOBRITTLE,DAMAGE_ANISOBRITTLE)
call HDF5_write(damageState(ph)%state,groupHandle,'omega_damage')
end select
@ -332,8 +324,8 @@ module subroutine damage_restartRead(groupHandle,ph)
integer, intent(in) :: ph
select case(phase_damage(ph))
case(DAMAGE_ISOBRITTLE_ID,DAMAGE_ANISOBRITTLE_ID)
select case(damage_type(ph))
case(DAMAGE_ISOBRITTLE,DAMAGE_ANISOBRITTLE)
call HDF5_read(damageState(ph)%state0,groupHandle,'omega_damage')
end select
@ -350,15 +342,15 @@ module subroutine damage_result(group,ph)
integer, intent(in) :: ph
if (phase_damage(ph) /= DAMAGE_UNDEFINED_ID) &
if (damage_type(ph) /= UNDEFINED) &
call result_closeGroup(result_addGroup(group//'damage'))
sourceType: select case (phase_damage(ph))
sourceType: select case (damage_type(ph))
case (DAMAGE_ISOBRITTLE_ID) sourceType
case (DAMAGE_ISOBRITTLE) sourceType
call isobrittle_result(ph,group//'damage/')
case (DAMAGE_ANISOBRITTLE_ID) sourceType
case (DAMAGE_ANISOBRITTLE) sourceType
call anisobrittle_result(ph,group//'damage/')
end select sourceType
@ -381,9 +373,9 @@ function phase_damage_collectDotState(ph,en) result(broken)
if (damageState(ph)%sizeState > 0) then
sourceType: select case (phase_damage(ph))
sourceType: select case (damage_type(ph))
case (DAMAGE_ANISOBRITTLE_ID) sourceType
case (DAMAGE_ANISOBRITTLE) sourceType
call anisobrittle_dotState(mechanical_S(ph,en), ph,en) ! ToDo: use M_d
end select sourceType
@ -446,9 +438,9 @@ function phase_damage_deltaState(Fe, ph, en) result(broken)
if (damageState(ph)%sizeState == 0) return
sourceType: select case (phase_damage(ph))
sourceType: select case (damage_type(ph))
case (DAMAGE_ISOBRITTLE_ID) sourceType
case (DAMAGE_ISOBRITTLE) sourceType
call isobrittle_deltaState(phase_homogenizedC66(ph,en), Fe, ph,en)
broken = any(IEEE_is_NaN(damageState(ph)%deltaState(:,en)))
if (.not. broken) then

6
src/phase_damage_anisobrittle.f90
View File

@ -50,7 +50,7 @@ module function anisobrittle_init() result(mySources)
if (count(mySources) == 0) return
print'(/,1x,a)', '<<<+- phase:damage:anisobrittle init -+>>>'
print'(/,a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT)
print'(/,1x,a,1x,i0)', '# phases:',count(mySources); flush(IO_STDOUT)
phases => config_material%get_dict('phase')
@ -64,7 +64,7 @@ module function anisobrittle_init() result(mySources)
associate(prm => param(ph))
print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
print'(/,1x,a,1x,i0,a)', 'phase',ph,': '//phases%key(ph)
refs = config_listReferences(src,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs
@ -77,7 +77,7 @@ module function anisobrittle_init() result(mySources)
prm%s_crit = src%get_as1dReal('s_crit',requiredSize=size(N_cl))
prm%g_crit = src%get_as1dReal('g_crit',requiredSize=size(N_cl))
prm%cleavage_systems = lattice_SchmidMatrix_cleavage(N_cl,phase_lattice(ph),phase_cOverA(ph))
prm%cleavage_systems = crystal_SchmidMatrix_cleavage(N_cl,phase_lattice(ph),phase_cOverA(ph))
! expand: family => system
prm%s_crit = math_expand(prm%s_crit,N_cl)

4
src/phase_damage_isobrittle.f90
View File

@ -48,7 +48,7 @@ module function isobrittle_init() result(mySources)
if (count(mySources) == 0) return
print'(/,1x,a)', '<<<+- phase:damage:isobrittle init -+>>>'
print'(/,a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT)
print'(/,1x,a,1x,i0)', '# phases:',count(mySources); flush(IO_STDOUT)
phases => config_material%get_dict('phase')
@ -66,7 +66,7 @@ module function isobrittle_init() result(mySources)
prm%W_crit = src%get_asReal('G_crit')/src%get_asReal('l_c')
print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
print'(/,1x,a,1x,i0,a)', 'phase',ph,': '//phases%key(ph)
refs = config_listReferences(src,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs

280
src/phase_mechanical.f90
View File

@ -3,21 +3,6 @@
!----------------------------------------------------------------------------------------------------
submodule(phase) mechanical
enum, bind(c); enumerator :: &
PLASTIC_UNDEFINED_ID, &
PLASTIC_NONE_ID, &
PLASTIC_ISOTROPIC_ID, &
PLASTIC_PHENOPOWERLAW_ID, &
PLASTIC_KINEHARDENING_ID, &
PLASTIC_DISLOTWIN_ID, &
PLASTIC_DISLOTUNGSTEN_ID, &
PLASTIC_NONLOCAL_ID, &
EIGEN_UNDEFINED_ID, &
EIGEN_CLEAVAGE_OPENING_ID, &
EIGEN_THERMAL_EXPANSION_ID
end enum
type(tTensorContainer), dimension(:), allocatable :: &
! current value
phase_mechanical_Fe, &
@ -37,9 +22,6 @@ submodule(phase) mechanical
phase_mechanical_S0
integer(kind(PLASTIC_undefined_ID)), dimension(:), allocatable :: &
phase_plasticity !< plasticity of each phase
interface
module subroutine eigen_init(phases)
@ -198,10 +180,11 @@ contains
!> @brief Initialize mechanical field related constitutive models
!> @details Initialize elasticity, plasticity and stiffness degradation models.
!--------------------------------------------------------------------------------------------------
module subroutine mechanical_init(phases)
module subroutine mechanical_init(phases, num_mech)
type(tDict), pointer :: &
phases
phases, &
num_mech
integer :: &
ce, &
@ -211,9 +194,11 @@ module subroutine mechanical_init(phases)
en, &
Nmembers
type(tDict), pointer :: &
num_crystallite, &
phase, &
mech
mech, &
num_mech_plastic, &
num_mech_eigen
character(len=:), allocatable :: extmsg
print'(/,1x,a)', '<<<+- phase:mechanical init -+>>>'
@ -283,15 +268,50 @@ module subroutine mechanical_init(phases)
call elastic_init(phases)
allocate(plasticState(phases%length))
allocate(phase_plasticity(phases%length),source = PLASTIC_UNDEFINED_ID)
allocate(mechanical_plasticity_type(phases%length),source = UNDEFINED)
call plastic_init()
do ph = 1,phases%length
plasticState(ph)%state0 = plasticState(ph)%state
end do
num_crystallite => config_numerics%get_dict('crystallite',defaultVal=emptyDict)
num_mech_plastic => num_mech%get_dict('plastic', defaultVal=emptyDict)
num_mech_eigen => num_mech%get_dict('eigen', defaultVal=emptyDict)
select case(num_crystallite%get_asStr('integrator',defaultVal='FPI'))
num%stepMinCryst = num_mech%get_asReal ('r_cutback_min', defaultVal=1.0e-3_pREAL)
num%stepSizeCryst = num_mech%get_asReal ('r_cutback', defaultVal=0.25_pREAL)
num%stepIncreaseCryst = num_mech%get_asReal ('r_increase', defaultVal=1.5_pREAL)
num%rtol_crystalliteState = num_mech%get_asReal ('eps_rel_state', defaultVal=1.0e-6_pREAL)
num%nState = num_mech%get_asInt ('N_iter_state_max', defaultVal=20)
num%nStress_Lp = num_mech_plastic%get_asInt ('N_iter_Lp_max', defaultVal=40)
num%stepSizeLp = num_mech_plastic%get_asReal ('r_linesearch_Lp', defaultVal=0.5_pREAL)
num%rtol_Lp = num_mech_plastic%get_asReal ('eps_rel_Lp', defaultVal=1.0e-6_pREAL)
num%atol_Lp = num_mech_plastic%get_asReal ('eps_abs_Lp', defaultVal=1.0e-8_pREAL)
num%iJacoLpresiduum = num_mech_plastic%get_asInt ('f_update_jacobi_Lp', defaultVal=1)
num%nStress_Li = num_mech_eigen%get_asInt ('N_iter_Li_max', defaultVal=40)
num%stepSizeLi = num_mech_eigen%get_asReal ('r_linesearch_Li', defaultVal=0.5_pREAL)
num%rtol_Li = num_mech_eigen%get_asReal ('eps_rel_Li', defaultVal=num%rtol_Lp)
num%atol_Li = num_mech_eigen%get_asReal ('eps_abs_Li', defaultVal=num%atol_Lp)
num%iJacoLiresiduum = num_mech_eigen%get_asInt ('f_update_jacobi_Li', defaultVal=num%iJacoLpresiduum)
extmsg = ''
if (num%stepMinCryst <= 0.0_pREAL) extmsg = trim(extmsg)//' r_cutback_min'
if (num%stepSizeCryst <= 0.0_pREAL) extmsg = trim(extmsg)//' r_cutback'
if (num%stepIncreaseCryst <= 0.0_pREAL) extmsg = trim(extmsg)//' r_increase'
if (num%stepSizeLp <= 0.0_pREAL) extmsg = trim(extmsg)//' r_linesearch_Lp'
if (num%stepSizeLi <= 0.0_pREAL) extmsg = trim(extmsg)//' r_linesearch_Li'
if (num%rtol_Lp <= 0.0_pREAL) extmsg = trim(extmsg)//' epl_rel_Lp'
if (num%atol_Lp <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_Lp'
if (num%rtol_Li <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_Li'
if (num%atol_Li <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_Li'
if (num%iJacoLpresiduum < 1) extmsg = trim(extmsg)//' f_update_jacobi_Lp'
if (num%iJacoLiresiduum < 1) extmsg = trim(extmsg)//' f_update_jacobi_Li'
if (num%nState < 1) extmsg = trim(extmsg)//' N_iter_state_max'
if (num%nStress_Lp < 1) extmsg = trim(extmsg)//' N_iter_Lp_max'
if (num%nStress_Li < 1) extmsg = trim(extmsg)//' N_iter_Li_max'
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
select case(num_mech_plastic%get_asStr('integrator_state',defaultVal='FPI'))
case('FPI')
integrateState => integrateStateFPI
@ -327,24 +347,24 @@ module subroutine mechanical_result(group,ph)
call results(group,ph)
select case(phase_plasticity(ph))
select case(mechanical_plasticity_type(ph))
case(PLASTIC_ISOTROPIC_ID)
case(MECHANICAL_PLASTICITY_ISOTROPIC)
call plastic_isotropic_result(ph,group//'mechanical/')
case(PLASTIC_PHENOPOWERLAW_ID)
case(MECHANICAL_PLASTICITY_PHENOPOWERLAW)
call plastic_phenopowerlaw_result(ph,group//'mechanical/')
case(PLASTIC_KINEHARDENING_ID)
case(MECHANICAL_PLASTICITY_KINEHARDENING)
call plastic_kinehardening_result(ph,group//'mechanical/')
case(PLASTIC_DISLOTWIN_ID)
case(MECHANICAL_PLASTICITY_DISLOTWIN)
call plastic_dislotwin_result(ph,group//'mechanical/')
case(PLASTIC_DISLOTUNGSTEN_ID)
case(MECHANICAL_PLASTICITY_DISLOTUNGSTEN)
call plastic_dislotungsten_result(ph,group//'mechanical/')
case(PLASTIC_NONLOCAL_ID)
case(MECHANICAL_PLASTICITY_NONLOCAL)
call plastic_nonlocal_result(ph,group//'mechanical/')
end select
@ -357,9 +377,9 @@ end subroutine mechanical_result
!> @brief calculation of stress (P) with time integration based on a residuum in Lp and
!> intermediate acceleration of the Newton-Raphson correction
!--------------------------------------------------------------------------------------------------
function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
function integrateStress(F,Fp0,Fi0,Delta_t,ph,en) result(broken)
real(pREAL), dimension(3,3), intent(in) :: F,subFp0,subFi0
real(pREAL), dimension(3,3), intent(in) :: F,Fp0,Fi0
real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en
@ -419,9 +439,9 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
Lpguess = phase_mechanical_Lp(ph)%data(1:3,1:3,en) ! take as first guess
Liguess = phase_mechanical_Li(ph)%data(1:3,1:3,en) ! take as first guess
call math_invert33(invFp_current,error=error,A=subFp0)
call math_invert33(invFp_current,error=error,A=Fp0)
if (error) return ! error
call math_invert33(invFi_current,error=error,A=subFi0)
call math_invert33(invFi_current,error=error,A=Fi0)
if (error) return ! error
A = matmul(F,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp
@ -434,7 +454,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
NiterationStressLi = 0
LiLoop: do
NiterationStressLi = NiterationStressLi + 1
if (NiterationStressLi>num%nStress) return ! error
if (NiterationStressLi>num%nStress_Li) return ! error
invFi_new = matmul(invFi_current,math_I3 - Delta_t*Liguess)
Fi_new = math_inv33(invFi_new)
@ -447,7 +467,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
NiterationStressLp = 0
LpLoop: do
NiterationStressLp = NiterationStressLp + 1
if (NiterationStressLp>num%nStress) return ! error
if (NiterationStressLp>num%nStress_Lp) return ! error
B = math_I3 - Delta_t*Lpguess
Fe = matmul(matmul(A,B), invFi_new)
@ -458,8 +478,8 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
S, Fi_new, ph,en)
!* update current residuum and check for convergence of loop
atol_Lp = max(num%rtol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error
num%atol_crystalliteStress) ! minimum lower cutoff
atol_Lp = max(num%rtol_Lp * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error
num%atol_Lp) ! minimum lower cutoff
residuumLp = Lpguess - Lp_constitutive
if (any(IEEE_is_NaN(residuumLp))) then
@ -471,7 +491,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
Lpguess_old = Lpguess
steplengthLp = 1.0_pREAL ! ...proceed with normal step length (calculate new search direction)
else ! not converged and residuum not improved...
steplengthLp = num%subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction
steplengthLp = num%stepSizeLp * steplengthLp ! ...try with smaller step length in same direction
Lpguess = Lpguess_old &
+ deltaLp * stepLengthLp
cycle LpLoop
@ -499,8 +519,8 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
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
num%atol_crystalliteStress) ! minimum lower cutoff
atol_Li = max(num%rtol_Li * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error
num%atol_Li) ! minimum lower cutoff
residuumLi = Liguess - Li_constitutive
if (any(IEEE_is_NaN(residuumLi))) then
return ! error
@ -511,13 +531,13 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
Liguess_old = Liguess
steplengthLi = 1.0_pREAL ! ...proceed with normal step length (calculate new search direction)
else ! not converged and residuum not improved...
steplengthLi = num%subStepSizeLi * steplengthLi ! ...try with smaller step length in same direction
steplengthLi = num%stepSizeLi * steplengthLi ! ...try with smaller step length in same direction
Liguess = Liguess_old &
+ deltaLi * steplengthLi
cycle LiLoop
end if
calculateJacobiLi: if (mod(jacoCounterLi, num%iJacoLpresiduum) == 0) then
calculateJacobiLi: if (mod(jacoCounterLi, num%iJacoLiresiduum) == 0) then
jacoCounterLi = jacoCounterLi + 1
temp_33 = matmul(matmul(A,B),invFi_current)
@ -562,10 +582,10 @@ end function integrateStress
!> @brief integrate stress, state with adaptive 1st order explicit Euler method
!> using Fixed Point Iteration to adapt the stepsize
!--------------------------------------------------------------------------------------------------
function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
function integrateStateFPI(F_0,F,Fp0,Fi0,state0,Delta_t,ph,en) result(broken)
real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
real(pREAL), intent(in),dimension(:) :: subState0
real(pREAL), intent(in),dimension(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
ph, &
@ -591,14 +611,14 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
if (any(IEEE_is_NaN(dotState))) return
sizeDotState = plasticState(ph)%sizeDotState
plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState * Delta_t
plasticState(ph)%state(1:sizeDotState,en) = state0 + dotState * Delta_t
iteration: do NiterationState = 1, num%nState
dotState_last(1:sizeDotState,2) = merge(dotState_last(1:sizeDotState,1),0.0_pREAL, nIterationState > 1)
dotState_last(1:sizeDotState,1) = dotState
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en)
broken = integrateStress(F,Fp0,Fi0,Delta_t,ph,en)
if (broken) exit iteration
dotState = plastic_dotState(Delta_t,ph,en)
@ -608,7 +628,7 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
dotState = dotState * zeta &
+ dotState_last(1:sizeDotState,1) * (1.0_pREAL - zeta)
r = plasticState(ph)%state(1:sizeDotState,en) &
- subState0 &
- state0 &
- dotState * Delta_t
plasticState(ph)%state(1:sizeDotState,en) = plasticState(ph)%state(1:sizeDotState,en) - r
@ -650,10 +670,10 @@ end function integrateStateFPI
!--------------------------------------------------------------------------------------------------
!> @brief integrate state with 1st order explicit Euler method
!--------------------------------------------------------------------------------------------------
function integrateStateEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
function integrateStateEuler(F_0,F,Fp0,Fi0,state0,Delta_t,ph,en) result(broken)
real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
real(pREAL), intent(in),dimension(:) :: subState0
real(pREAL), intent(in),dimension(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
ph, &
@ -673,16 +693,12 @@ function integrateStateEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result
if (any(IEEE_is_NaN(dotState))) return
sizeDotState = plasticState(ph)%sizeDotState
#ifndef __INTEL_LLVM_COMPILER
plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState*Delta_t
#else
plasticState(ph)%state(1:sizeDotState,en) = IEEE_FMA(dotState,Delta_t,subState0)
#endif
plasticState(ph)%state(1:sizeDotState,en) = state0 + dotState*Delta_t
broken = plastic_deltaState(ph,en)
if (broken) return
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en)
broken = integrateStress(F,Fp0,Fi0,Delta_t,ph,en)
end function integrateStateEuler
@ -690,10 +706,10 @@ end function integrateStateEuler
!--------------------------------------------------------------------------------------------------
!> @brief integrate stress, state with 1st order Euler method with adaptive step size
!--------------------------------------------------------------------------------------------------
function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
function integrateStateAdaptiveEuler(F_0,F,Fp0,Fi0,state0,Delta_t,ph,en) result(broken)
real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
real(pREAL), intent(in),dimension(:) :: subState0
real(pREAL), intent(in),dimension(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
ph, &
@ -716,16 +732,12 @@ function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en
sizeDotState = plasticState(ph)%sizeDotState
r = - dotState * 0.5_pREAL * Delta_t
#ifndef __INTEL_LLVM_COMPILER
plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState*Delta_t
#else
plasticState(ph)%state(1:sizeDotState,en) = IEEE_FMA(dotState,Delta_t,subState0)
#endif
plasticState(ph)%state(1:sizeDotState,en) = state0 + dotState*Delta_t
broken = plastic_deltaState(ph,en)
if (broken) return
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en)
broken = integrateStress(F,Fp0,Fi0,Delta_t,ph,en)
if (broken) return
dotState = plastic_dotState(Delta_t,ph,en)
@ -741,10 +753,10 @@ end function integrateStateAdaptiveEuler
!---------------------------------------------------------------------------------------------------
!> @brief Integrate state (including stress integration) with the classic Runge Kutta method
!---------------------------------------------------------------------------------------------------
function integrateStateRK4(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
function integrateStateRK4(F_0,F,Fp0,Fi0,state0,Delta_t,ph,en) result(broken)
real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
real(pREAL), intent(in),dimension(:) :: subState0
real(pREAL), intent(in),dimension(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en
logical :: broken
@ -761,7 +773,7 @@ function integrateStateRK4(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
B = [6.0_pREAL, 3.0_pREAL, 3.0_pREAL, 6.0_pREAL]**(-1)
broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C)
broken = integrateStateRK(F_0,F,Fp0,Fi0,state0,Delta_t,ph,en,A,B,C)
end function integrateStateRK4
@ -769,10 +781,10 @@ end function integrateStateRK4
!---------------------------------------------------------------------------------------------------
!> @brief Integrate state (including stress integration) with the Cash-Carp method
!---------------------------------------------------------------------------------------------------
function integrateStateRKCK45(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
function integrateStateRKCK45(F_0,F,Fp0,Fi0,state0,Delta_t,ph,en) result(broken)
real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
real(pREAL), intent(in),dimension(:) :: subState0
real(pREAL), intent(in),dimension(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en
logical :: broken
@ -796,7 +808,7 @@ function integrateStateRKCK45(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) resul
13525.0_pREAL/55296.0_pREAL, 277.0_pREAL/14336.0_pREAL, 1._pREAL/4._pREAL]
broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB)
broken = integrateStateRK(F_0,F,Fp0,Fi0,state0,Delta_t,ph,en,A,B,C,DB)
end function integrateStateRKCK45
@ -805,10 +817,10 @@ end function integrateStateRKCK45
!> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an
!! embedded explicit Runge-Kutta method
!--------------------------------------------------------------------------------------------------
function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB) result(broken)
function integrateStateRK(F_0,F,Fp0,Fi0,state0,Delta_t,ph,en,A,B,C,DB) result(broken)
real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
real(pREAL), intent(in),dimension(:) :: subState0
real(pREAL), intent(in),dimension(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t
real(pREAL), dimension(:,:), intent(in) :: A
real(pREAL), dimension(:), intent(in) :: B, C
@ -841,20 +853,12 @@ function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB)
dotState = A(1,stage) * plastic_RKdotState(1:sizeDotState,1)
do n = 2, stage
#ifndef __INTEL_LLVM_COMPILER
dotState = dotState + A(n,stage)*plastic_RKdotState(1:sizeDotState,n)
#else
dotState = IEEE_FMA(A(n,stage),plastic_RKdotState(1:sizeDotState,n),dotState)
#endif
end do
#ifndef __INTEL_LLVM_COMPILER
plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState*Delta_t
#else
plasticState(ph)%state(1:sizeDotState,en) = IEEE_FMA(dotState,Delta_t,subState0)
#endif
plasticState(ph)%state(1:sizeDotState,en) = state0 + dotState*Delta_t
broken = integrateStress(F_0+(F-F_0)*Delta_t*C(stage),subFp0,subFi0,Delta_t*C(stage), ph,en)
broken = integrateStress(F_0+(F-F_0)*Delta_t*C(stage),Fp0,Fi0,Delta_t*C(stage), ph,en)
if (broken) exit
dotState = plastic_dotState(Delta_t*C(stage), ph,en)
@ -866,11 +870,7 @@ function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB)
plastic_RKdotState(1:sizeDotState,size(B)) = dotState
dotState = matmul(plastic_RKdotState,B)
#ifndef __INTEL_LLVM_COMPILER
plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState*Delta_t
#else
plasticState(ph)%state(1:sizeDotState,en) = IEEE_FMA(dotState,Delta_t,subState0)
#endif
plasticState(ph)%state(1:sizeDotState,en) = state0 + dotState*Delta_t
if (present(DB)) &
broken = .not. converged(matmul(plastic_RKdotState(1:sizeDotState,1:size(DB)),DB) * Delta_t, &
@ -882,7 +882,7 @@ function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB)
broken = plastic_deltaState(ph,en)
if (broken) return
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en)
broken = integrateStress(F,Fp0,Fi0,Delta_t,ph,en)
end function integrateStateRK
@ -993,75 +993,75 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
logical :: converged_
real(pREAL) :: &
formerSubStep
formerStep
integer :: &
ph, en, sizeDotState
logical :: todo
real(pREAL) :: subFrac,subStep
real(pREAL) :: stepFrac,step
real(pREAL), dimension(3,3) :: &
subFp0, &
subFi0, &
subLp0, &
subLi0, &
subF0, &
subF
real(pREAL), dimension(plasticState(material_ID_phase(co,ce))%sizeState) :: subState0
Fp0, &
Fi0, &
Lp0, &
Li0, &
F0, &
F
real(pREAL), dimension(plasticState(material_ID_phase(co,ce))%sizeState) :: state0
ph = material_ID_phase(co,ce)
en = material_entry_phase(co,ce)
subState0 = plasticState(ph)%state0(:,en)
subLi0 = phase_mechanical_Li0(ph)%data(1:3,1:3,en)
subLp0 = phase_mechanical_Lp0(ph)%data(1:3,1:3,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)
subFrac = 0.0_pREAL
state0 = plasticState(ph)%state0(:,en)
Li0 = phase_mechanical_Li0(ph)%data(1:3,1:3,en)
Lp0 = phase_mechanical_Lp0(ph)%data(1:3,1:3,en)
Fp0 = phase_mechanical_Fp0(ph)%data(1:3,1:3,en)
Fi0 = phase_mechanical_Fi0(ph)%data(1:3,1:3,en)
F0 = phase_mechanical_F0(ph)%data(1:3,1:3,en)
stepFrac = 0.0_pREAL
todo = .true.
subStep = 1.0_pREAL/num%subStepSizeCryst
converged_ = .false. ! pretend failed step of 1/subStepSizeCryst
step = 1.0_pREAL/num%stepSizeCryst
converged_ = .false. ! pretend failed step of 1/stepSizeCryst
todo = .true.
cutbackLooping: do while (todo)
if (converged_) then
formerSubStep = subStep
subFrac = subFrac + subStep
subStep = min(1.0_pREAL - subFrac, num%stepIncreaseCryst * subStep)
formerStep = step
stepFrac = stepFrac + step
step = min(1.0_pREAL - stepFrac, num%stepIncreaseCryst * step)
todo = subStep > 0.0_pREAL ! still time left to integrate on?
todo = step > 0.0_pREAL ! still time left to integrate on?
if (todo) then
subF0 = subF
subLp0 = phase_mechanical_Lp(ph)%data(1:3,1:3,en)
subLi0 = phase_mechanical_Li(ph)%data(1:3,1:3,en)
subFp0 = phase_mechanical_Fp(ph)%data(1:3,1:3,en)
subFi0 = phase_mechanical_Fi(ph)%data(1:3,1:3,en)
subState0 = plasticState(ph)%state(:,en)
F0 = F
Lp0 = phase_mechanical_Lp(ph)%data(1:3,1:3,en)
Li0 = phase_mechanical_Li(ph)%data(1:3,1:3,en)
Fp0 = phase_mechanical_Fp(ph)%data(1:3,1:3,en)
Fi0 = phase_mechanical_Fi(ph)%data(1:3,1:3,en)
state0 = plasticState(ph)%state(:,en)
end if
!--------------------------------------------------------------------------------------------------
! cut back (reduced time and restore)
else
subStep = num%subStepSizeCryst * subStep
phase_mechanical_Fp(ph)%data(1:3,1:3,en) = subFp0
phase_mechanical_Fi(ph)%data(1:3,1:3,en) = subFi0
step = num%stepSizeCryst * step
phase_mechanical_Fp(ph)%data(1:3,1:3,en) = Fp0
phase_mechanical_Fi(ph)%data(1:3,1:3,en) = Fi0
phase_mechanical_S(ph)%data(1:3,1:3,en) = phase_mechanical_S0(ph)%data(1:3,1:3,en)
if (subStep < 1.0_pREAL) then ! actual (not initial) cutback
phase_mechanical_Lp(ph)%data(1:3,1:3,en) = subLp0
phase_mechanical_Li(ph)%data(1:3,1:3,en) = subLi0
if (step < 1.0_pREAL) then ! actual (not initial) cutback
phase_mechanical_Lp(ph)%data(1:3,1:3,en) = Lp0
phase_mechanical_Li(ph)%data(1:3,1:3,en) = Li0
end if
plasticState(ph)%state(:,en) = subState0
todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair)
plasticState(ph)%state(:,en) = state0
todo = step > num%stepMinCryst ! still on track or already done (beyond repair)
end if
!--------------------------------------------------------------------------------------------------
! prepare for integration
if (todo) then
sizeDotState = plasticState(ph)%sizeDotState
subF = subF0 &
+ subStep * (phase_mechanical_F(ph)%data(1:3,1:3,en) - phase_mechanical_F0(ph)%data(1:3,1:3,en))
converged_ = .not. integrateState(subF0,subF,subFp0,subFi0,subState0(1:sizeDotState),subStep * Delta_t,ph,en)
F = F0 &
+ step * (phase_mechanical_F(ph)%data(1:3,1:3,en) - phase_mechanical_F0(ph)%data(1:3,1:3,en))
converged_ = .not. integrateState(F0,F,Fp0,Fi0,state0(1:sizeDotState),step * Delta_t,ph,en)
end if
end do cutbackLooping
@ -1154,18 +1154,12 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
else
lhs_3333 = 0.0_pREAL; rhs_3333 = 0.0_pREAL
do o=1,3; do p=1,3
#ifndef __INTEL_LLVM_COMPILER
lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) &
+ matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) * Delta_t
lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) &
+ invFi*invFi(p,o)
rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) &
- matmul(invSubFi0,dLidS(1:3,1:3,o,p)) * Delta_t
#else
lhs_3333(1:3,1:3,o,p) = IEEE_FMA(matmul(invSubFi0,dLidFi(1:3,1:3,o,p)),Delta_t,lhs_3333(1:3,1:3,o,p))
lhs_3333(1:3,o,1:3,p) = IEEE_FMA(invFi,invFi(p,o),lhs_3333(1:3,o,1:3,p))
rhs_3333(1:3,1:3,o,p) = IEEE_FMA(matmul(invSubFi0,dLidS(1:3,1:3,o,p)),-Delta_t,rhs_3333(1:3,1:3,o,p))
#endif
end do; end do
call math_invert(temp_99,error,math_3333to99(lhs_3333))
if (error) then
@ -1194,12 +1188,8 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) &
+ matmul(temp_33_3,dLidS(1:3,1:3,p,o))
end do; end do
#ifndef __INTEL_LLVM_COMPILER
lhs_3333 = math_mul3333xx3333(dSdFe,temp_3333) * Delta_t &
+ math_mul3333xx3333(dSdFi,dFidS)
#else
lhs_3333 = IEEE_FMA(math_mul3333xx3333(dSdFe,temp_3333),Delta_t,math_mul3333xx3333(dSdFi,dFidS))
#endif
call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333))
if (error) then

71
src/phase_mechanical_eigen.f90
View File

@ -3,15 +3,7 @@ submodule(phase:mechanical) eigen
integer, dimension(:), allocatable :: &
Nmodels
integer(kind(EIGEN_UNDEFINED_ID)), dimension(:,:), allocatable :: &
model
integer(kind(EIGEN_UNDEFINED_ID)), dimension(:), allocatable :: &
model_damage
interface
module function damage_anisobrittle_init() result(myKinematics)
logical, dimension(:), allocatable :: myKinematics
end function damage_anisobrittle_init
module function thermalexpansion_init(kinematics_length) result(myKinematics)
integer, intent(in) :: kinematics_length
@ -60,17 +52,12 @@ module subroutine eigen_init(phases)
Nmodels(ph) = kinematics%length
end do
allocate(model(maxval(Nmodels),phases%length), source = EIGEN_undefined_ID)
allocate(mechanical_eigen_kinematics_type(maxval(Nmodels),phases%length), source = UNDEFINED)
if (maxval(Nmodels) /= 0) then
where(thermalexpansion_init(maxval(Nmodels))) model = EIGEN_thermal_expansion_ID
where(thermalexpansion_init(maxval(Nmodels))) mechanical_eigen_kinematics_type = MECHANICAL_EIGEN_THERMALEXPANSION
end if
allocate(model_damage(phases%length), source = EIGEN_UNDEFINED_ID)
where(damage_anisobrittle_init()) model_damage = EIGEN_cleavage_opening_ID
end subroutine eigen_init
@ -108,34 +95,6 @@ function kinematics_active(kinematics_label,kinematics_length) result(active_ki
end function kinematics_active
!--------------------------------------------------------------------------------------------------
!> @brief Checks if a damage kinematic mechanism is active.
!--------------------------------------------------------------------------------------------------
function kinematics_active2(kinematics_label) result(active_kinematics)
character(len=*), intent(in) :: kinematics_label !< name of kinematic mechanism
logical, dimension(:), allocatable :: active_kinematics
type(tDict), pointer :: &
phases, &
phase, &
kinematics_type
integer :: ph
phases => config_material%get_dict('phase')
allocate(active_kinematics(phases%length), source = .false.)
do ph = 1, phases%length
phase => phases%get_dict(ph)
kinematics_type => phase%get_dict('damage',defaultVal=emptyDict)
active_kinematics(ph) = kinematics_type%get_asStr('type',defaultVal='n/a') == kinematics_label
end do
end function kinematics_active2
!--------------------------------------------------------------------------------------------------
!> @brief contains the constitutive equation for calculating the velocity gradient
! ToDo: MD: S is Mi?
@ -173,17 +132,9 @@ module subroutine phase_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
dLi_dFi = 0.0_pREAL
plasticType: select case (phase_plasticity(ph))
case (PLASTIC_isotropic_ID) plasticType
call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,ph,en)
Li = Li + my_Li
dLi_dS = dLi_dS + my_dLi_dS
active = .true.
end select plasticType
KinematicsLoop: do k = 1, Nmodels(ph)
kinematicsType: select case (model(k,ph))
case (EIGEN_thermal_expansion_ID) kinematicsType
kinematicsType: select case (mechanical_eigen_kinematics_type(k,ph))
case (MECHANICAL_EIGEN_THERMALEXPANSION) kinematicsType
call thermalexpansion_LiAndItsTangent(my_Li, my_dLi_dS, ph,en)
Li = Li + my_Li
dLi_dS = dLi_dS + my_dLi_dS
@ -191,13 +142,21 @@ module subroutine phase_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
end select kinematicsType
end do KinematicsLoop
select case (model_damage(ph))
case (EIGEN_cleavage_opening_ID)
plasticType: select case (mechanical_plasticity_type(ph))
case (MECHANICAL_PLASTICITY_ISOTROPIC) plasticType
call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,ph,en)
Li = Li + my_Li
dLi_dS = dLi_dS + my_dLi_dS
active = .true.
end select plasticType
damageType: select case (damage_type(ph))
case (DAMAGE_ANISOBRITTLE)
call damage_anisobrittle_LiAndItsTangent(my_Li, my_dLi_dS, S, ph, en)
Li = Li + my_Li
dLi_dS = dLi_dS + my_dLi_dS
active = .true.
end select
end select damageType
if (.not. active) return

30
src/phase_mechanical_eigen_cleavageopening.f90
View File

@ -1,30 +0,0 @@
!--------------------------------------------------------------------------------------------------
!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief material subroutine incorporating kinematics resulting from opening of cleavage planes
!> @details to be done
!--------------------------------------------------------------------------------------------------
submodule(phase:eigen) cleavageopening
contains
!--------------------------------------------------------------------------------------------------
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
module function damage_anisobrittle_init() result(myKinematics)
logical, dimension(:), allocatable :: myKinematics
myKinematics = kinematics_active2('anisobrittle')
if (count(myKinematics) == 0) return
print'(/,1x,a)', '<<<+- phase:mechanical:eigen:cleavageopening init -+>>>'
print'(/,a,i2)', ' # phases: ',count(myKinematics); flush(IO_STDOUT)
end function damage_anisobrittle_init
end submodule cleavageopening

12
src/phase_mechanical_eigen_thermalexpansion.f90
View File

@ -27,7 +27,7 @@ module function thermalexpansion_init(kinematics_length) result(myKinematics)
integer, intent(in) :: kinematics_length
logical, dimension(:,:), allocatable :: myKinematics
integer :: Ninstances, p, k
integer :: p, k
type(tList), pointer :: &
kinematics
type(tDict), pointer :: &
@ -37,15 +37,13 @@ module function thermalexpansion_init(kinematics_length) result(myKinematics)
myKinematics = kinematics_active('thermalexpansion',kinematics_length)
Ninstances = count(myKinematics)
print'(/,a,i2)', ' # phases: ',Ninstances; flush(IO_STDOUT)
if (Ninstances == 0) return
if (count(myKinematics) == 0) return
print'(/,1x,a)', '<<<+- phase:mechanical:eigen:thermalexpansion init -+>>>'
print'(/,1x,a,1x,i0)', '# phases:',count(myKinematics); flush(IO_STDOUT)
phases => config_material%get_dict('phase')
allocate(param(Ninstances))
allocate(param(count(myKinematics)))
allocate(kinematics_thermal_expansion_instance(phases%length), source=0)
do p = 1, phases%length
@ -92,7 +90,7 @@ module subroutine thermalexpansion_LiAndItsTangent(Li, dLi_dTstar, ph,me)
Alpha = 0.0_pREAL
Alpha(1,1) = prm%Alpha_11%at(T)
if (any(phase_lattice(ph) == ['hP','tI'])) Alpha(3,3) = prm%Alpha_33%at(T)
Alpha = lattice_symmetrize_33(Alpha,phase_lattice(ph))
Alpha = crystal_symmetrize_33(Alpha,phase_lattice(ph))
Li = dot_T * Alpha
end associate

14
src/phase_mechanical_elastic.f90
View File

@ -34,7 +34,7 @@ module subroutine elastic_init(phases)
print'(/,1x,a)', '<<<+- phase:mechanical:elastic init -+>>>'
print'(/,1x,a)', '<<<+- phase:mechanical:elastic:Hooke init -+>>>'
print'(/,a,i0)', ' # phases: ',phases%length; flush(IO_STDOUT)
print'(/,1x,a,1x,i0)', '# phases:',phases%length; flush(IO_STDOUT)
allocate(param(phases%length))
@ -43,7 +43,7 @@ module subroutine elastic_init(phases)
phase => phases%get_dict(ph)
mech => phase%get_dict('mechanical')
elastic => mech%get_dict('elastic')
print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
print'(/,1x,a,1x,i0,a)', 'phase',ph,': '//phases%key(ph)
refs = config_listReferences(elastic,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs
if (elastic%get_asStr('type') /= 'Hooke') call IO_error(200,ext_msg=elastic%get_asStr('type'))
@ -97,7 +97,7 @@ pure module function elastic_C66(ph,en) result(C66)
if (phase_lattice(ph) == 'tI') C66(6,6) = prm%C_66%at(T)
C66 = lattice_symmetrize_C66(C66,phase_lattice(ph))
C66 = crystal_symmetrize_C66(C66,phase_lattice(ph))
end associate
@ -119,7 +119,7 @@ pure module function elastic_mu(ph,en,isotropic_bound) result(mu)
associate(prm => param(ph))
mu = lattice_isotropic_mu(elastic_C66(ph,en),isotropic_bound,phase_lattice(ph))
mu = crystal_isotropic_mu(elastic_C66(ph,en),isotropic_bound,phase_lattice(ph))
end associate
@ -141,7 +141,7 @@ pure module function elastic_nu(ph,en,isotropic_bound) result(nu)
associate(prm => param(ph))
nu = lattice_isotropic_nu(elastic_C66(ph,en),isotropic_bound,phase_lattice(ph))
nu = crystal_isotropic_nu(elastic_C66(ph,en),isotropic_bound,phase_lattice(ph))
end associate
@ -199,8 +199,8 @@ module function phase_homogenizedC66(ph,en) result(C)
integer, intent(in) :: ph, en
plasticType: select case (phase_plasticity(ph))
case (PLASTIC_DISLOTWIN_ID) plasticType
plasticType: select case (mechanical_plasticity_type(ph))
case (MECHANICAL_PLASTICITY_DISLOTWIN) plasticType
C = plastic_dislotwin_homogenizedC(ph,en)
case default plasticType
C = elastic_C66(ph,en)

68
src/phase_mechanical_plastic.f90
View File

@ -211,17 +211,17 @@ contains
module subroutine plastic_init
print'(/,1x,a)', '<<<+- phase:mechanical:plastic init -+>>>'
print'(/,1x,a)', '<<<+- phase:mechanical:plasticity init -+>>>'
where(plastic_none_init()) phase_plasticity = PLASTIC_NONE_ID
where(plastic_isotropic_init()) phase_plasticity = PLASTIC_ISOTROPIC_ID
where(plastic_phenopowerlaw_init()) phase_plasticity = PLASTIC_PHENOPOWERLAW_ID
where(plastic_kinehardening_init()) phase_plasticity = PLASTIC_KINEHARDENING_ID
where(plastic_dislotwin_init()) phase_plasticity = PLASTIC_DISLOTWIN_ID
where(plastic_dislotungsten_init()) phase_plasticity = PLASTIC_DISLOTUNGSTEN_ID
where(plastic_nonlocal_init()) phase_plasticity = PLASTIC_NONLOCAL_ID
where(plastic_none_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_NONE
where(plastic_isotropic_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_ISOTROPIC
where(plastic_phenopowerlaw_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_PHENOPOWERLAW
where(plastic_kinehardening_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_KINEHARDENING
where(plastic_dislotwin_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_DISLOTWIN
where(plastic_dislotungsten_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_DISLOTUNGSTEN
where(plastic_nonlocal_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_NONLOCAL
if (any(phase_plasticity == PLASTIC_undefined_ID)) call IO_error(201)
if (any(mechanical_plasticity_type == UNDEFINED)) call IO_error(201)
end subroutine plastic_init
@ -251,7 +251,7 @@ module subroutine plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
i, j
if (phase_plasticity(ph) == PLASTIC_NONE_ID) then
if (mechanical_plasticity_type(ph) == MECHANICAL_PLASTICITY_NONE) then
Lp = 0.0_pREAL
dLp_dFi = 0.0_pREAL
dLp_dS = 0.0_pREAL
@ -259,24 +259,24 @@ module subroutine plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
Mp = matmul(matmul(transpose(Fi),Fi),S)
plasticType: select case (phase_plasticity(ph))
plasticType: select case (mechanical_plasticity_type(ph))
case (PLASTIC_ISOTROPIC_ID) plasticType
case (MECHANICAL_PLASTICITY_ISOTROPIC) plasticType
call isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
case (PLASTIC_PHENOPOWERLAW_ID) plasticType
case (MECHANICAL_PLASTICITY_PHENOPOWERLAW) plasticType
call phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
case (PLASTIC_KINEHARDENING_ID) plasticType
case (MECHANICAL_PLASTICITY_KINEHARDENING) plasticType
call kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
case (PLASTIC_NONLOCAL_ID) plasticType
case (MECHANICAL_PLASTICITY_NONLOCAL) plasticType
call nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
case (PLASTIC_DISLOTWIN_ID) plasticType
case (MECHANICAL_PLASTICITY_DISLOTWIN) plasticType
call dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
case (PLASTIC_DISLOTUNGSTEN_ID) plasticType
case (MECHANICAL_PLASTICITY_DISLOTUNGSTEN) plasticType
call dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
end select plasticType
@ -308,28 +308,28 @@ module function plastic_dotState(subdt,ph,en) result(dotState)
dotState
if (phase_plasticity(ph) /= PLASTIC_NONE_ID) then
if (mechanical_plasticity_type(ph) /= MECHANICAL_PLASTICITY_NONE) then
Mp = matmul(matmul(transpose(phase_mechanical_Fi(ph)%data(1:3,1:3,en)),&
phase_mechanical_Fi(ph)%data(1:3,1:3,en)),phase_mechanical_S(ph)%data(1:3,1:3,en))
plasticType: select case (phase_plasticity(ph))
plasticType: select case (mechanical_plasticity_type(ph))
case (PLASTIC_ISOTROPIC_ID) plasticType
case (MECHANICAL_PLASTICITY_ISOTROPIC) plasticType
dotState = isotropic_dotState(Mp,ph,en)
case (PLASTIC_PHENOPOWERLAW_ID) plasticType
case (MECHANICAL_PLASTICITY_PHENOPOWERLAW) plasticType
dotState = phenopowerlaw_dotState(Mp,ph,en)
case (PLASTIC_KINEHARDENING_ID) plasticType
case (MECHANICAL_PLASTICITY_KINEHARDENING) plasticType
dotState = plastic_kinehardening_dotState(Mp,ph,en)
case (PLASTIC_DISLOTWIN_ID) plasticType
case (MECHANICAL_PLASTICITY_DISLOTWIN) plasticType
dotState = dislotwin_dotState(Mp,ph,en)
case (PLASTIC_DISLOTUNGSTEN_ID) plasticType
case (MECHANICAL_PLASTICITY_DISLOTUNGSTEN) plasticType
dotState = dislotungsten_dotState(Mp,ph,en)
case (PLASTIC_NONLOCAL_ID) plasticType
case (MECHANICAL_PLASTICITY_NONLOCAL) plasticType
call nonlocal_dotState(Mp,subdt,ph,en)
dotState = plasticState(ph)%dotState(:,en)
@ -349,15 +349,15 @@ module subroutine plastic_dependentState(ph,en)
en
plasticType: select case (phase_plasticity(ph))
plasticType: select case (mechanical_plasticity_type(ph))
case (PLASTIC_DISLOTWIN_ID) plasticType
case (MECHANICAL_PLASTICITY_DISLOTWIN) plasticType
call dislotwin_dependentState(ph,en)
case (PLASTIC_DISLOTUNGSTEN_ID) plasticType
case (MECHANICAL_PLASTICITY_DISLOTUNGSTEN) plasticType
call dislotungsten_dependentState(ph,en)
case (PLASTIC_NONLOCAL_ID) plasticType
case (MECHANICAL_PLASTICITY_NONLOCAL) plasticType
call nonlocal_dependentState(ph,en)
end select plasticType
@ -384,19 +384,19 @@ module function plastic_deltaState(ph, en) result(broken)
broken = .false.
select case (phase_plasticity(ph))
case (PLASTIC_NONLOCAL_ID,PLASTIC_KINEHARDENING_ID)
select case (mechanical_plasticity_type(ph))
case (MECHANICAL_PLASTICITY_NONLOCAL,MECHANICAL_PLASTICITY_KINEHARDENING)
Mp = matmul(matmul(transpose(phase_mechanical_Fi(ph)%data(1:3,1:3,en)),&
phase_mechanical_Fi(ph)%data(1:3,1:3,en)),&
phase_mechanical_S(ph)%data(1:3,1:3,en))
plasticType: select case (phase_plasticity(ph))
plasticType: select case (mechanical_plasticity_type(ph))
case (PLASTIC_KINEHARDENING_ID) plasticType
case (MECHANICAL_PLASTICITY_KINEHARDENING) plasticType
call plastic_kinehardening_deltaState(Mp,ph,en)
case (PLASTIC_NONLOCAL_ID) plasticType
case (MECHANICAL_PLASTICITY_NONLOCAL) plasticType
call plastic_nonlocal_deltaState(Mp,ph,en)
end select plasticType

176
src/phase_mechanical_plastic_dislotungsten.f90
View File

@ -92,8 +92,9 @@ module function plastic_dislotungsten_init() result(myPlasticity)
real(pREAL),dimension(:), allocatable :: &
f_edge, & !< edge character fraction of total dislocation density
rho_mob_0, & !< initial dislocation density
rho_dip_0, & !< initial dipole density
a !< non-Schmid coefficients
rho_dip_0 !< initial dipole density
real(pREAL), dimension(:,:), allocatable :: &
a_nS !< non-Schmid coefficients
character(len=:), allocatable :: &
refs, &
extmsg
@ -108,11 +109,11 @@ module function plastic_dislotungsten_init() result(myPlasticity)
if (count(myPlasticity) == 0) return
print'(/,1x,a)', '<<<+- phase:mechanical:plastic:dislotungsten init -+>>>'
print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
print'(/,1x,a)', 'D. Cereceda et al., International Journal of Plasticity 78:242–256, 2016'
print'( 1x,a)', 'https://doi.org/10.1016/j.ijplas.2015.09.002'
print'(/,1x,a,1x,i0)', '# phases:',count(myPlasticity); flush(IO_STDOUT)
phases => config_material%get_dict('phase')
allocate(param(phases%length))
@ -149,16 +150,18 @@ module function plastic_dislotungsten_init() result(myPlasticity)
N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray)
prm%sum_N_sl = sum(abs(N_sl))
slipActive: if (prm%sum_N_sl > 0) then
prm%systems_sl = lattice_labels_slip(N_sl,phase_lattice(ph))
prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph))
prm%systems_sl = crystal_labels_slip(N_sl,phase_lattice(ph))
prm%P_sl = crystal_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph))
if (phase_lattice(ph) == 'cI') then
a = pl%get_as1dReal('a_nonSchmid',defaultVal = emptyRealArray)
prm%P_nS_pos = lattice_nonSchmidMatrix(N_sl,a,+1)
prm%P_nS_neg = lattice_nonSchmidMatrix(N_sl,a,-1)
allocate(a_nS(3,size(pl%get_as1dReal('a_nonSchmid_110',defaultVal=emptyRealArray))))
a_nS(1,:) = pl%get_as1dReal('a_nonSchmid_110',defaultVal=emptyRealArray)
prm%P_nS_pos = crystal_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph),nonSchmidCoefficients=a_nS,sense=+1)
prm%P_nS_neg = crystal_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph),nonSchmidCoefficients=a_nS,sense=-1)
deallocate(a_nS)
else
prm%P_nS_pos = prm%P_sl
prm%P_nS_neg = prm%P_sl
prm%P_nS_pos = +prm%P_sl
prm%P_nS_neg = -prm%P_sl
end if
prm%dipoleformation = .not. pl%get_asBool('no_dipole_formation', defaultVal=.false.)
@ -184,13 +187,13 @@ module function plastic_dislotungsten_init() result(myPlasticity)
prm%d_caron = prm%b_sl * pl%get_asReal('D_a')
prm%f_at = prm%b_sl**3*pl%get_asReal('f_at')
prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dReal('h_sl-sl'), &
prm%h_sl_sl = crystal_interaction_SlipBySlip(N_sl,pl%get_as1dReal('h_sl-sl'), &
phase_lattice(ph))
prm%forestProjection = spread( f_edge,1,prm%sum_N_sl) &
* lattice_forestProjection_edge (N_sl,phase_lattice(ph),phase_cOverA(ph)) &
* crystal_forestProjection_edge (N_sl,phase_lattice(ph),phase_cOverA(ph)) &
+ spread(1.0_pREAL-f_edge,1,prm%sum_N_sl) &
* lattice_forestProjection_screw(N_sl,phase_lattice(ph),phase_cOverA(ph))
* crystal_forestProjection_screw(N_sl,phase_lattice(ph),phase_cOverA(ph))
! sanity checks
if ( prm%D_0 < 0.0_pREAL) extmsg = trim(extmsg)//' D_0'
@ -280,9 +283,9 @@ pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, &
Lp !< plastic velocity gradient
real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp !< derivative of Lp with respect to the Mandel stress
real(pREAL), dimension(3,3), intent(in) :: &
real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
integer, intent(in) :: &
ph, &
en
@ -291,8 +294,7 @@ pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, &
real(pREAL) :: &
T !< temperature
real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos,dot_gamma_neg, &
ddot_gamma_dtau_pos,ddot_gamma_dtau_neg
dot_gamma, ddot_gamma_dtau
T = thermal_T(ph,en)
@ -301,13 +303,14 @@ pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, &
associate(prm => param(ph))
call kinetics(Mp,T,ph,en,dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg)
call kinetics(Mp,T,ph,en, dot_gamma,ddot_gamma_dtau)
do i = 1, prm%sum_N_sl
Lp = Lp + (dot_gamma_pos(i)+dot_gamma_neg(i))*prm%P_sl(1:3,1:3,i)
Lp = Lp + dot_gamma(i)*prm%P_sl(1:3,1:3,i)
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) &
+ ddot_gamma_dtau_pos(i) * prm%P_sl(k,l,i) * prm%P_nS_pos(m,n,i) &
+ ddot_gamma_dtau_neg(i) * prm%P_sl(k,l,i) * prm%P_nS_neg(m,n,i)
+ ddot_gamma_dtau(i) * prm%P_sl(k,l,i) &
* merge(prm%P_nS_pos(m,n,i), &
prm%P_nS_neg(m,n,i), dot_gamma(i)>0.0_pREAL)
end do
end associate
@ -329,52 +332,50 @@ module function dislotungsten_dotState(Mp,ph,en) result(dotState)
dotState
real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos, dot_gamma_neg,&
tau_pos,&
tau_neg, &
tau_eff, &
v_cl, &
dot_rho_dip_formation, &
dot_rho_dip_climb, &
d_hat
real(pREAL) :: &
mu, T
mu, nu, T
associate(prm => param(ph), stt => state(ph), dst => dependentState(ph), &
dot_rho_mob => dotState(indexDotState(ph)%rho_mob(1):indexDotState(ph)%rho_mob(2)), &
dot_rho_dip => dotState(indexDotState(ph)%rho_dip(1):indexDotState(ph)%rho_dip(2)), &
dot_gamma_sl => dotState(indexDotState(ph)%gamma_sl(1):indexDotState(ph)%gamma_sl(2)))
dot_gamma => dotState(indexDotState(ph)%gamma_sl(1):indexDotState(ph)%gamma_sl(2)))
mu = elastic_mu(ph,en,prm%isotropic_bound)
nu = elastic_nu(ph,en,prm%isotropic_bound)
T = thermal_T(ph,en)
call kinetics(Mp,T,ph,en,&
dot_gamma_pos,dot_gamma_neg, &
tau_pos_out = tau_pos,tau_neg_out = tau_neg)
dot_gamma, tau = tau_eff)
dot_gamma_sl = abs(dot_gamma_pos+dot_gamma_neg)
dot_gamma = abs(dot_gamma)
where(dEq0((tau_pos+tau_neg)*0.5_pREAL))
where(dEq0(dot_gamma))
dot_rho_dip_formation = 0.0_pREAL
dot_rho_dip_climb = 0.0_pREAL
else where
d_hat = math_clip(3.0_pREAL*mu*prm%b_sl/(16.0_pREAL*PI*abs(tau_pos+tau_neg)*0.5_pREAL), &
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/prm%b_sl, &
d_hat = math_clip(mu*prm%b_sl/(8.0_pREAL*PI*(1.0_pREAL-nu)*tau_eff), &
left = prm%d_caron, & ! lower limit
right = dst%Lambda_sl(:,en)) ! upper limit
dot_rho_dip_formation = merge(dot_gamma * 2.0_pREAL*(d_hat-prm%d_caron)/prm%b_sl * stt%rho_mob(:,en), &
0.0_pREAL, &
prm%dipoleformation)
v_cl = (3.0_pREAL*mu*prm%D_0*exp(-prm%Q_cl/(K_B*T))*prm%f_at/(TAU*K_B*T)) &
v_cl = (3.0_pREAL*mu*prm%D_0*exp(-prm%Q_cl/(K_B*T))*prm%f_at/(2.0_pREAL*PI*K_B*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 = dot_gamma_sl/(prm%b_sl*dst%Lambda_sl(:,en)) & ! multiplication
- dot_rho_dip_formation &
- (2.0_pREAL*prm%d_caron)/prm%b_sl*stt%rho_mob(:,en)*dot_gamma_sl ! Spontaneous annihilation of 2 edges
dot_rho_mob = dot_gamma / (prm%b_sl*dst%Lambda_sl(:,en)) & ! multiplication
- dot_rho_dip_formation &
- dot_gamma * 2.0_pREAL*prm%d_caron/prm%b_sl * stt%rho_mob(:,en) ! spontaneous annihilation of 2 edges
dot_rho_dip = dot_rho_dip_formation &
- (2.0_pREAL*prm%d_caron)/prm%b_sl*stt%rho_dip(:,en)*dot_gamma_sl & ! Spontaneous annihilation of an edge with a dipole
- dot_rho_dip_climb
- dot_rho_dip_climb &
- dot_gamma * 2.0_pREAL*prm%d_caron/prm%b_sl * stt%rho_dip(:,en) ! spontaneous annihilation of an edge with a dipole
end associate
@ -457,51 +458,44 @@ end subroutine plastic_dislotungsten_result
! at the end since some of them are optional.
!--------------------------------------------------------------------------------------------------
pure subroutine kinetics(Mp,T,ph,en, &
dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg,tau_pos_out,tau_neg_out)
dot_gamma,ddot_gamma_dtau,tau)
real(pREAL), dimension(3,3), intent(in) :: &
real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
real(pREAL), intent(in) :: &
real(pREAL), intent(in) :: &
T !< temperature
integer, intent(in) :: &
integer, intent(in) :: &
ph, &
en
real(pREAL), intent(out), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos, &
dot_gamma_neg
real(pREAL), intent(out), optional, dimension(param(ph)%sum_N_sl) :: &
ddot_gamma_dtau_pos, &
ddot_gamma_dtau_neg, &
tau_pos_out, &
tau_neg_out
real(pREAL), dimension(param(ph)%sum_N_sl), intent(out) :: &
dot_gamma
real(pREAL), dimension(param(ph)%sum_N_sl), optional, intent(out) :: &
ddot_gamma_dtau, &
tau
real(pREAL), dimension(param(ph)%sum_N_sl) :: &
StressRatio, &
StressRatio_p,StressRatio_pminus1, &
dvel, &
tau_pos, tau_neg, tau_eff, &
t_n, t_k, dtk,dtn
integer :: j
t_n,t_k, dtk,dtn
integer :: i
associate(prm => param(ph), stt => state(ph), dst => dependentState(ph))
do j = 1, prm%sum_N_sl
tau_pos(j) = math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,j))
tau_neg(j) = math_tensordot(Mp,prm%P_nS_neg(1:3,1:3,j))
end do
tau_pos = [(math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,i)),i=1,prm%sum_N_sl)]
tau_neg = [(math_tensordot(Mp,prm%P_nS_neg(1:3,1:3,i)),i=1,prm%sum_N_sl)]
tau_eff = math_clip(max(tau_pos,tau_neg) - dst%tau_pass(:,en),left = 0.0_pREAL)
if (present(tau_pos_out)) tau_pos_out = tau_pos
if (present(tau_neg_out)) tau_neg_out = tau_neg
if (present(tau)) tau = tau_eff
associate(BoltzmannRatio => prm%Q_s/(K_B*T), &
b_rho_half => stt%rho_mob(:,en) * prm%b_sl * 0.5_pREAL, &
b_rho => stt%rho_mob(:,en) * prm%b_sl, &
effectiveLength => dst%Lambda_sl(:,en) - prm%w)
tau_eff = abs(tau_pos)-dst%tau_pass(:,en)
significantPositiveTau: where(tau_eff > tol_math_check)
where(tau_eff > tol_math_check)
StressRatio = tau_eff/prm%tau_Peierls
StressRatio_p = StressRatio** prm%p
StressRatio_pminus1 = StressRatio**(prm%p-1.0_pREAL)
@ -510,53 +504,21 @@ pure subroutine kinetics(Mp,T,ph,en, &
/ (prm%omega*effectiveLength)
t_k = effectiveLength * prm%B /(2.0_pREAL*prm%b_sl*tau_eff) ! corrected eq. (14)
dot_gamma_pos = b_rho_half * sign(prm%h/(t_n + t_k),tau_pos)
else where significantPositiveTau
dot_gamma_pos = 0.0_pREAL
end where significantPositiveTau
dot_gamma = b_rho * prm%h/(t_n + t_k) * merge(+1.0_pREAL,-1.0_pREAL, tau_pos>tau_neg)
else where
dot_gamma = 0.0_pREAL
end where
if (present(ddot_gamma_dtau_pos)) then
significantPositiveTau2: where(abs(tau_pos)-dst%tau_pass(:,en) > tol_math_check)
if (present(ddot_gamma_dtau)) then
where(tau_eff > 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_pminus1 / prm%tau_Peierls
dtk = -1.0_pREAL * t_k / tau_pos
dtk = -1.0_pREAL * t_k / tau_eff
dvel = -1.0_pREAL * prm%h * (dtk + dtn) / (t_n + t_k)**2
ddot_gamma_dtau_pos = b_rho_half * dvel
else where significantPositiveTau2
ddot_gamma_dtau_pos = 0.0_pREAL
end where significantPositiveTau2
end if
tau_eff = abs(tau_neg)-dst%tau_pass(:,en)
significantNegativeTau: where(tau_eff > tol_math_check)
StressRatio = tau_eff/prm%tau_Peierls
StressRatio_p = StressRatio** prm%p
StressRatio_pminus1 = StressRatio**(prm%p-1.0_pREAL)
t_n = prm%b_sl*exp(BoltzmannRatio*(1.0_pREAL-StressRatio_p) ** prm%q) &
/ (prm%omega*effectiveLength)
t_k = effectiveLength * prm%B /(2.0_pREAL*prm%b_sl*tau_eff) ! corrected eq. (14)
dot_gamma_neg = b_rho_half * sign(prm%h/(t_n + t_k),tau_neg)
else where significantNegativeTau
dot_gamma_neg = 0.0_pREAL
end where significantNegativeTau
if (present(ddot_gamma_dtau_neg)) then
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_pminus1 / prm%tau_Peierls
dtk = -1.0_pREAL * t_k / tau_neg
dvel = -1.0_pREAL * prm%h * (dtk + dtn) / (t_n + t_k)**2
ddot_gamma_dtau_neg = b_rho_half * dvel
else where significantNegativeTau2
ddot_gamma_dtau_neg = 0.0_pREAL
end where significantNegativeTau2
ddot_gamma_dtau = -1.0_pREAL * dot_gamma * (dtn + dtk) / (t_n + t_k)
else where
ddot_gamma_dtau = 0.0_pREAL
end where
end if
end associate

Some files were not shown because too many files have changed in this diff Show More