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_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" PETSC_INTEL: "Libraries/PETSc/3.16.5/Intel-2022.0.1-IntelMPI-2021.5.0"
# ++++++++++++ MSC Marc +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ # ++++++++++++ MSC Marc +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
MSC: "FEM/MSC/2022.4" MSC: "FEM/MSC/2023.1"
IntelMarc: "Compiler/Intel/19.1.2 Libraries/IMKL/2020" IntelMarc: "Compiler/Intel/19.1.2 Libraries/IMKL/2020"
HDF5Marc: "HDF5/1.12.2/Intel-19.1.2" 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: grid_GNU:
stage: compile stage: compile
script: script:
@ -196,7 +230,7 @@ Marc:
################################################################################################### ###################################################################################################
grid_runtime: grid_performance:
stage: statistics stage: statistics
before_script: before_script:
- ${LOCAL_HOME}/bin/queue ${CI_JOB_ID} --blocking - ${LOCAL_HOME}/bin/queue ${CI_JOB_ID} --blocking
@ -209,28 +243,33 @@ grid_runtime:
- make -j2 all install - make -j2 all install
- export PATH=${PWD}/bin:${PATH} - export PATH=${PWD}/bin:${PATH}
- cd $(mktemp -d) - 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 if [ ${CI_COMMIT_BRANCH} == development ]; then
--input_dir ${CI_PROJECT_DIR}/examples/grid git add performance.txt
--output_dir ./ git commit -m ${CI_PIPELINE_ID}_${CI_COMMIT_SHA}
--tag ${CI_COMMIT_SHA} git push
- if [ ${CI_COMMIT_BRANCH} == development ]; then git commit -am ${CI_PIPELINE_ID}_${CI_COMMIT_SHA}; git push; fi 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
################################################################################################### ###################################################################################################
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: update_revision:
stage: finalize stage: finalize
before_script: before_script:
@ -245,6 +284,6 @@ update_revision:
- > - >
git diff-index --quiet HEAD || git diff-index --quiet HEAD ||
git commit VERSION -m "[skip ci] updated version information after successful test of $VERSION" 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: only:
- development - 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") set (COMPILE_FLAGS "${COMPILE_FLAGS} -fPIE")
# position independent code # position independent code
set (COMPILE_FLAGS "${COMPILE_FLAGS} -ffree-line-length-132") set (COMPILE_FLAGS "${COMPILE_FLAGS} -ffree-line-length-none")
# restrict line length to the standard 132 characters (lattice.f90 require more characters) # PETSc macros are long, line length is enforced in pre-receive hook
set (COMPILE_FLAGS "${COMPILE_FLAGS} -fimplicit-none") set (COMPILE_FLAGS "${COMPILE_FLAGS} -fimplicit-none")
# assume "implicit none" even if not present in source # 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") set (DEBUG_FLAGS "${DEBUG_FLAGS} -fstack-protector-all")
# Inserts a guard variable onto the stack frame for all functions # 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") set (DEBUG_FLAGS "${DEBUG_FLAGS} -fsanitize=undefined")
# detect undefined behavior # detect undefined behavior
# Additional options # 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") set (COMPILE_FLAGS "${COMPILE_FLAGS} -diag-disable")
# disables warnings ... # disables warnings ...
set (COMPILE_FLAGS "${COMPILE_FLAGS} 5268") 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") set (COMPILE_FLAGS "${COMPILE_FLAGS},7624")
# ... about deprecated forall (has nice syntax and most likely a performance advantage) # ... 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") set (COMPILE_FLAGS "${COMPILE_FLAGS} -diag-disable")
# disables warnings ... # disables warnings ...
set (COMPILE_FLAGS "${COMPILE_FLAGS} 5268") 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") set (COMPILE_FLAGS "${COMPILE_FLAGS},7624")
# ... about deprecated forall (has nice syntax and most likely a performance advantage) # ... 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") set (DEBUG_FLAGS "${DEBUG_FLAGS} -fpe-all=0 -ftz")
# ... capture all floating-point exceptions, need to overwrite -no-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 # 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") #set (DEBUG_FLAGS "${DEBUG_FLAGS} -warn")
# enables warnings ... # enables warnings ...

8
examples/Marc/material.yaml
View File

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

167
examples/config/numerics.yaml
View File

@ -1,83 +1,100 @@
# Available numerical parameters # Default values of all available numerical parameters
# Case sensitive keys # Please note that keys are case sensitive
homogenization:
mech:
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
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
solver:
grid: grid:
eps_div_atol: 1.0e-3 # absolute tolerance for fulfillment of stress equilibrium N_staggered_iter_max: 10 # max number of field-level staggered iterations
eps_div_rtol: 5.0e-4 # relative tolerance for fulfillment of stress equilibrium N_cutback_max: 3 # maximum cutback level (0: 1, 1: 0.5, 2: 0.25, etc)
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 damage:
eps_stress_atol: 1.0e+3 # absolute tolerance for fulfillment of stress BC N_iter_max: 100 # maximum iteration number
eps_stress_rtol: 0.01 # relative tolerance for fulfillment of stress BC eps_abs_phi: 1.0e-2 # absolute tolerance for damage evolution
eps_damage_atol: 1.0e-2 # absolute tolerance for damage evolution eps_rel_phi: 1.0e-6 # relative tolerance for damage evolution
eps_damage_rtol: 1.0e-6 # relative tolerance for damage evolution phi_min: 1.0e-6 # residual integrity
eps_thermal_atol: 1.0e-2 # absolute tolerance for thermal equilibrium
eps_thermal_rtol: 1.0e-6 # relative tolerance for thermal equilibrium thermal:
itmax: 250 # Maximum iteration number N_iter_max: 100 # maximum iteration number
itmin: 2 # Minimum iteration number eps_abs_T: 1.0e-2 # absolute tolerance for thermal equilibrium
fftw_timelimit: -1.0 # timelimit of plan creation for FFTW, see manual on www.fftw.org, Default -1.0: disable timelimit eps_rel_T: 1.0e-6 # relative tolerance for thermal equilibrium
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) mechanical:
maxStaggeredIter: 10 # max number of field level staggered iterations N_iter_min: 1 # minimum iteration number
memory_efficient: 1 # Precalculate Gamma-operator (81 double per point) N_iter_max: 100 # maximum iteration number
update_gamma: false # Update Gamma-operator with current dPdF (not possible if memory_efficient=1) eps_abs_div(P): 1.0e-4 # absolute tolerance for fulfillment of stress equilibrium
divergence_correction: 2 # Use size-independent divergence criterion eps_rel_div(P): 5.0e-4 # relative tolerance for fulfillment of stress equilibrium
derivative: continuous # Approximation used for derivatives in Fourier space eps_abs_P: 1.0e3 # absolute tolerance for fulfillment of stress BC
petsc_options: -snes_type ngmres -snes_ngmres_anderson # PetSc solver options eps_rel_P: 1.0e-3 # relative tolerance for fulfillment of stress BC
alpha: 1.0 # polarization scheme parameter 0.0 < alpha < 2.0. alpha = 1.0 ==> AL scheme, alpha = 2.0 ==> accelerated scheme update_gamma: false # update Gamma-operator with current dPdF (not possible if FFT: memory_efficient == true)
beta: 1.0 # polarization scheme parameter 0.0 < beta < 2.0. beta = 1.0 ==> AL scheme, beta = 2.0 ==> accelerated scheme
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: mesh:
maxCutBack: 3 # maximum cut back level (0: 1, 1: 0.5, 2: 0.25, etc) N_cutback_max: 3 # maximum cut back level (0: 1, 1: 0.5, 2: 0.25, etc)
maxStaggeredIter: 10 # max number of field level staggered iterations N_staggered_iter_max: 10 # max number of field level staggered iterations
structorder: 2 # order of displacement shape functions (when mesh is defined) p_s: 2 # order of displacement shape functions
bbarstabilisation: false p_i: 2 # order of quadrature rule required
integrationorder: 2 # order of quadrature rule required (when mesh is defined) bbarstabilization: false
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
crystallite: mechanical:
subStepMin: 1.0e-3 # minimum (relative) size of sub-step allowed during cutback in crystallite N_iter_max: 250 # Maximum iteration number
subStepSize: 0.25 # size of substep when cutback introduced in crystallite (value between 0 and 1) eps_abs_div(P): 1.0e-10 # absolute tolerance for mechanical equilibrium
stepIncrease: 1.5 # increase of next substep size when previous substep converged in crystallite (value higher than 1) eps_rel_div(P): 1.0e-4 # relative tolerance for mechanical equilibrium
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: Marc:
unitlength: 1 # physical length of one computational length unit unit_length: 1.0 # physical length of one computational length unit
homogenization:
mechanical:
RGC:
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
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
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)
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: generic:
random_seed: 0 # fixed seeding for pseudo-random number generator, Default 0: use random seed. random_seed: 0 # fixed seeding for pseudo-random number generator (0: use random seed)
phi_min: 1.0e-6 # non-zero residual damage.

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 w: [2.992e-09] # 11b
# values in Cereceda et al. are high, using parameters from Gröger et al. # 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 # (almost) no annhilation, adjustment needed for simulations beyond the yield point
i_sl: [1] # c, eq. (25) 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_0_chi: [55e+9] # θ_0,bs
h_inf_chi: [1.3e+9] # θ_1,bs h_inf_chi: [1.3e+9] # θ_1,bs
n: 20 # not mentioned in the reference n: [20] # not mentioned in the reference
dot_gamma_0: 1e-4 # 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] 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: [12]
n_sl: 20 dot_gamma_0_sl: [0.001]
a_sl: 3.7 n_sl: [20]
h_0_sl-sl: 1.02e+9 a_sl: [3.7]
xi_0_sl: [76.e+6] xi_0_sl: [76.e+6]
xi_inf_sl: [266.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] 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: [12]
n_sl: 20 dot_gamma_0_sl: [7.5e-5]
a_sl: 5.4 n_sl: [20]
h_0_sl-sl: 281.5e+6 a_sl: [5.4]
xi_0_sl: [2.69e+6] xi_0_sl: [2.69e+6]
xi_inf_sl: [67.5e+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] 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: [12]
n_sl: 83.3 dot_gamma_0_sl: [0.001]
a_sl: 1.0 n_sl: [83.3]
h_0_sl-sl: 75.0e+6 a_sl: [1.0]
xi_0_sl: [26.25e+6] xi_0_sl: [26.25e+6]
xi_inf_sl: [53.0e+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] 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: [12]
n_sl: 20 dot_gamma_0_sl: [3.e-3]
a_sl: 0.6 n_sl: [20]
h_0_sl-sl: 3.5e+8 a_sl: [0.6]
xi_0_sl: [1.6e+6] xi_0_sl: [1.6e+6]
xi_inf_sl: [96.4e+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] 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: [12, 12]
n_sl: 20 dot_gamma_0_sl: [0.001, 0.001]
a_sl: 2.25 n_sl: [20, 20]
h_0_sl-sl: 1.0e+9 a_sl: [2.25, 2.25]
xi_0_sl: [95.e+6, 96.e+6] xi_0_sl: [95.e+6, 96.e+6]
xi_inf_sl: [222.e+6, 412.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] 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_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] xi_0_tw: [40.e+6, 0., 60.e+6]
a_sl: 2.25 a_sl: [2.25, 2.25, 2.25, 1, 2.25]
dot_gamma_0_sl: 0.001 dot_gamma_0_sl: [0.001, 0.001, 0.001, 0, 0.001]
dot_gamma_0_tw: 0.001 dot_gamma_0_tw: [0.001, 0, 0.001]
n_sl: 20 n_sl: [20, 20, 20, 1, 20]
n_tw: 20 n_tw: [20, 1, 20]
f_sat_sl-tw: 10.0 f_sat_sl-tw: [10.0, 10.0, 10.0, 0, 10.0]
h_0_sl-sl: 500.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 h_0_tw-tw: [50.0e+6, 0, 50.0e+6]
h_0_tw-sl: 150.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, 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,
-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: [12]
n_sl: 20 dot_gamma_0_sl: [0.001]
a_sl: 0.9 n_sl: [20]
h_0_sl-sl: 781.2e+6 a_sl: [0.9]
xi_0_sl: [114.e+6] xi_0_sl: [0.114e+9]
xi_inf_sl: [207.e+6] 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] 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: [2, 2, 2, 4, 2, 4, 2, 2, 4, 0, 0, 8]
n_sl: 6.0 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 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: 20.0e+6 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_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] 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, 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,
+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, -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 +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: [3, 3, 0, 12] # basal, prism, -, 1. pyr<c+a>
n_sl: 20 dot_gamma_0_sl: [0.001, 0.001, 0.0, 0.001]
a_sl: 2.0 n_sl: [20, 20, 1, 20]
dot_gamma_0_sl: 0.001 a_sl: [2.0, 2.0, 1.0, 2.0]
h_0_sl-sl: 200.e+6
# C. Zambaldi et al.: # C. Zambaldi et al.:
xi_0_sl: [349.e+6, 150.e+6, 0.0, 1107.e+6] xi_0_sl: [0.349e+9, 0.15e+9, 0.0, 1.107e+9]
xi_inf_sl: [568.e+6, 150.e+7, 0.0, 3420.e+6] xi_inf_sl: [0.568e+9, 1.50e+9, 0.0, 3.420e+9]
# L. Wang et al. : # L. Wang et al. :
# xi_0_sl: [127.e+6, 96.e+6, 0.0, 240.e+6] # 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, 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,
+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 Acta Materalia
# Tasan et.al. 2015 International Journal of Plasticity # Tasan et.al. 2015 International Journal of Plasticity
# Diehl et.al. 2015 Meccanica # 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 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_0_sl: [405.8e+6, 456.7e+6]
xi_inf_sl: [872.9e+6, 971.2e+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: plastic:
type: phenopowerlaw type: phenopowerlaw
N_sl: [12] N_sl: [12]
a_sl: 2.25 a_sl: [2.25]
atol_xi: 1.0 atol_xi: 1.0
dot_gamma_0_sl: 0.001 dot_gamma_0_sl: [0.001]
h_0_sl-sl: 75.e+6 h_0_sl-sl: [75.e+6]
h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4] h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4]
n_sl: 20 n_sl: [20]
output: [xi_sl] output: [xi_sl]
xi_0_sl: [31.e+6] xi_0_sl: [31.e+6]
xi_inf_sl: [63.e+6] xi_inf_sl: [63.e+6]

6
examples/grid/numerics.yaml
View File

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

8
examples/mesh/material.yaml
View File

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

30
python/damask/_configmaterial.py
View File

@ -106,15 +106,12 @@ class ConfigMaterial(Config):
Load DREAM.3D (HDF5) file. Load DREAM.3D (HDF5) file.
Data in DREAM.3D files can be stored per cell ('CellData') Data in DREAM.3D files can be stored per cell ('CellData')
and/or per grain ('Grain Data'). Per default, cell-wise data and/or per grain ('Grain Data'). Per default, i.e. if
is assumed. 'grain_data' is None, cell-wise data is assumed.
damask.Grid.load_DREAM3D allows to get the corresponding geometry
for the grid solver.
Parameters Parameters
---------- ----------
fname : str fname : str or pathlib.Path
Filename of the DREAM.3D (HDF5) file. Filename of the DREAM.3D (HDF5) file.
grain_data : str grain_data : str
Name of the group (folder) containing grain-wise data. Defaults Name of the group (folder) containing grain-wise data. Defaults
@ -140,19 +137,26 @@ class ConfigMaterial(Config):
and grain- or cell-wise data. Defaults to None, in which case and grain- or cell-wise data. Defaults to None, in which case
it is set as the path that contains _SIMPL_GEOMETRY/SPACING. 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 Returns
------- -------
loaded : damask.ConfigMaterial loaded : damask.ConfigMaterial
Material configuration from file. 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 with h5py.File(fname, 'r') as f:
c = util.DREAM3D_cell_data_group(fname) if cell_data is None else cell_data b = util.DREAM3D_base_group(f) if base_group is None else base_group
f = h5py.File(fname,'r') c = util.DREAM3D_cell_data_group(f) if cell_data is None else cell_data
if grain_data is None: if grain_data is None:
phase = f['/'.join([b,c,phases])][()].flatten() phase = f['/'.join([b,c,phases])][()].flatten()

220
python/damask/_crystal.py
View File

@ -2,11 +2,11 @@ from typing import Optional, Union, Dict, List, Tuple
import numpy as np import numpy as np
from ._typehints import FloatSequence, CrystalFamily, CrystalLattice, CrystalKinematics from ._typehints import FloatSequence, CrystalFamily, BravaisLattice, CrystalKinematics
from . import util from . import util
from . import Rotation from . import Rotation
lattice_symmetries: Dict[CrystalLattice, CrystalFamily] = { lattice_symmetries: Dict[BravaisLattice, CrystalFamily] = {
'aP': 'triclinic', 'aP': 'triclinic',
'mP': 'monoclinic', 'mP': 'monoclinic',
@ -27,7 +27,7 @@ lattice_symmetries: Dict[CrystalLattice, CrystalFamily] = {
'cF': 'cubic', 'cF': 'cubic',
} }
orientation_relationships: Dict[str, Dict[CrystalLattice,np.ndarray]] = { orientation_relationships: Dict[str, Dict[BravaisLattice,np.ndarray]] = {
'KS': { 'KS': {
'cF': np.array([ 'cF': np.array([
[[-1, 0, 1],[ 1, 1, 1]], [[-1, 0, 1],[ 1, 1, 1]],
@ -323,7 +323,7 @@ class Crystal():
def __init__(self, *, def __init__(self, *,
family: Optional[CrystalFamily] = None, family: Optional[CrystalFamily] = None,
lattice: Optional[CrystalLattice] = None, lattice: Optional[BravaisLattice] = None,
a: Optional[float] = None, b: Optional[float] = None, c: Optional[float] = 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, alpha: Optional[float] = None, beta: Optional[float] = None, gamma: Optional[float] = None,
degrees: bool = False): degrees: bool = False):
@ -548,7 +548,17 @@ class Crystal():
@property @property
def symmetry_operations(self) -> Rotation: 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] = { _symmetry_operations: Dict[CrystalFamily, List] = {
'cubic': [ 'cubic': [
[ 1.0, 0.0, 0.0, 0.0 ], [ 1.0, 0.0, 0.0, 0.0 ],
@ -772,28 +782,28 @@ class Crystal():
Directions and planes of deformation mode families. Directions and planes of deformation mode families.
""" """
_kinematics: Dict[CrystalLattice, Dict[CrystalKinematics, List[np.ndarray]]] = { _kinematics: Dict[BravaisLattice, Dict[CrystalKinematics, List[np.ndarray]]] = {
'cF': { 'cF': {
'slip': [np.array([ 'slip': [np.array([
[+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,-1,+0, +1,+1,+1], [+1,-1, 0, +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,+1,+0, -1,-1,+1], [-1,+1, 0, -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,+1,+0, +1,-1,-1], [+1,+1, 0, +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,-1,+0, -1,+1,-1]]), [-1,-1, 0, -1,+1,-1]]),
np.array([ 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],
[+1,+0,+1, +1,+0,-1], [+1, 0,+1, +1, 0,-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],
[+0,+1,-1, +0,+1,+1]])], [ 0,+1,-1, 0,+1,+1]])],
'twin': [np.array([ 'twin': [np.array([
[-2, 1, 1, 1, 1, 1], [-2, 1, 1, 1, 1, 1],
[ 1,-2, 1, 1, 1, 1], [ 1,-2, 1, 1, 1, 1],
@ -810,18 +820,18 @@ class Crystal():
}, },
'cI': { 'cI': {
'slip': [np.array([ '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, +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,+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]]), [-1,-1,+1, -1,+1, 0]]),
np.array([ np.array([
[-1,+1,+1, +2,+1,+1], [-1,+1,+1, +2,+1,+1],
[+1,+1,+1, -2,+1,+1], [+1,+1,+1, -2,+1,+1],
@ -876,33 +886,33 @@ class Crystal():
}, },
'hP': { 'hP': {
'slip': [np.array([ 'slip': [np.array([
[+2,-1,-1,+0, +0,+0,+0,+1], [+2,-1,-1, 0, 0, 0, 0,+1],
[-1,+2,-1,+0, +0,+0,+0,+1], [-1,+2,-1, 0, 0, 0, 0,+1],
[-1,-1,+2,+0, +0,+0,+0,+1]]), [-1,-1,+2, 0, 0, 0, 0,+1]]),
np.array([ np.array([
[+2,-1,-1,+0, +0,+1,-1,+0], [+2,-1,-1, 0, 0,+1,-1, 0],
[-1,+2,-1,+0, -1,+0,+1,+0], [-1,+2,-1, 0, -1, 0,+1, 0],
[-1,-1,+2,+0, +1,-1,+0,+0]]), [-1,-1,+2, 0, +1,-1, 0, 0]]),
np.array([ np.array([
[-1,+2,-1,+0, +1,+0,-1,+1], [-1,+2,-1, 0, +1, 0,-1,+1],
[-2,+1,+1,+0, +0,+1,-1,+1], [-2,+1,+1, 0, 0,+1,-1,+1],
[-1,-1,+2,+0, -1,+1,+0,+1], [-1,-1,+2, 0, -1,+1, 0,+1],
[+1,-2,+1,+0, -1,+0,+1,+1], [+1,-2,+1, 0, -1, 0,+1,+1],
[+2,-1,-1,+0, +0,-1,+1,+1], [+2,-1,-1, 0, 0,-1,+1,+1],
[+1,+1,-2,+0, +1,-1,+0,+1]]), [+1,+1,-2, 0, +1,-1, 0,+1]]),
np.array([ np.array([
[-2,+1,+1,+3, +1,+0,-1,+1], [-2,+1,+1,+3, +1, 0,-1,+1],
[-1,-1,+2,+3, +1,+0,-1,+1], [-1,-1,+2,+3, +1, 0,-1,+1],
[-1,-1,+2,+3, +0,+1,-1,+1], [-1,-1,+2,+3, 0,+1,-1,+1],
[+1,-2,+1,+3, +0,+1,-1,+1], [+1,-2,+1,+3, 0,+1,-1,+1],
[+1,-2,+1,+3, -1,+1,+0,+1], [+1,-2,+1,+3, -1,+1, 0,+1],
[+2,-1,-1,+3, -1,+1,+0,+1], [+2,-1,-1,+3, -1,+1, 0,+1],
[+2,-1,-1,+3, -1,+0,+1,+1], [+2,-1,-1,+3, -1, 0,+1,+1],
[+1,+1,-2,+3, -1,+0,+1,+1], [+1,+1,-2,+3, -1, 0,+1,+1],
[+1,+1,-2,+3, +0,-1,+1,+1], [+1,+1,-2,+3, 0,-1,+1,+1],
[-1,+2,-1,+3, +0,-1,+1,+1], [-1,+2,-1,+3, 0,-1,+1,+1],
[-1,+2,-1,+3, +1,-1,+0,+1], [-1,+2,-1,+3, +1,-1, 0,+1],
[-2,+1,+1,+3, +1,-1,+0,+1]]), [-2,+1,+1,+3, +1,-1, 0,+1]]),
np.array([ np.array([
[-1,-1,+2,+3, +1,+1,-2,+2], [-1,-1,+2,+3, +1,+1,-2,+2],
[+1,-2,+1,+3, -1,+2,-1,+2], [+1,-2,+1,+3, -1,+2,-1,+2],
@ -941,61 +951,61 @@ class Crystal():
}, },
'tI': { 'tI': {
'slip': [np.array([ 'slip': [np.array([
[+0,+0,+1, +1,+0,+0], [ 0, 0,+1, +1, 0, 0],
[+0,+0,+1, +0,+1,+0]]), [ 0, 0,+1, 0,+1, 0]]),
np.array([ 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([ np.array([
[+0,+1,+0, +1,+0,+0], [ 0,+1, 0, +1, 0, 0],
[+1,+0,+0, +0,+1,+0]]), [+1, 0, 0, 0,+1, 0]]),
np.array([ 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([ 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([ np.array([
[+0,+1,+1, +1,+0,+0], [ 0,+1,+1, +1, 0, 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],
[+1,+0,+1, +0,+1,+0]]), [+1, 0,+1, 0,+1, 0]]),
np.array([ np.array([
[+0,+1,+0, +0,+0,+1], [ 0,+1, 0, 0, 0,+1],
[+1,+0,+0, +0,+0,+1]]), [+1, 0, 0, 0, 0,+1]]),
np.array([ 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([ np.array([
[+0,+1,-1, +0,+1,+1], [ 0,+1,-1, 0,+1,+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],
[+1,+0,-1, +1,+0,+1]]), [+1, 0,-1, +1, 0,+1]]),
np.array([ 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, +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,-1]]), [+1,-1,+1, +1, 0,-1]]),
np.array([ np.array([
[+1,+0,+0, +0,+1,+1], [+1, 0, 0, 0,+1,+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],
[+0,+1,+0, +1,+0,-1]]), [ 0,+1, 0, +1, 0,-1]]),
np.array([ np.array([
[+0,+1,-1, +2,+1,+1], [ 0,+1,-1, +2,+1,+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],
[-1,+0,-1, -1,+2,+1], [-1, 0,-1, -1,+2,+1],
[+0,+1,-1, -2,+1,+1], [ 0,+1,-1, -2,+1,+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],
[+1,+0,-1, +1,-2,+1]]), [+1, 0,-1, +1,-2,+1]]),
np.array([ np.array([
[-1,+1,+1, +2,+1,+1], [-1,+1,+1, +2,+1,+1],
[-1,-1,+1, +2,-1,+1], [-1,-1,+1, +2,-1,+1],
@ -1015,7 +1025,7 @@ class Crystal():
def relation_operations(self, def relation_operations(self,
model: str) -> Tuple[CrystalLattice, Rotation]: model: str) -> Tuple[BravaisLattice, Rotation]:
""" """
Crystallographic orientation relationships for phase transformations. Crystallographic orientation relationships for phase transformations.

22
python/damask/_grid.py
View File

@ -358,14 +358,14 @@ class Grid:
""" """
Load DREAM.3D (HDF5) file. Load DREAM.3D (HDF5) file.
Data in DREAM.3D files can be stored per cell ('CellData') and/or Data in DREAM.3D files can be stored per cell ('CellData')
per grain ('Grain Data'). Per default, cell-wise data is assumed. 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 Parameters
---------- ----------
fname : str or or pathlib.Path fname : str or pathlib.Path
Filename of the DREAM.3D (HDF5) file. Filename of the DREAM.3D (HDF5) file.
feature_IDs : str, optional feature_IDs : str, optional
Name of the dataset containing the mapping between cells and Name of the dataset containing the mapping between cells and
@ -392,10 +392,18 @@ class Grid:
loaded : damask.Grid loaded : damask.Grid
Grid-based geometry from file. 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 with h5py.File(fname, 'r') as f:
c = util.DREAM3D_cell_data_group(fname) if cell_data is None else cell_data b = util.DREAM3D_base_group(f) if base_group is None else base_group
f = h5py.File(fname, 'r') c = util.DREAM3D_cell_data_group(f) if cell_data is None else cell_data
cells = f['/'.join([b,'_SIMPL_GEOMETRY','DIMENSIONS'])][()] cells = f['/'.join([b,'_SIMPL_GEOMETRY','DIMENSIONS'])][()]
size = f['/'.join([b,'_SIMPL_GEOMETRY','SPACING'])] * cells size = f['/'.join([b,'_SIMPL_GEOMETRY','SPACING'])] * cells

6
python/damask/_orientation.py
View File

@ -3,7 +3,7 @@ from typing import Optional, Union, TypeVar
import numpy as np import numpy as np
from ._typehints import FloatSequence, IntSequence, CrystalFamily, CrystalLattice from ._typehints import FloatSequence, IntSequence, CrystalFamily, BravaisLattice
from . import Rotation from . import Rotation
from . import Crystal from . import Crystal
from . import util from . import util
@ -73,7 +73,7 @@ class Orientation(Rotation,Crystal):
rotation: Union[FloatSequence, Rotation] = np.array([1.,0.,0.,0.]), rotation: Union[FloatSequence, Rotation] = np.array([1.,0.,0.,0.]),
*, *,
family: Optional[CrystalFamily] = None, family: Optional[CrystalFamily] = None,
lattice: Optional[CrystalLattice] = None, lattice: Optional[BravaisLattice] = None,
a: Optional[float] = None, b: Optional[float] = None, c: Optional[float] = 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, alpha: Optional[float] = None, beta: Optional[float] = None, gamma: Optional[float] = None,
degrees: bool = False): degrees: bool = False):
@ -833,7 +833,7 @@ class Orientation(Rotation,Crystal):
>>> import damask >>> import damask
>>> np.set_printoptions(3,suppress=True,floatmode='fixed') >>> np.set_printoptions(3,suppress=True,floatmode='fixed')
>>> O = damask.Orientation.from_Euler_angles(phi=[0,45,0],degrees=True,lattice='cF') >>> 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], array([[ 0.000, 0.000, 0.000],
[ 0.577, -0.000, 0.816], [ 0.577, -0.000, 0.816],
[ 0.000, 0.000, 0.000]]) [ 0.000, 0.000, 0.000]])

619
python/damask/_result.py
View File

@ -1,5 +1,3 @@
import multiprocessing as mp
from multiprocessing.synchronize import Lock
import re import re
import fnmatch import fnmatch
import os import os
@ -7,8 +5,8 @@ import copy
import datetime import datetime
import xml.etree.ElementTree as ET # noqa import xml.etree.ElementTree as ET # noqa
import xml.dom.minidom import xml.dom.minidom
import functools
from pathlib import Path from pathlib import Path
from functools import partial
from collections import defaultdict from collections import defaultdict
from collections.abc import Iterable from collections.abc import Iterable
from typing import Optional, Union, Callable, Any, Sequence, Literal, Dict, List, Tuple 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()) 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): def add_absolute(self, x: str):
""" """
Add absolute value. Add absolute value.
@ -647,28 +634,20 @@ class Result:
Name of scalar, vector, or tensor dataset to take absolute value of. 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]:
@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 { return {
'data': data, 'data': np.abs(x['data']),
'label': kwargs['label'], 'label': f'|{x["label"]}|',
'meta': { 'meta': {
'unit': kwargs['unit'], 'unit': x['meta']['unit'],
'description': f"{kwargs['description']} (formula: {kwargs['formula']})", 'description': f"absolute value of {x['label']} ({x['meta']['description']})",
'creator': 'add_calculation' 'creator': 'add_absolute'
} }
} }
self._add_generic_pointwise(absolute,{'x':x})
def add_calculation(self, def add_calculation(self,
formula: str, formula: str,
name: str, name: str,
@ -717,24 +696,30 @@ class Result:
... 'Mises equivalent of the Cauchy stress') ... '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 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} 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, def add_stress_Cauchy(self,
P: str = 'P', P: str = 'P',
F: str = 'F'): F: str = 'F'):
@ -751,20 +736,23 @@ class Result:
Defaults to 'F'. 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]:
@staticmethod
def _add_determinant(T: Dict[str, Any]) -> Dict[str, Any]:
return { return {
'data': np.linalg.det(T['data']), 'data': mechanics.stress_Cauchy(P['data'],F['data']),
'label': f"det({T['label']})", 'label': 'sigma',
'meta': { 'meta': {
'unit': T['meta']['unit'], 'unit': P['meta']['unit'],
'description': f"determinant of tensor {T['label']} ({T['meta']['description']})", 'description': "Cauchy stress calculated "
'creator': 'add_determinant' 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})
def add_determinant(self, T: str): def add_determinant(self, T: str):
""" """
Add the determinant of a tensor. Add the determinant of a tensor.
@ -783,20 +771,21 @@ class Result:
>>> r.add_determinant('F_p') >>> r.add_determinant('F_p')
""" """
self._add_generic_pointwise(self._add_determinant,{'T':T})
def determinant(T: Dict[str, Any]) -> Dict[str, Any]:
@staticmethod
def _add_deviator(T: Dict[str, Any]) -> Dict[str, Any]:
return { return {
'data': tensor.deviatoric(T['data']), 'data': np.linalg.det(T['data']),
'label': f"s_{T['label']}", 'label': f"det({T['label']})",
'meta': { 'meta': {
'unit': T['meta']['unit'], 'unit': T['meta']['unit'],
'description': f"deviator of tensor {T['label']} ({T['meta']['description']})", 'description': f"determinant of tensor {T['label']} ({T['meta']['description']})",
'creator': 'add_deviator' 'creator': 'add_determinant'
} }
} }
self._add_generic_pointwise(determinant,{'T':T})
def add_deviator(self, T: str): def add_deviator(self, T: str):
""" """
Add the deviatoric part of a tensor. Add the deviatoric part of a tensor.
@ -815,29 +804,21 @@ class Result:
>>> r.add_deviator('sigma') >>> r.add_deviator('sigma')
""" """
self._add_generic_pointwise(self._add_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}')
def deviator(T: Dict[str, Any]) -> Dict[str, Any]:
return { return {
'data': tensor.eigenvalues(T_sym['data'])[:,p], 'data': tensor.deviatoric(T['data']),
'label': f"lambda_{eigenvalue}({T_sym['label']})", 'label': f"s_{T['label']}",
'meta': { 'meta': {
'unit': T_sym['meta']['unit'], 'unit': T['meta']['unit'],
'description': f"{label} eigenvalue of {T_sym['label']} ({T_sym['meta']['description']})", 'description': f"deviator of tensor {T['label']} ({T['meta']['description']})",
'creator': 'add_eigenvalue' 'creator': 'add_deviator'
} }
} }
self._add_generic_pointwise(deviator,{'T':T})
def add_eigenvalue(self, def add_eigenvalue(self,
T_sym: str, T_sym: str,
eigenvalue: Literal['max', 'mid', 'min'] = 'max'): eigenvalue: Literal['max', 'mid', 'min'] = 'max'):
@ -860,11 +841,47 @@ class Result:
>>> r.add_eigenvalue('sigma','min') >>> 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(self,
def _add_eigenvector(T_sym: Dict[str, Any], eigenvalue: Literal['max', 'mid', 'min']) -> Dict[str, Any]: T_sym: str,
eigenvalue: Literal['max', 'mid', 'min'] = 'max'):
"""
Add eigenvector of symmetric tensor.
Parameters
----------
T_sym : str
Name of symmetric tensor dataset.
eigenvalue : {'max', 'mid', 'min'}, optional
Eigenvalue to which the eigenvector corresponds.
Defaults to 'max'.
"""
def eigenvector(T_sym: Dict[str, Any], eigenvalue: Literal['max', 'mid', 'min']) -> Dict[str, Any]:
if eigenvalue == 'max': if eigenvalue == 'max':
label,p = 'maximum',2 label,p = 'maximum',2
elif eigenvalue == 'mid': elif eigenvalue == 'mid':
@ -884,40 +901,10 @@ class Result:
'creator': 'add_eigenvector' 'creator': 'add_eigenvector'
} }
} }
def add_eigenvector(self,
T_sym: str,
eigenvalue: Literal['max', 'mid', 'min'] = 'max'):
"""
Add eigenvector of symmetric tensor.
Parameters self._add_generic_pointwise(eigenvector,{'T_sym':T_sym},{'eigenvalue':eigenvalue})
----------
T_sym : str
Name of symmetric tensor dataset.
eigenvalue : {'max', 'mid', 'min'}, optional
Eigenvalue to which the eigenvector corresponds.
Defaults to 'max'.
"""
self._add_generic_pointwise(self._add_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, def add_IPF_color(self,
l: FloatSequence, l: FloatSequence,
q: str = 'O'): q: str = 'O'):
@ -941,20 +928,26 @@ class Result:
>>> r.add_IPF_color(np.array([0,1,1])) >>> 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)
@staticmethod
def _add_maximum_shear(T_sym: Dict[str, Any]) -> Dict[str, Any]:
return { return {
'data': mechanics.maximum_shear(T_sym['data']), 'data': np.uint8(o.IPF_color(l)*255),
'label': f"max_shear({T_sym['label']})", 'label': 'IPFcolor_({} {} {})'.format(*m),
'meta' : { 'meta' : {
'unit': T_sym['meta']['unit'], 'unit': '8-bit RGB',
'description': f"maximum shear component of {T_sym['label']} ({T_sym['meta']['description']})", 'lattice': q['meta']['lattice'],
'creator': 'add_maximum_shear' '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})
def add_maximum_shear(self, T_sym: str): def add_maximum_shear(self, T_sym: str):
""" """
Add maximum shear components of symmetric tensor. Add maximum shear components of symmetric tensor.
@ -965,30 +958,20 @@ class Result:
Name of symmetric tensor dataset. 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]:
@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 { return {
'data': (mechanics.equivalent_strain_Mises if k=='strain' else \ 'data': mechanics.maximum_shear(T_sym['data']),
mechanics.equivalent_stress_Mises)(T_sym['data']), 'label': f"max_shear({T_sym['label']})",
'label': f"{T_sym['label']}_vM",
'meta': { 'meta': {
'unit': T_sym['meta']['unit'], 'unit': T_sym['meta']['unit'],
'description': f"Mises equivalent {k} of {T_sym['label']} ({T_sym['meta']['description']})", 'description': f"maximum shear component of {T_sym['label']} ({T_sym['meta']['description']})",
'creator': 'add_Mises' 'creator': 'add_maximum_shear'
} }
} }
self._add_generic_pointwise(maximum_shear,{'T_sym':T_sym})
def add_equivalent_Mises(self, def add_equivalent_Mises(self,
T_sym: str, T_sym: str,
kind: Optional[str] = None): kind: Optional[str] = None):
@ -1018,11 +1001,45 @@ class Result:
>>> r.add_equivalent_Mises('epsilon_V^0.0(F)') >>> 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(self,
def _add_norm(x: Dict[str, Any], ord: Union[int, float, Literal['fro', 'nuc']]) -> Dict[str, Any]: x: str,
ord: Union[None, int, float, Literal['fro', 'nuc']] = None):
"""
Add the norm of a vector or tensor.
Parameters
----------
x : str
Name of vector or tensor dataset.
ord : {non-zero int, inf, -inf, 'fro', 'nuc'}, optional
Order of the norm. inf means NumPy's inf object. For details refer to numpy.linalg.norm.
"""
def norm(x: Dict[str, Any], ord: Union[int, float, Literal['fro', 'nuc']]) -> Dict[str, Any]:
o = ord o = ord
if len(x['data'].shape) == 2: if len(x['data'].shape) == 2:
axis: Union[int, Tuple[int, int]] = 1 axis: Union[int, Tuple[int, int]] = 1
@ -1044,36 +1061,10 @@ class Result:
'creator': 'add_norm' 'creator': 'add_norm'
} }
} }
def add_norm(self,
x: str,
ord: Union[None, int, float, Literal['fro', 'nuc']] = None):
"""
Add the norm of a vector or tensor.
Parameters self._add_generic_pointwise(norm,{'x':x},{'ord':ord})
----------
x : str
Name of vector or tensor dataset.
ord : {non-zero int, inf, -inf, 'fro', 'nuc'}, optional
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})
@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, def add_stress_second_Piola_Kirchhoff(self,
P: str = 'P', P: str = 'P',
F: str = 'F'): F: str = 'F'):
@ -1096,34 +1087,23 @@ class Result:
is taken into account. 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]:
@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 { return {
'data': ori.to_pole(uvw=uvw,hkl=hkl,with_symmetry=with_symmetry,normalize=normalize), 'data': mechanics.stress_second_Piola_Kirchhoff(P['data'],F['data']),
'label': label, 'label': 'S',
'meta': { 'meta': {
'unit': '1', 'unit': P['meta']['unit'],
'description': f'{"normalized " if normalize else ""}lab frame vector along lattice ' \ 'description': "second Piola-Kirchhoff stress calculated "
+ ('direction' if uvw is not None else 'plane') \ f"from {P['label']} ({P['meta']['description']})"
+ ('s' if with_symmetry else ''), f" and {F['label']} ({F['meta']['description']})",
'creator': 'add_pole' 'creator': 'add_stress_second_Piola_Kirchhoff'
} }
} }
self._add_generic_pointwise(stress_second_Piola_Kirchhoff,{'P':P,'F':F})
def add_pole(self, def add_pole(self,
q: str = 'O', q: str = 'O',
*, *,
@ -1149,22 +1129,33 @@ class Result:
Defaults to True. Defaults to True.
""" """
self._add_generic_pointwise(self._add_pole, def pole(q: Dict[str, Any],
{'q':q}, uvw: FloatSequence,
{'uvw':uvw,'hkl':hkl,'with_symmetry':with_symmetry,'normalize':normalize}) 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)
@staticmethod
def _add_rotation(F: Dict[str, Any]) -> Dict[str, Any]:
return { return {
'data': mechanics.rotation(F['data']).as_matrix(), 'data': ori.to_pole(uvw=uvw,hkl=hkl,with_symmetry=with_symmetry,normalize=normalize),
'label': f"R({F['label']})", 'label': label,
'meta' : { 'meta' : {
'unit': F['meta']['unit'], 'unit': '1',
'description': f"rotational part of {F['label']} ({F['meta']['description']})", 'description': f'{"normalized " if normalize else ""}lab frame vector along lattice ' \
'creator': 'add_rotation' + ('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})
def add_rotation(self, F: str): def add_rotation(self, F: str):
""" """
Add rotational part of a deformation gradient. Add rotational part of a deformation gradient.
@ -1183,20 +1174,20 @@ class Result:
>>> r.add_rotation('F') >>> r.add_rotation('F')
""" """
self._add_generic_pointwise(self._add_rotation,{'F':F}) def rotation(F: Dict[str, Any]) -> Dict[str, Any]:
@staticmethod
def _add_spherical(T: Dict[str, Any]) -> Dict[str, Any]:
return { return {
'data': tensor.spherical(T['data'],False), 'data': mechanics.rotation(F['data']).as_matrix(),
'label': f"p_{T['label']}", 'label': f"R({F['label']})",
'meta': { 'meta': {
'unit': T['meta']['unit'], 'unit': F['meta']['unit'],
'description': f"spherical component of tensor {T['label']} ({T['meta']['description']})", 'description': f"rotational part of {F['label']} ({F['meta']['description']})",
'creator': 'add_spherical' 'creator': 'add_rotation'
} }
} }
self._add_generic_pointwise(rotation,{'F':F})
def add_spherical(self, T: str): def add_spherical(self, T: str):
""" """
Add the spherical (hydrostatic) part of a tensor. Add the spherical (hydrostatic) part of a tensor.
@ -1215,30 +1206,29 @@ class Result:
>>> r.add_spherical('sigma') >>> r.add_spherical('sigma')
""" """
self._add_generic_pointwise(self._add_spherical,{'T':T}) def spherical(T: Dict[str, Any]) -> Dict[str, Any]:
@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 { return {
'data': mechanics.strain(F['data'],t,m), 'data': tensor.spherical(T['data'],False),
'label': f"epsilon_{t}^{m}({F['label']})", 'label': f"p_{T['label']}",
'meta': { 'meta': {
'unit': F['meta']['unit'], 'unit': T['meta']['unit'],
'description': f'strain tensor of order {m} based on {side} stretch tensor '+\ 'description': f"spherical component of tensor {T['label']} ({T['meta']['description']})",
f"of {F['label']} ({F['meta']['description']})", 'creator': 'add_spherical'
'creator': 'add_strain'
} }
} }
self._add_generic_pointwise(spherical,{'T':T})
def add_strain(self, def add_strain(self,
F: str = 'F', F: str = 'F',
t: Literal['V', 'U'] = 'V', t: Literal['V', 'U'] = 'V',
m: float = 0.0): m: float = 0.0):
""" r"""
Add strain tensor of a deformation gradient. 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 Parameters
---------- ----------
@ -1272,22 +1262,40 @@ class Result:
spatial/Eulerian strain measures (based on 'V') for elastic strains spatial/Eulerian strain measures (based on 'V') for elastic strains
when calculating averages. 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'
@staticmethod
def _add_stretch_tensor(F: Dict[str, Any], t: str) -> Dict[str, Any]:
return { return {
'data': (mechanics.stretch_left if t.upper() == 'V' else mechanics.stretch_right)(F['data']), 'data': mechanics.strain(F['data'],t,m),
'label': f"{t}({F['label']})", 'label': f"epsilon_{t}^{m}({F['label']})",
'meta': { 'meta': {
'unit': F['meta']['unit'], 'unit': F['meta']['unit'],
'description': f"{'left' if t.upper() == 'V' else 'right'} stretch tensor "\ 'description': f'Seth-Hill strain tensor of order {m} based on {side} stretch tensor '+\
+f"of {F['label']} ({F['meta']['description']})", # noqa f"of {F['label']} ({F['meta']['description']})",
'creator': 'add_stretch_tensor' 'creator': 'add_strain'
} }
} }
self._add_generic_pointwise(strain,{'F':F},{'t':t,'m':m})
def add_stretch_tensor(self, def add_stretch_tensor(self,
F: str = 'F', F: str = 'F',
t: Literal['V', 'U'] = 'V'): t: Literal['V', 'U'] = 'V'):
@ -1303,20 +1311,21 @@ class Result:
Defaults to 'V'. 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]:
@staticmethod
def _add_curl(f: Dict[str, Any], size: np.ndarray) -> Dict[str, Any]:
return { return {
'data': grid_filters.curl(size,f['data']), 'data': (mechanics.stretch_left if t.upper() == 'V' else mechanics.stretch_right)(F['data']),
'label': f"curl({f['label']})", 'label': f"{t}({F['label']})",
'meta': { 'meta': {
'unit': f['meta']['unit']+'/m', 'unit': F['meta']['unit'],
'description': f"curl of {f['label']} ({f['meta']['description']})", 'description': f"{'left' if t.upper() == 'V' else 'right'} stretch tensor "\
'creator': 'add_curl' +f"of {F['label']} ({F['meta']['description']})", # noqa
'creator': 'add_stretch_tensor'
} }
} }
self._add_generic_pointwise(stretch_tensor,{'F':F},{'t':t})
def add_curl(self, f: str): def add_curl(self, f: str):
""" """
Add curl of a field. Add curl of a field.
@ -1332,20 +1341,20 @@ class Result:
i.e. fields resulting from the grid solver. 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]:
@staticmethod
def _add_divergence(f: Dict[str, Any], size: np.ndarray) -> Dict[str, Any]:
return { return {
'data': grid_filters.divergence(size,f['data']), 'data': grid_filters.curl(size,f['data']),
'label': f"divergence({f['label']})", 'label': f"curl({f['label']})",
'meta': { 'meta': {
'unit': f['meta']['unit']+'/m', 'unit': f['meta']['unit']+'/m',
'description': f"divergence of {f['label']} ({f['meta']['description']})", 'description': f"curl of {f['label']} ({f['meta']['description']})",
'creator': 'add_divergence' 'creator': 'add_curl'
} }
} }
self._add_generic_grid(curl,{'f':f},{'size':self.size})
def add_divergence(self, f: str): def add_divergence(self, f: str):
""" """
Add divergence of a field. Add divergence of a field.
@ -1361,21 +1370,20 @@ class Result:
i.e. fields resulting from the grid solver. 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]:
@staticmethod
def _add_gradient(f: Dict[str, Any], size: np.ndarray) -> Dict[str, Any]:
return { return {
'data': grid_filters.gradient(size,f['data'] if len(f['data'].shape) == 4 else \ 'data': grid_filters.divergence(size,f['data']),
f['data'].reshape(f['data'].shape+(1,))), 'label': f"divergence({f['label']})",
'label': f"gradient({f['label']})",
'meta': { 'meta': {
'unit': f['meta']['unit']+'/m', 'unit': f['meta']['unit']+'/m',
'description': f"gradient of {f['label']} ({f['meta']['description']})", 'description': f"divergence of {f['label']} ({f['meta']['description']})",
'creator': 'add_gradient' 'creator': 'add_divergence'
} }
} }
self._add_generic_grid(divergence,{'f':f},{'size':self.size})
def add_gradient(self, f: str): def add_gradient(self, f: str):
""" """
Add gradient of a field. Add gradient of a field.
@ -1391,7 +1399,19 @@ class Result:
i.e. fields resulting from the grid solver. 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, def _add_generic_grid(self,
@ -1453,29 +1473,6 @@ class Result:
f'damask.Result.{creator} v{damask.version}'.encode() 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, def _add_generic_pointwise(self,
@ -1497,8 +1494,24 @@ class Result:
Arguments parsed to func. 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 = [] groups = []
with h5py.File(self.fname,'r') as f: with h5py.File(self.fname,'r') as f:
@ -1513,12 +1526,10 @@ class Result:
print('No matching dataset found, no data was added.') print('No matching dataset found, no data was added.')
return 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 for group in util.show_progress(groups):
if not result: if not (result := job_pointwise(group, callback=func, datasets=datasets, args=args)): # type: ignore
continue continue
lock.acquire()
with h5py.File(self.fname, 'a') as f: with h5py.File(self.fname, 'a') as f:
try: try:
if not self._protected and '/'.join([group,result['label']]) in f: if not self._protected and '/'.join([group,result['label']]) in f:
@ -1550,10 +1561,6 @@ class Result:
except (OSError,RuntimeError) as err: except (OSError,RuntimeError) as err:
print(f'Could not add dataset: {err}.') print(f'Could not add dataset: {err}.')
lock.release()
pool.close()
pool.join()
def _mappings(self): def _mappings(self):
@ -2192,7 +2199,7 @@ class Result:
cfg_dir = (Path.cwd() if target_dir is None else Path(target_dir)) cfg_dir = (Path.cwd() if target_dir is None else Path(target_dir))
with h5py.File(self.fname,'r') as f_in: with h5py.File(self.fname,'r') as f_in:
f_in['setup'].visititems(partial(export, f_in['setup'].visititems(functools.partial(export,
output=output, output=output,
cfg_dir=cfg_dir, cfg_dir=cfg_dir,
overwrite=overwrite)) overwrite=overwrite))

137
python/damask/_rotation.py
View File

@ -307,7 +307,8 @@ class Rotation:
p_m = self.quaternion[...,1:] p_m = self.quaternion[...,1:]
q_o = other.quaternion[...,0:1] q_o = other.quaternion[...,0:1]
p_o = other.quaternion[...,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) 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()) return self.copy(Rotation(np.block([q,p]))._standardize())
else: else:
@ -374,6 +375,11 @@ class Rotation:
Return self@other. Return self@other.
Rotate vector, second-order tensor, or fourth-order tensor. 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 Parameters
---------- ----------
@ -385,29 +391,73 @@ class Rotation:
rotated : numpy.ndarray, shape (...,3), (...,3,3), or (...,3,3,3,3) rotated : numpy.ndarray, shape (...,3), (...,3,3), or (...,3,3,3,3)
Rotated vector or tensor, i.e. transformed to frame defined by rotation. 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 isinstance(other, np.ndarray):
if self.shape + (3,) == other.shape: obs = util.shapeblender(self.shape,other.shape,keep_ones=False)[len(self.shape):]
q_m = self.quaternion[...,0] for l in [4,2,1]:
p_m = self.quaternion[...,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) A = q_m**2 - np.einsum('...i,...i',p_m,p_m)
B = 2. * np.einsum('...i,...i',p_m,other) B = 2. * np.einsum('...i,...i',p_m,other)
C = 2. * _P * q_m C = 2. * _P * q_m
return np.block([(A * other[...,i]).reshape(self.shape+(1,)) + return np.block([(A * other[...,i]) +
(B * p_m[...,i]).reshape(self.shape+(1,)) + (B * p_m[...,i]) +
(C * ( p_m[...,(i+1)%3]*other[...,(i+2)%3]\ (C * ( p_m[...,(i+1)%3]*other[...,(i+2)%3]
- p_m[...,(i+2)%3]*other[...,(i+1)%3])).reshape(self.shape+(1,)) - p_m[...,(i+2)%3]*other[...,(i+1)%3]))
for i in [0,1,2]]) for i in [0,1,2]]).reshape(bs+(3,),order='F')
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: 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') raise ValueError('can only rotate vectors, second-order tensors, and fourth-order tensors')
elif isinstance(other, Rotation): 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: else:
raise TypeError(f'cannot rotate "{type(other)}"') raise TypeError(f'cannot rotate "{type(other)}"')
@ -1323,28 +1373,41 @@ class Rotation:
@staticmethod @staticmethod
def _qu2eu(qu: np.ndarray) -> np.ndarray: def _qu2eu(qu: np.ndarray) -> np.ndarray:
"""Quaternion to Bunge Euler angles.""" """
q02 = qu[...,0:1]*qu[...,2:3] Quaternion to Bunge Euler angles.
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)
eu = np.where(np.abs(q12_s) < 1.e-8, References
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,))]), E. Bernardes and S. Viollet, PLoS ONE 17(11):e0276302, 2022
np.where(np.abs(q03_s) < 1.e-8, https://doi.org/10.1371/journal.pone.0276302
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,))]), a = qu[...,0:1]
np.block([np.arctan2((-_P*q02+q13)*chi, (-_P*q01-q23)*chi), b = -_P*qu[...,3:4]
np.arctan2( 2.*chi, q03_s-q12_s ), c = -_P*qu[...,1:2]
np.arctan2(( _P*q02+q13)*chi, (-_P*q01+q23)*chi)]) d = -_P*qu[...,2:3]
)
) eu = np.block([
eu[np.abs(eu) < 1.e-6] = 0. 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) return np.where(eu < 0., eu%(np.pi*np.array([2.,1.,2.])),eu)
@staticmethod @staticmethod

2
python/damask/_typehints.py
View File

@ -11,7 +11,7 @@ IntSequence = Union[np.ndarray,Sequence[int]]
StrSequence = Union[np.ndarray,Sequence[str]] StrSequence = Union[np.ndarray,Sequence[str]]
FileHandle = Union[TextIO, str, Path] FileHandle = Union[TextIO, str, Path]
CrystalFamily = Union[None,Literal['triclinic', 'monoclinic', 'orthorhombic', 'tetragonal', 'hexagonal', 'cubic']] 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'] CrystalKinematics = Literal['slip', 'twin']
NumpyRngSeed = Union[int, IntSequence, np.random.SeedSequence, np.random.Generator] NumpyRngSeed = Union[int, IntSequence, np.random.SeedSequence, np.random.Generator]
# BitGenerator does not exists in older numpy versions # 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 pathlib import Path
from typing import Literal from typing import Literal
_marc_version = '2022.4' _marc_version = '2023.1'
_marc_root = '/opt/msc' _marc_root = '/opt/msc'
_damask_root = str(Path(__file__).parents[3]) _damask_root = str(Path(__file__).parents[3])

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

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 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.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.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.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.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.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.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.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.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.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.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.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.4714045207910318 0.23570226039551595 0.23570226039551595 -0.4714045207910318 0.23570226039551595 0.23570226039551595 -0.4714045207910318 0.23570226039551595 0.23570226039551595
0.47140452079103173 -0.2357022603955159 0.23570226039551584 0.47140452079103173 -0.2357022603955159 0.23570226039551584 -0.4714045207910318 0.23570226039551595 -0.23570226039551587 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.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.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.23570226039551587 0.47140452079103173 0.23570226039551584 -0.23570226039551587 0.47140452079103173 0.23570226039551584 0.2357022603955159 -0.4714045207910318 -0.23570226039551587
0.2357022603955159 -0.4714045207910318 0.23570226039551595 0.2357022603955159 -0.4714045207910318 0.23570226039551595 0.2357022603955159 -0.4714045207910318 0.23570226039551595 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.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.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 -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.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.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.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.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.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 -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.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.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.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 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} elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke}
plastic: plastic:
N_sl: [12] N_sl: [12]
a_sl: 2.25 a_sl: [2.25]
atol_xi: 1.0 atol_xi: 1.0
dot_gamma_0_sl: 0.001 dot_gamma_0_sl: [0.001]
h_0_sl-sl: 75e6 h_0_sl-sl: [75e6]
h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4] h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4]
n_sl: 20 n_sl: [20]
output: [xi_sl] output: [xi_sl]
type: phenopowerlaw type: phenopowerlaw
xi_0_sl: [31e6] xi_0_sl: [31e6]
@ -29,12 +29,12 @@ phase:
elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke} elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke}
plastic: plastic:
N_sl: [12] N_sl: [12]
a_sl: 2.25 a_sl: [2.25]
atol_xi: 1.0 atol_xi: 1.0
dot_gamma_0_sl: 0.001 dot_gamma_0_sl: [0.001]
h_0_sl-sl: 75e6 h_0_sl-sl: [75e6]
h_sl-sl: [1, 1.4, 1, 1.4, 1.4, 1.4, 1.4] h_sl-sl: [1, 1.4, 1, 1.4, 1.4, 1.4, 1.4]
n_sl: 20 n_sl: [20]
output: [xi_sl] output: [xi_sl]
type: phenopowerlaw type: phenopowerlaw
xi_0_sl: [31e6] 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} elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke}
plastic: plastic:
N_sl: [12] N_sl: [12]
a_sl: 2.25 a_sl: [2.25]
atol_xi: 1.0 atol_xi: 1.0
dot_gamma_0_sl: 0.001 dot_gamma_0_sl: [0.001]
h_0_sl-sl: 75e6 h_0_sl-sl: [75e6]
h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4] h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4]
n_sl: 20 n_sl: [20]
output: [xi_sl] output: [xi_sl]
type: phenopowerlaw type: phenopowerlaw
xi_0_sl: [31e6] xi_0_sl: [31e6]
@ -661,12 +661,12 @@ phase:
elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke} elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke}
plastic: plastic:
N_sl: [12] N_sl: [12]
a_sl: 2.25 a_sl: [2.25]
atol_xi: 1.0 atol_xi: 1.0
dot_gamma_0_sl: 0.001 dot_gamma_0_sl: [0.001]
h_0_sl-sl: 75e6 h_0_sl-sl: [75e6]
h_sl-sl: [1, 1.4, 1, 1.4, 1.4, 1.4, 1.4] h_sl-sl: [1, 1.4, 1, 1.4, 1.4, 1.4, 1.4]
n_sl: 20 n_sl: [20]
output: [xi_sl] output: [xi_sl]
type: phenopowerlaw type: phenopowerlaw
xi_0_sl: [31e6] 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} elastic: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: Hooke}
plastic: plastic:
N_sl: [12] N_sl: [12]
a_sl: 2.25 a_sl: [2.25]
atol_xi: 1.0 atol_xi: 1.0
dot_gamma_0_sl: 0.001 dot_gamma_0_sl: [0.001]
h_0_sl-sl: 75e6 h_0_sl-sl: [75e6]
h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4] h_sl-sl: [1, 1, 1.4, 1.4, 1.4, 1.4, 1.4]
n_sl: 20 n_sl: [20]
output: [xi_sl] output: [xi_sl]
type: phenopowerlaw type: phenopowerlaw
xi_0_sl: [31e6] xi_0_sl: [31e6]

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

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 == '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 == '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') 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') default.add_gradient('x')
in_file = default.place('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) 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) 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])), @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_quaternion, np.array([1,1,1,0])),
(Rotation.from_Euler_angles, np.array([1,4,0])), (Rotation.from_Euler_angles, np.array([1,4,0])),
@ -1058,7 +1065,7 @@ class TestRotation:
@pytest.mark.parametrize('data',[np.random.rand(4), @pytest.mark.parametrize('data',[np.random.rand(4),
np.random.rand(3,2), 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): def test_rotate_invalid_shape(self,data):
R = Rotation.from_random() R = Rotation.from_random()
with pytest.raises(ValueError): 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[1]),
np.arange(cells[2]),indexing='ij')).reshape(tuple(cells)+(3,),order='F') np.arange(cells[2]),indexing='ij')).reshape(tuple(cells)+(3,),order='F')
x,y,z = map(np.random.randint,cells) 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): def test_unravel_index(self):
cells = np.random.randint(8,32,(3)) 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): with pytest.raises(ValueError):
util.shapeshifter(fro,to,mode) util.shapeshifter(fro,to,mode)
@pytest.mark.parametrize('a,b,answer', @pytest.mark.parametrize('a,b,ones,answer',
[ [
((),(1,),(1,)), ((),(1,),True,(1,)),
((1,),(),(1,)), ((1,),(),False,(1,)),
((1,),(7,),(1,7)), ((1,1),(7,),False,(1,7)),
((2,),(2,2),(2,2)), ((1,),(7,),False,(7,)),
((1,2),(2,2),(1,2,2)), ((1,),(7,),True,(1,7)),
((1,2,3),(2,3,4),(1,2,3,4)), ((2,),(2,2),False,(2,2)),
((1,2,3),(1,2,3),(1,2,3)), ((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): def test_shapeblender(self,a,b,ones,answer):
assert util.shapeblender(a,b) == answer assert util.shapeblender(a,b,ones) == answer
@pytest.mark.parametrize('style',[util.emph,util.deemph,util.warn,util.strikeout]) @pytest.mark.parametrize('style',[util.emph,util.deemph,util.warn,util.strikeout])
def test_decorate(self,style): def test_decorate(self,style):
assert 'DAMASK' in style('DAMASK') assert 'DAMASK' in style('DAMASK')
@pytest.mark.parametrize('complete',[True,False]) @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)) base_group = ''.join(random.choices('DAMASK', k=10))
with h5py.File(tmp_path/'base_group.dream3d','w') as f: with h5py.File(tmp_path/'base_group.dream3d','w') as f:
f.create_group('/'.join((base_group,'_SIMPL_GEOMETRY'))) f.create_group('/'.join((base_group,'_SIMPL_GEOMETRY')))
if complete: if complete:
f['/'.join((base_group,'_SIMPL_GEOMETRY'))].create_dataset('SPACING',data=np.ones(3)) 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: if complete:
assert base_group == util.DREAM3D_base_group(tmp_path/'base_group.dream3d') assert base_group == util.DREAM3D_base_group(fname)
else: else:
with pytest.raises(ValueError): with pytest.raises(ValueError):
util.DREAM3D_base_group(tmp_path/'base_group.dream3d') util.DREAM3D_base_group(fname)
@pytest.mark.parametrize('complete',[True,False]) @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)) base_group = ''.join(random.choices('DAMASK', k=10))
cell_data_group = ''.join(random.choices('KULeuven', k=10)) cell_data_group = ''.join(random.choices('KULeuven', k=10))
cells = np.random.randint(1,50,3) cells = np.random.randint(1,50,3)
@ -172,11 +180,13 @@ class TestUtil:
if complete: if complete:
f['/'.join((base_group,cell_data_group))].create_dataset('data',shape=np.append(cells,1)) 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: 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: else:
with pytest.raises(ValueError): 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',[({}, {}), @pytest.mark.parametrize('full,reduced',[({}, {}),

171
src/CLI.f90
View File

@ -21,14 +21,16 @@ module CLI
implicit none(type,external) implicit none(type,external)
private private
integer, public, protected :: & integer, public, protected :: &
CLI_restartInc = 0 !< Increment at which calculation starts CLI_restartInc = 0 !< increment at which calculation starts
character(len=:), allocatable, public, protected :: & character(len=:), allocatable, public, protected :: &
CLI_geomFile, & !< parameter given for geometry file CLI_geomFile, & !< location of the geometry file
CLI_loadFile, & !< parameter given for load case file CLI_loadFile, & !< location of the load case file
CLI_materialFile CLI_materialFile, & !< location of the material configuration file
CLI_numericsFile, & !< location of the numerics configuration file
solverJobname
public :: & public :: &
getSolverJobName, & getSolverJobname, &
CLI_init CLI_init
contains contains
@ -47,15 +49,18 @@ subroutine CLI_init()
character(len=:), allocatable :: & character(len=:), allocatable :: &
commandLine, & !< command line call as string commandLine, & !< command line call as string
arg, & !< individual argument arg, & !< individual argument
loadCaseArg, & !< -l argument given to the executable geomArg, & !< -g CLI argument
geometryArg, & !< -g argument given to the executable loadArg, & !< -l CLI argument
materialArg, & !< -m argument given to the executable materialArg, & !< -m CLI argument
workingDirArg !< -w argument given to the executable numericsArg, & !< -n CLI argument
workingDirArg !< -w CLI argument
integer :: & integer :: &
stat, & stat, &
i i
integer, dimension(8) :: & integer, dimension(8) :: &
dateAndTime dateAndTime
logical :: &
hasArg
external :: & external :: &
quit quit
@ -69,7 +74,7 @@ subroutine CLI_init()
print'(a)', achar(27)//'[31m' print'(a)', achar(27)//'[31m'
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'
#else #else
print '(a)', achar(27)//'[94m' print'(a)', achar(27)//'[1;94m'
#endif #endif
print'(1x,a)', ' _/_/_/ _/_/ _/ _/ _/_/ _/_/_/ _/ _/ _/_/_/' print'(1x,a)', ' _/_/_/ _/_/ _/ _/ _/_/ _/_/_/ _/ _/ _/_/_/'
print'(1x,a)', ' _/ _/ _/ _/ _/_/ _/_/ _/ _/ _/ _/ _/ _/' print'(1x,a)', ' _/ _/ _/ _/ _/_/ _/_/ _/ _/ _/ _/ _/ _/'
@ -106,6 +111,7 @@ subroutine CLI_init()
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),i2.2)', 'Time:',dateAndTime(5),':',dateAndTime(6),':',dateAndTime(7)
do i = 1, command_argument_count() do i = 1, command_argument_count()
hasArg = i < command_argument_count()
arg = getArg(i) arg = getArg(i)
select case(trim(arg)) ! extract key select case(trim(arg)) ! extract key
case ('-h','--help') case ('-h','--help')
@ -117,60 +123,82 @@ subroutine CLI_init()
print'(1x,a)', ' --geom (-g, --geometry)' print'(1x,a)', ' --geom (-g, --geometry)'
print'(1x,a)', ' --load (-l, --loadcase)' print'(1x,a)', ' --load (-l, --loadcase)'
print'(1x,a)', ' --material (-m, --materialconfig)' 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)', ' --workingdir (-w, --wd, --workingdirectory)'
print'(1x,a)', ' --restart (-r, --rs)' print'(1x,a)', ' --restart (-r, --rs)'
print'(1x,a)', ' --help (-h)' print'(1x,a)', ' --help (-h)'
print'(/,1x,a)','-----------------------------------------------------------------------' print'(/,1x,a)','-----------------------------------------------------------------------'
print'(1x,a)', 'Mandatory arguments:' print'(1x,a)', 'Mandatory arguments:'
print '(/,1x,a)',' --geom PathToGeomFile/NameOfGeom' print'(/,1x,a)',' --geom GEOMFILE'
print '(1x,a)', ' Specifies the location of the geometry definition file.' print'(1x,a)', ' specify the file path of the geometry definition'
print '(/,1x,a)',' --load PathToLoadFile/NameOfLoadFile' print'(/,1x,a)',' --load LOADFILE'
print '(1x,a)', ' Specifies the location of the load case definition file.' print'(1x,a)', ' specify the file path of the load case definition'
print '(/,1x,a)',' --material PathToMaterialConfigurationFile/NameOfMaterialConfigurationFile' print'(/,1x,a)',' --material MATERIALFILE'
print '(1x,a)', ' Specifies the location of the material configuration file.' print'(1x,a)', ' specify the file path of the material configuration'
print'(/,1x,a)','-----------------------------------------------------------------------' print'(/,1x,a)','-----------------------------------------------------------------------'
print'(1x,a)', 'Optional arguments:' print'(1x,a)', 'Optional arguments:'
print '(/,1x,a)',' --workingdirectory PathToWorkingDirectory' print'(/,1x,a)',' --numerics NUMERICSFILE'
print '(1x,a)', ' Specifies the base directory of relative paths.' 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)',' --restart N'
print '(1x,a)', ' Reads in increment N and continues with calculating' 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)', ' increment N+1, N+2, ... based on this'
print '(1x,a)', ' Appends to existing results file' print'(1x,a)', ' works only if the restart information for increment N'
print '(1x,a)', ' "NameOfGeom_NameOfLoadFile_NameOfMaterialConfigurationFile.hdf5".' print'(1x,a)', ' is available in JOBNAME_restart.hdf5'
print '(1x,a)', ' Works only if the restart information for increment N' print'(1x,a)', ' append to existing results file JOBNAME.hdf5'
print '(1x,a)', ' is available in the base directory.'
print'(/,1x,a)','-----------------------------------------------------------------------' print'(/,1x,a)','-----------------------------------------------------------------------'
print'(1x,a)', 'Help:' print'(1x,a)', 'Help:'
print'(/,1x,a)',' --help' print'(/,1x,a)',' --help'
print'(1x,a,/)',' Prints this message and exits' print'(1x,a,/)',' Prints this message and exits'
call quit(0) ! normal Termination call quit(0) ! normal Termination
case ('-l', '--load', '--loadcase')
loadCaseArg = getArg(i+1)
case ('-g', '--geom', '--geometry') 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') case ('-m', '--material', '--materialconfig')
if (.not. hasArg) call IO_error(610,ext_msg='--material')
materialArg = getArg(i+1) 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') case ('-w', '--wd', '--workingdir', '--workingdirectory')
if (.not. hasArg) call IO_error(610,ext_msg='--workingdirectory')
workingDirArg = getArg(i+1) workingDirArg = getArg(i+1)
case ('-r', '--rs', '--restart') case ('-r', '--rs', '--restart')
if (.not. hasArg) call IO_error(610,ext_msg='--jobname')
arg = getArg(i+1) arg = getArg(i+1)
read(arg,*,iostat=stat) CLI_restartInc CLI_restartInc = IO_strAsInt(arg)
if (CLI_restartInc < 0 .or. stat /= 0) then if (CLI_restartInc < 0 .or. stat /= 0) call IO_error(611,ext_msg=arg)
print'(/,1x,a)', 'ERROR: Could not parse restart increment: '//trim(arg)
call quit(1)
end if
end select end select
end do end do
if (.not. all([allocated(loadcaseArg),allocated(geometryArg),allocated(materialArg)])) then if (.not. allocated(geomArg)) call IO_error(612,ext_msg='--geom')
print '(/,1x,a)', 'ERROR: Please specify geometry AND load case AND material configuration (-h for help)' if (.not. allocated(loadArg)) call IO_error(612,ext_msg='--load')
call quit(1) if (.not. allocated(materialArg)) call IO_error(612,ext_msg='--material')
end if
call setWorkingDirectory(trim(workingDirArg)) call setWorkingDirectory(trim(workingDirArg))
CLI_geomFile = getPathRelCWD(geometryArg,'geometry') CLI_geomFile = getPathRelCWD(geomArg,'geometry')
CLI_loadFile = getPathRelCWD(loadCaseArg,'load case') CLI_loadFile = getPathRelCWD(loadArg,'load case')
CLI_materialFile = getPathRelCWD(materialArg,'material configuration') 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) commandLine = getArg(-1)
@ -179,16 +207,19 @@ subroutine CLI_init()
print'(/,1x,a,/)', 'Command line call: '//trim(commandLine) print'(/,1x,a,/)', 'Command line call: '//trim(commandLine)
print'(1x,a)', 'Working directory: '//IO_glueDiffering(getCWD(),workingDirArg) print'(1x,a)', 'Working directory: '//IO_glueDiffering(getCWD(),workingDirArg)
print '(1x,a)', 'Geometry: '//IO_glueDiffering(CLI_geomFile,geometryArg) print'(1x,a)', 'Geometry: '//IO_glueDiffering(CLI_geomFile,geomArg)
print '(1x,a)', 'Load case: '//IO_glueDiffering(CLI_loadFile,loadCaseArg) print'(1x,a)', 'Load case: '//IO_glueDiffering(CLI_loadFile,loadArg)
print'(1x,a)', 'Material config: '//IO_glueDiffering(CLI_materialFile,materialArg) print'(1x,a)', 'Material config: '//IO_glueDiffering(CLI_materialFile,materialArg)
print '(1x,a)', 'Solver job name: '//getSolverJobName() if (allocated(numericsArg)) &
print'(1x,a)', 'Numerics config: '//IO_glueDiffering(CLI_numericsFile,numericsArg)
print'(1x,a)', 'Solver job name: '//getSolverJobname()
if (CLI_restartInc > 0) & 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 end subroutine CLI_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Get argument from command line. !> @brief Get argument from command line.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -228,9 +259,6 @@ subroutine setWorkingDirectory(workingDirectoryArg)
character(len=*), intent(in) :: workingDirectoryArg !< working directory argument character(len=*), intent(in) :: workingDirectoryArg !< working directory argument
character(len=:), allocatable :: workingDirectory character(len=:), allocatable :: workingDirectory
logical :: error
external :: quit
absolutePath: if (workingDirectoryArg(1:1) == '/') then absolutePath: if (workingDirectoryArg(1:1) == '/') then
workingDirectory = workingDirectoryArg workingDirectory = workingDirectoryArg
@ -240,36 +268,50 @@ subroutine setWorkingDirectory(workingDirectoryArg)
end if absolutePath end if absolutePath
workingDirectory = trim(normpath(workingDirectory)) workingDirectory = trim(normpath(workingDirectory))
error = setCWD(trim(workingDirectory)) if (setCWD(trim(workingDirectory))) call IO_error(640,ext_msg=workingDirectory)
if (error) then
print '(1x,a)', 'ERROR: Invalid Working directory: '//trim(workingDirectory)
call quit(1)
end if
end subroutine setWorkingDirectory 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 character(len=:), allocatable :: getSolverJobname
integer :: posExt,posSep
posExt = scan(CLI_geomFile,'.',back=.true.) getSolverJobname = solverJobname
posSep = scan(CLI_geomFile,'/',back=.true.)
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 character(len=*), intent(in) :: fileType
logical :: file_exists logical :: file_exists
external :: quit
getPathRelCWD = trim(path) getPathRelCWD = trim(path)
@ -290,10 +331,7 @@ function getPathRelCWD(path,fileType)
getPathRelCWD = trim(relpath(getPathRelCWD,getCWD())) getPathRelCWD = trim(relpath(getPathRelCWD,getCWD()))
inquire(file=getPathRelCWD, exist=file_exists) inquire(file=getPathRelCWD, exist=file_exists)
if (.not. file_exists) then if (.not. file_exists) call IO_error(100,ext_msg=fileType//' "'//trim(getPathRelCWD)//'"')
print '(1x,a)', 'ERROR: '//fileType//' file does not exist: '//trim(getPathRelCWD)
call quit(1)
end if
end function getPathRelCWD end function getPathRelCWD
@ -376,4 +414,5 @@ function relpath(path,start)
end function relpath end function relpath
end module CLI 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) file(GLOB damask-sources CONFIGURE_DEPENDS *.f90 *.c)
if(PROJECT_NAME STREQUAL "damask-grid") if(PROJECT_NAME STREQUAL "damask-grid")
@ -18,14 +11,6 @@ elseif(PROJECT_NAME STREQUAL "damask-test")
file(GLOB solver-sources CONFIGURE_DEPENDS test/*.f90) file(GLOB solver-sources CONFIGURE_DEPENDS test/*.f90)
endif() 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") if(NOT CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
add_executable(${executable-name} ${damask-sources} ${solver-sources}) 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 !> @author Philip Eisenlohr, Michigan State University
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module HDF5_utilities module HDF5_utilities
use IO
use HDF5 use HDF5
#ifdef PETSC #ifdef PETSC
#include <petsc/finclude/petscsys.h> #include <petsc/finclude/petscsys.h>
@ -190,6 +191,7 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
character :: m character :: m
integer(HID_T) :: plist_id integer(HID_T) :: plist_id
integer :: hdferr integer :: hdferr
logical :: exist
m = misc_optional(mode,'r') 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 H5Fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
elseif (m == 'r') then 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 H5Fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
else 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 integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in) :: parallel logical, intent(in) :: parallel
integer(HSIZE_T), intent(in), dimension(:) :: & integer(HSIZE_T), intent(in), dimension(:) :: localShape
localShape integer(HSIZE_T), intent(out), dimension(size(localShape)) :: &
integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: &
myStart, & myStart, &
globalShape !< shape of the dataset (all processes) globalShape !< shape of the dataset (all processes)
integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(MPI_INTEGER_KIND), dimension(worldsize) :: & integer(MPI_INTEGER_KIND), dimension(worldsize) :: readSize !< contribution of all processes
readSize !< contribution of all processes
integer :: hdferr integer :: hdferr
integer(MPI_INTEGER_KIND) :: err_MPI 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 if (parallel) then
call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
call HDF5_chkerr(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' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
end if end if
#endif #endif
@ -1930,15 +1933,14 @@ end subroutine finalize_read
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, & 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 integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in) :: parallel logical, intent(in) :: parallel
integer(HID_T), intent(in) :: datatype integer(HID_T), intent(in) :: datatype
integer(HSIZE_T), intent(in), dimension(:) :: & integer(HSIZE_T), intent(in), dimension(:) :: localShape
myShape integer(HSIZE_T), intent(out), dimension(size(localShape)) :: &
integer(HSIZE_T), intent(out), dimension(size(myShape,1)):: &
myStart, & myStart, &
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id 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 ! determine the global data layout among all processes
writeSize = 0_MPI_INTEGER_KIND 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 #ifdef PETSC
if (parallel) then 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' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
end if end if
#endif #endif
myStart = int(0,HSIZE_T) myStart = int(0,HSIZE_T)
myStart(ubound(myStart)) = int(sum(writeSize(1:worldrank)),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 ! 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) ! 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 HDF5_chkerr(hdferr)
call H5Screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape) call H5Screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape)
call HDF5_chkerr(hdferr) 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) ! 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 H5Dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr, dcpl)
call HDF5_chkerr(hdferr) 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 HDF5_chkerr(hdferr)
call H5Pclose_f(dcpl , hdferr) call H5Pclose_f(dcpl , hdferr)

65
src/IO.f90
View File

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

49
src/Marc/DAMASK_Marc.f90
View File

@ -16,15 +16,24 @@
#endif #endif
#include "../prec.f90" #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 module DAMASK_interface
use prec
use, intrinsic :: ISO_fortran_env, only: & use, intrinsic :: ISO_fortran_env, only: &
compiler_version, & compiler_version, &
compiler_options compiler_options
use ifport, only: & use ifport, only: &
CHDIR CHDIR
use prec
use IO
implicit none(type,external) implicit none(type,external)
private private
@ -105,7 +114,7 @@ logical function solverIsSymmetric()
status='old', position='rewind', action='read',iostat=myStat) status='old', position='rewind', action='read',iostat=myStat)
do do
read (fileUnit,'(A)',END=100) line 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 read (fileUnit,'(A)',END=100) line ! next line
s = verify(line, ' ') ! start of first chunk s = verify(line, ' ') ! start of first chunk
s = s + verify(line(s+1:),' ') ! start of second chunk s = s + verify(line(s+1:),' ') ! start of second chunk
@ -114,40 +123,11 @@ logical function solverIsSymmetric()
end if end if
end do end do
100 close(fileUnit) 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 function solverIsSymmetric
end module DAMASK_interface 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 "../result.f90"
#include "../config.f90" #include "../config.f90"
#include "../LAPACK_interface.f90" #include "../LAPACK_interface.f90"
@ -155,7 +135,7 @@ end module DAMASK_interface
#include "../rotations.f90" #include "../rotations.f90"
#include "../polynomials.f90" #include "../polynomials.f90"
#include "../tables.f90" #include "../tables.f90"
#include "../lattice.f90" #include "../crystal.f90"
#include "element.f90" #include "element.f90"
#include "../geometry_plastic_nonlocal.f90" #include "../geometry_plastic_nonlocal.f90"
#include "../discretization.f90" #include "../discretization.f90"
@ -173,11 +153,10 @@ end module DAMASK_interface
#include "../phase_mechanical_plastic_dislotungsten.f90" #include "../phase_mechanical_plastic_dislotungsten.f90"
#include "../phase_mechanical_plastic_nonlocal.f90" #include "../phase_mechanical_plastic_nonlocal.f90"
#include "../phase_mechanical_eigen.f90" #include "../phase_mechanical_eigen.f90"
#include "../phase_mechanical_eigen_cleavageopening.f90"
#include "../phase_mechanical_eigen_thermalexpansion.f90" #include "../phase_mechanical_eigen_thermalexpansion.f90"
#include "../phase_thermal.f90" #include "../phase_thermal.f90"
#include "../phase_thermal_dissipation.f90" #include "../phase_thermal_source_dissipation.f90"
#include "../phase_thermal_externalheat.f90" #include "../phase_thermal_source_externalheat.f90"
#include "../phase_damage.f90" #include "../phase_damage.f90"
#include "../phase_damage_isobrittle.f90" #include "../phase_damage_isobrittle.f90"
#include "../phase_damage_anisobrittle.f90" #include "../phase_damage_anisobrittle.f90"

10
src/Marc/discretization_Marc.f90
View File

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

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 rotations
use polynomials use polynomials
use tables use tables
use lattice use crystal
use material use material
use phase use phase
use homogenization use homogenization
@ -75,7 +75,7 @@ subroutine materialpoint_initAll()
call rotations_init() call rotations_init()
call polynomials_init() call polynomials_init()
call tables_init() call tables_init()
call lattice_init() call crystal_init()
call discretization_Marc_init() call discretization_Marc_init()
call material_init(.false.) call material_init(.false.)
call phase_init() call phase_init()

2
src/YAML_parse.f90
View File

@ -162,7 +162,7 @@ end function parse_flow
!> @brief Find location of chunk end: ',' '}', or ']'. !> @brief Find location of chunk end: ',' '}', or ']'.
!> @details leaves nested lists ( '[...]' and dicts '{...}') intact !> @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(len=*), intent(in) :: str !< chunk of YAML flow string
character, intent(in) :: e_char !< end of list/dict ( '}' or ']') character, intent(in) :: e_char !< end of list/dict ( '}' or ']')

10
src/YAML_types.f90
View File

@ -1166,7 +1166,10 @@ function tDict_get_as1dReal(self,k,defaultVal,requiredSize) result(nodeAs1dReal)
end if end if
if (present(requiredSize)) then 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 if
end function tDict_get_as1dReal end function tDict_get_as1dReal
@ -1251,7 +1254,10 @@ function tDict_get_as1dInt(self,k,defaultVal,requiredSize) result(nodeAs1dInt)
end if end if
if (present(requiredSize)) then 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 if
end function tDict_get_as1dInt end function tDict_get_as1dInt

78
src/config.f90
View File

@ -34,8 +34,23 @@ subroutine config_init()
print'(/,1x,a)', '<<<+- config init -+>>>'; flush(IO_STDOUT) print'(/,1x,a)', '<<<+- config init -+>>>'; flush(IO_STDOUT)
call parse_material() #if defined(MESH) || defined(GRID)
call parse_numerics() 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 end subroutine config_init
@ -68,11 +83,10 @@ end subroutine config_numerics_deallocate
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function config_listReferences(config,indent) result(references) function config_listReferences(config,indent) result(references)
type(tDict) :: config type(tDict), intent(in) :: config
integer, optional :: indent integer, intent(in), optional :: indent
character(len=:), allocatable :: references character(len=:), allocatable :: references
type(tList), pointer :: ref type(tList), pointer :: ref
character(len=:), allocatable :: filler character(len=:), allocatable :: filler
integer :: r 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)
logical :: fileExists character(len=*), intent(in) :: fname, description
character(len=:), allocatable :: & type(tDict), pointer :: parse
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
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_closeJobFile()
end if
call parallelization_bcast_str(fileContent)
config_material => YAML_parse_str_asDict(fileContent)
end subroutine parse_material
!--------------------------------------------------------------------------------------------------
!> @brief Read numerics.yaml.
!--------------------------------------------------------------------------------------------------
subroutine parse_numerics()
logical :: fileExists
character(len=:), allocatable :: fileContent character(len=:), allocatable :: fileContent
config_numerics => emptyDict
inquire(file='numerics.yaml', exist=fileExists)
if (fileExists) then
if (worldrank == 0) then if (worldrank == 0) then
print'(1x,a)', 'reading numerics.yaml'; flush(IO_STDOUT) print'(/,1x,a)', 'reading '//description; flush(IO_STDOUT)
fileContent = IO_read('numerics.yaml') fileContent = IO_read(fname)
if (len(fileContent) > 0) then
call result_openJobFile(parallel=.false.) call result_openJobFile(parallel=.false.)
call result_writeDataset_str(fileContent,'setup','numerics.yaml','numerics configuration') call result_addSetupFile(fileContent,fname,description)
call result_closeJobFile() call result_closeJobFile()
end if end if
end if
call parallelization_bcast_str(fileContent) call parallelization_bcast_str(fileContent)
config_numerics => YAML_parse_str_asDict(fileContent) parse => YAML_parse_str_asDict(fileContent)
end if end function parse
end subroutine parse_numerics
end module config 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) 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) 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 end module constants

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

@ -3,10 +3,10 @@
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Pratheek Shanthraj, 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 !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief contains lattice definitions including Schmid matrices for slip, twin, trans, !> @brief Contains crystal definitions including Schmid matrices for slip, twin, trans,
! and cleavage as well as interaction among the various systems ! and cleavage as well as interaction among the various systems.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module lattice module crystal
use prec use prec
use misc use misc
use IO use IO
@ -80,7 +80,7 @@ module lattice
],pREAL),shape(CF_SYSTEMTWIN)) !< cF twin systems ],pREAL),shape(CF_SYSTEMTWIN)) !< cF twin systems
integer, dimension(2,CF_NTWIN), parameter, public :: & integer, dimension(2,CF_NTWIN), parameter, public :: &
lattice_CF_TWINNUCLEATIONSLIPPAIR = reshape( [& crystal_CF_TWINNUCLEATIONSLIPPAIR = reshape( [&
2,3, & 2,3, &
1,3, & 1,3, &
1,2, & 1,2, &
@ -93,7 +93,7 @@ module lattice
11,12, & 11,12, &
10,12, & 10,12, &
10,11 & 10,11 &
],shape(lattice_CF_TWINNUCLEATIONSLIPPAIR)) ],shape(crystal_CF_TWINNUCLEATIONSLIPPAIR))
real(pREAL), dimension(3+3,CF_NCLEAVAGE), parameter :: & real(pREAL), dimension(3+3,CF_NCLEAVAGE), parameter :: &
CF_SYSTEMCLEAVAGE = reshape(real([& CF_SYSTEMCLEAVAGE = reshape(real([&
@ -123,18 +123,21 @@ module lattice
real(pREAL), dimension(3+3,CI_NSLIP), parameter :: & real(pREAL), dimension(3+3,CI_NSLIP), parameter :: &
CI_SYSTEMSLIP = reshape(real([& CI_SYSTEMSLIP = reshape(real([&
! <111>{110} systems ! <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, 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, 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, & -1,-1, 1, -1, 1, 0, &
! <111>{112} systems ! <111>{112} systems
-1, 1, 1, 2, 1, 1, & -1, 1, 1, 2, 1, 1, &
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) ],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 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 module procedure slipProjection_direction
end interface lattice_forestProjection_screw end interface crystal_forestProjection_screw
public :: & public :: &
lattice_init, & crystal_init, &
lattice_isotropic_nu, & crystal_selfTest, &
lattice_isotropic_mu, & crystal_isotropic_nu, &
lattice_symmetrize_33, & crystal_isotropic_mu, &
lattice_symmetrize_C66, & crystal_symmetrize_33, &
lattice_SchmidMatrix_slip, & crystal_symmetrize_C66, &
lattice_SchmidMatrix_twin, & crystal_SchmidMatrix_slip, &
lattice_SchmidMatrix_trans, & crystal_SchmidMatrix_twin, &
lattice_SchmidMatrix_cleavage, & crystal_SchmidMatrix_trans, &
lattice_nonSchmidMatrix, & crystal_SchmidMatrix_cleavage, &
lattice_interaction_SlipBySlip, & crystal_interaction_SlipBySlip, &
lattice_interaction_TwinByTwin, & crystal_interaction_TwinByTwin, &
lattice_interaction_TransByTrans, & crystal_interaction_TransByTrans, &
lattice_interaction_SlipByTwin, & crystal_interaction_SlipByTwin, &
lattice_interaction_SlipByTrans, & crystal_interaction_SlipByTrans, &
lattice_interaction_TwinBySlip, & crystal_interaction_TwinBySlip, &
lattice_characteristicShear_Twin, & crystal_characteristicShear_Twin, &
lattice_C66_twin, & crystal_C66_twin, &
lattice_C66_trans, & crystal_C66_trans, &
lattice_forestProjection_edge, & crystal_forestProjection_edge, &
lattice_forestProjection_screw, & crystal_forestProjection_screw, &
lattice_slip_normal, & crystal_slip_normal, &
lattice_slip_direction, & crystal_slip_direction, &
lattice_slip_transverse, & crystal_slip_transverse, &
lattice_labels_slip, & crystal_labels_slip, &
lattice_labels_twin crystal_labels_twin
contains contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Run self test. !> @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 !> @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 integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol) 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) characteristicShear(a) = 0.5_pREAL*sqrt(2.0_pREAL)
case('hP') case('hP')
if (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL) & 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 p = sum(HP_NTWINSYSTEM(1:f-1))+s
select case(HP_SHEARTWIN(p)) ! from Christian & Mahajan 1995 p.29 select case(HP_SHEARTWIN(p)) ! from Christian & Mahajan 1995 p.29
case (1) ! <-10.1>{10.2} 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 characteristicShear(a) = 2.0_pREAL*(cOverA**2-2.0_pREAL)/3.0_pREAL/cOverA
end select end select
case default 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 select
end do mySystems end do mySystems
end do myFamilies end do myFamilies
end function lattice_characteristicShear_Twin end function crystal_characteristicShear_Twin
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Rotated elasticity matrices for twinning in 6x6-matrix notation !> @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 integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol) character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
real(pREAL), dimension(6,6), intent(in) :: C66 !< unrotated parent stiffness matrix real(pREAL), dimension(6,6), intent(in) :: C66 !< unrotated parent stiffness matrix
real(pREAL), intent(in) :: cOverA !< c/a ratio 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 real(pREAL), dimension(3,3,sum(Ntwin)):: coordinateSystem
type(tRotation) :: R type(tRotation) :: R
@ -518,28 +521,28 @@ function lattice_C66_twin(Ntwin,C66,lattice,CoverA)
coordinateSystem = buildCoordinateSystem(Ntwin,HP_NSLIPSYSTEM,HP_SYSTEMTWIN,& coordinateSystem = buildCoordinateSystem(Ntwin,HP_NSLIPSYSTEM,HP_SYSTEMTWIN,&
lattice,cOverA) lattice,cOverA)
case default 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 end select
do i = 1, sum(Ntwin) do i = 1, sum(Ntwin)
call R%fromAxisAngle([coordinateSystem(1:3,2,i),PI],P=1) ! ToDo: Why always 180 deg? 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 do
end function lattice_C66_twin end function crystal_C66_twin
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Rotated elasticity matrices for transformation in 6x6-matrix notation !> @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) cOverA_trans,a_cF,a_cI)
integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family 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), dimension(6,6), intent(in) :: C_parent66
real(pREAL), optional, intent(in) :: cOverA_trans, a_cF, a_cI 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(6,6) :: C_bar66, C_target_unrotated66
real(pREAL), dimension(3,3,sum(Ntrans)) :: Q,S 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 ! 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.1063/1.1663858 eq. (16), eq. (18), eq. (19)
! https://doi.org/10.1016/j.actamat.2016.07.032 eq. (47), eq. (48) ! 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) & 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,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(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 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(1,3) = C_bar66(1,3)
C_target_unrotated66(3,3) = C_bar66(3,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(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') C_target_unrotated66 = crystal_symmetrize_C66(C_target_unrotated66,'hP')
elseif (lattice_target == 'cI' .and. present(a_cF) .and. present(a_cI)) then 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) & 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 C_target_unrotated66 = C_parent66
else 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 end if
do i = 1,6 do i = 1,6
@ -584,58 +587,10 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
do i = 1,sum(Ntrans) do i = 1,sum(Ntrans)
call R%fromMatrix(Q(1:3,1:3,i)) 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 do
end function lattice_C66_trans end function crystal_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
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -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.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) !> @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 integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
real(pREAL), dimension(:), intent(in) :: interactionValues !< values for slip-slip interaction 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 interactionTypes = TI_INTERACTIONSLIPSLIP
NslipMax = TI_NSLIPSYSTEM NslipMax = TI_NSLIPSYSTEM
case default 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 end select
interactionMatrix = buildInteraction(Nslip,Nslip,NslipMax,NslipMax,interactionValues,interactionTypes) interactionMatrix = buildInteraction(Nslip,Nslip,NslipMax,NslipMax,interactionValues,interactionTypes)
end function lattice_interaction_SlipBySlip end function crystal_interaction_SlipBySlip
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Twin-twin interaction matrix !> @brief Twin-twin interaction matrix
!> details only active twin systems are considered !> 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 integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
real(pREAL), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction 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 interactionTypes = HP_INTERACTIONTWINTWIN
NtwinMax = HP_NTWINSYSTEM NtwinMax = HP_NTWINSYSTEM
case default 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 end select
interactionMatrix = buildInteraction(Ntwin,Ntwin,NtwinMax,NtwinMax,interactionValues,interactionTypes) interactionMatrix = buildInteraction(Ntwin,Ntwin,NtwinMax,NtwinMax,interactionValues,interactionTypes)
end function lattice_interaction_TwinByTwin end function crystal_interaction_TwinByTwin
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Trans-trans interaction matrix !> @brief Trans-trans interaction matrix
!> details only active trans systems are considered !> 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 integer, dimension(:), intent(in) :: Ntrans !< number of active trans systems per family
real(pREAL), dimension(:), intent(in) :: interactionValues !< values for trans-trans interaction 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 interactionTypes = CF_INTERACTIONTRANSTRANS
NtransMax = CF_NTRANSSYSTEM NtransMax = CF_NTRANSSYSTEM
else 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 end if
interactionMatrix = buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTypes) interactionMatrix = buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTypes)
end function lattice_interaction_TransByTrans end function crystal_interaction_TransByTrans
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Slip-twin interaction matrix !> @brief Slip-twin interaction matrix
!> details only active slip and twin systems are considered !> 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 integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family
Ntwin !< number of active twin 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 NslipMax = HP_NSLIPSYSTEM
NtwinMax = HP_NTWINSYSTEM NtwinMax = HP_NTWINSYSTEM
case default 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 end select
interactionMatrix = buildInteraction(Nslip,Ntwin,NslipMax,NtwinMax,interactionValues,interactionTypes) interactionMatrix = buildInteraction(Nslip,Ntwin,NslipMax,NtwinMax,interactionValues,interactionTypes)
end function lattice_interaction_SlipByTwin end function crystal_interaction_SlipByTwin
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Slip-trans interaction matrix !> @brief Slip-trans interaction matrix
!> details only active slip and trans systems are considered !> 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 integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family
Ntrans !< number of active trans 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 NslipMax = CF_NSLIPSYSTEM
NtransMax = CF_NTRANSSYSTEM NtransMax = CF_NTRANSSYSTEM
case default 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 end select
interactionMatrix = buildInteraction(Nslip,Ntrans,NslipMax,NtransMax,interactionValues,interactionTypes) interactionMatrix = buildInteraction(Nslip,Ntrans,NslipMax,NtransMax,interactionValues,interactionTypes)
end function lattice_interaction_SlipByTrans end function crystal_interaction_SlipByTrans
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Twin-slip interaction matrix !> @brief Twin-slip interaction matrix
!> details only active twin and slip systems are considered !> 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 integer, dimension(:), intent(in) :: Ntwin, & !< number of active twin systems per family
Nslip !< number of active slip 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 NtwinMax = HP_NTWINSYSTEM
NslipMax = HP_NSLIPSYSTEM NslipMax = HP_NSLIPSYSTEM
case default 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 end select
interactionMatrix = buildInteraction(Ntwin,Nslip,NtwinMax,NslipMax,interactionValues,interactionTypes) interactionMatrix = buildInteraction(Ntwin,Nslip,NtwinMax,NslipMax,interactionValues,interactionTypes)
end function lattice_interaction_TwinBySlip end function crystal_interaction_TwinBySlip
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Schmid matrix for slip !> @brief Schmid matrix for slip
!> details only active slip systems are considered !> 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 integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol) character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
real(pREAL), intent(in) :: cOverA 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)) :: SchmidMatrix
real(pREAL), dimension(3,3,sum(Nslip)) :: coordinateSystem real(pREAL), dimension(3,3,sum(Nslip)) :: coordinateSystem
real(pREAL), dimension(:,:), allocatable :: slipSystems real(pREAL), dimension(:,:), allocatable :: slipSystems
integer, dimension(:), allocatable :: NslipMax 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 integer :: i
select case(lattice) select case(lattice)
@ -1419,7 +1383,7 @@ function lattice_SchmidMatrix_slip(Nslip,lattice,cOverA) result(SchmidMatrix)
slipSystems = TI_SYSTEMSLIP slipSystems = TI_SYSTEMSLIP
case default case default
allocate(NslipMax(0)) 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 end select
if (any(NslipMax(1:size(Nslip)) - Nslip < 0)) & if (any(NslipMax(1:size(Nslip)) - Nslip < 0)) &
@ -1427,22 +1391,51 @@ function lattice_SchmidMatrix_slip(Nslip,lattice,cOverA) result(SchmidMatrix)
if (any(Nslip < 0)) & if (any(Nslip < 0)) &
call IO_error(144,ext_msg='Nslip '//trim(lattice)) 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) 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) do i = 1,sum(Nslip)
SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) 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) & if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) &
error stop 'dilatational Schmid matrix for slip' 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 do
end function lattice_SchmidMatrix_slip end function crystal_SchmidMatrix_slip
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Schmid matrix for twinning !> @brief Schmid matrix for twinning
!> details only active twin systems are considered !> 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 integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol) character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
@ -1466,7 +1459,7 @@ function lattice_SchmidMatrix_twin(Ntwin,lattice,cOverA) result(SchmidMatrix)
twinSystems = HP_SYSTEMTWIN twinSystems = HP_SYSTEMTWIN
case default case default
allocate(NtwinMax(0)) 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 end select
if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0)) & if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0)) &
@ -1482,43 +1475,43 @@ function lattice_SchmidMatrix_twin(Ntwin,lattice,cOverA) result(SchmidMatrix)
error stop 'dilatational Schmid matrix for twin' error stop 'dilatational Schmid matrix for twin'
end do end do
end function lattice_SchmidMatrix_twin end function crystal_SchmidMatrix_twin
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Schmid matrix for transformation !> @brief Schmid matrix for transformation
!> details only active twin systems are considered !> 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 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), optional, intent(in) :: cOverA, a_cI, a_cF
real(pREAL), dimension(3,3,sum(Ntrans)) :: SchmidMatrix real(pREAL), dimension(3,3,sum(Ntrans)) :: SchmidMatrix
real(pREAL), dimension(3,3,sum(Ntrans)) :: devNull 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) & 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) 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) & 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) call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,a_cF=a_cF,a_cI=a_cI)
else 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 if
end function lattice_SchmidMatrix_trans end function crystal_SchmidMatrix_trans
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Schmid matrix for cleavage !> @brief Schmid matrix for cleavage
!> details only active cleavage systems are considered !> 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 integer, dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol) character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
@ -1539,7 +1532,7 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,lattice,cOverA) result(SchmidMa
cleavageSystems = CI_SYSTEMCLEAVAGE cleavageSystems = CI_SYSTEMCLEAVAGE
case default case default
allocate(NcleavageMax(0)) 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 end select
if (any(NcleavageMax(1:size(Ncleavage)) - Ncleavage < 0)) & 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)) SchmidMatrix(1:3,1:3,3,i) = math_outer(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i))
end do end do
end function lattice_SchmidMatrix_cleavage end function crystal_SchmidMatrix_cleavage
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Slip direction of slip systems (|| b) !> @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 integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol) 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) coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
d = coordinateSystem(1:3,1,1:sum(Nslip)) 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) !> @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 integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol) 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) coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
n = coordinateSystem(1:3,2,1:sum(Nslip)) 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) !> @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 integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol) 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) coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
t = coordinateSystem(1:3,3,1:sum(Nslip)) t = coordinateSystem(1:3,3,1:sum(Nslip))
end function lattice_slip_transverse end function crystal_slip_transverse
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Labels of slip systems !> @brief Labels of slip systems
!> details only active slip systems are considered !> 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 integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol) character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
@ -1640,7 +1633,7 @@ function lattice_labels_slip(Nslip,lattice) result(labels)
NslipMax = TI_NSLIPSYSTEM NslipMax = TI_NSLIPSYSTEM
slipSystems = TI_SYSTEMSLIP slipSystems = TI_SYSTEMSLIP
case default 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 end select
if (any(NslipMax(1:size(Nslip)) - Nslip < 0)) & 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) 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 !> @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 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) T_sym(3,3) = T(3,3)
end select 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 !> @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 !> @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 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 do end do
end function lattice_symmetrize_C66 end function crystal_symmetrize_C66
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Labels for twin systems !> @brief Labels for twin systems
!> details only active twin systems are considered !> 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 integer, dimension(:), intent(in) :: Ntwin !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol) character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
@ -1751,7 +1744,7 @@ function lattice_labels_twin(Ntwin,lattice) result(labels)
NtwinMax = HP_NTWINSYSTEM NtwinMax = HP_NTWINSYSTEM
twinSystems = HP_SYSTEMTWIN twinSystems = HP_SYSTEMTWIN
case default 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 end select
if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0)) & 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) 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 real(pREAL), dimension(3,sum(Nslip)) :: n, t
integer :: i, j integer :: i, j
n = lattice_slip_normal (Nslip,lattice,cOverA) n = crystal_slip_normal (Nslip,lattice,cOverA)
t = lattice_slip_transverse(Nslip,lattice,cOverA) t = crystal_slip_transverse(Nslip,lattice,cOverA)
do i=1, sum(Nslip); do j=1, sum(Nslip) do i=1, sum(Nslip); do j=1, sum(Nslip)
projection(i,j) = abs(math_inner(n(:,i),t(:,j))) 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 real(pREAL), dimension(3,sum(Nslip)) :: n, d
integer :: i, j integer :: i, j
n = lattice_slip_normal (Nslip,lattice,cOverA) n = crystal_slip_normal (Nslip,lattice,cOverA)
d = lattice_slip_direction(Nslip,lattice,cOverA) d = crystal_slip_direction(Nslip,lattice,cOverA)
do i=1, sum(Nslip); do j=1, sum(Nslip) do i=1, sum(Nslip); do j=1, sum(Nslip)
projection(i,j) = abs(math_inner(n(:,i),d(:,j))) projection(i,j) = abs(math_inner(n(:,i),d(:,j)))
@ -1901,7 +1894,7 @@ end function buildInteraction
!> @brief Build a local coordinate system on slip, twin, trans, cleavage systems !> @brief Build a local coordinate system on slip, twin, trans, cleavage systems
!> @details Order: Direction, plane (normal), and common perpendicular !> @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 active, & !< # of active systems per family
@ -1913,7 +1906,7 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
real(pREAL), intent(in) :: & real(pREAL), intent(in) :: &
cOverA cOverA
real(pREAL), dimension(3,3,sum(active)) :: & real(pREAL), dimension(3,3,sum(active)) :: &
buildCoordinateSystem coordinateSystem
real(pREAL), dimension(3) :: & real(pREAL), dimension(3) :: &
direction, normal direction, normal
@ -1936,10 +1929,14 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
select case(lattice) select case(lattice)
case ('cF','cI','tI') case ('cF','cI')
direction = system(1:3,p) direction = system(1:3,p)
normal = system(4:6,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') case ('hP')
direction = [ system(1,p)*1.5_pREAL, & direction = [ system(1,p)*1.5_pREAL, &
(system(1,p)+2.0_pREAL*system(2,p))*sqrt(0.75_pREAL), & (system(1,p)+2.0_pREAL*system(2,p))*sqrt(0.75_pREAL), &
@ -1953,9 +1950,9 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
end select end select
buildCoordinateSystem(1:3,1,a) = direction/norm2(direction) coordinateSystem(1:3,1,a) = direction/norm2(direction)
buildCoordinateSystem(1:3,2,a) = normal /norm2(normal) coordinateSystem(1:3,2,a) = normal /norm2(normal)
buildCoordinateSystem(1:3,3,a) = math_cross(direction/norm2(direction),& coordinateSystem(1:3,3,a) = math_cross(direction/norm2(direction),&
normal /norm2(normal)) normal /norm2(normal))
end do activeSystems end do activeSystems
@ -2150,7 +2147,7 @@ end function getlabels
!> @brief Equivalent Poisson's ratio (ν) !> @brief Equivalent Poisson's ratio (ν)
!> @details https://doi.org/10.1143/JPSJ.20.635 !> @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) real(pREAL), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
character(len=*), intent(in) :: assumption !< Assumption (isostrain = 'Voigt', isostress = 'Reuss') 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' error stop 'invalid assumption'
end if 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) 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 https://doi.org/10.1143/JPSJ.20.635
!> @details Nonlinear Mechanics of Crystals 10.1007/978-94-007-0350-6, pp 563 !> @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) real(pREAL), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
character(len=*), intent(in) :: assumption !< Assumption (isostrain = 'Voigt', isostress = 'Reuss') 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' error stop 'invalid assumption'
end if 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 :: CoSy
real(pREAL), dimension(:,:), allocatable :: system real(pREAL), dimension(:,:), allocatable :: system
@ -2244,12 +2241,18 @@ subroutine selfTest
CoSy = buildCoordinateSystem([1],[1],system,'cF',0.0_pREAL) 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(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 do i = 1, 10
call random_number(C) call random_number(C)
C_cF = lattice_symmetrize_C66(C,'cI') C_cF = crystal_symmetrize_C66(C,'cI')
C_cI = lattice_symmetrize_C66(C,'cF') C_cI = crystal_symmetrize_C66(C,'cF')
C_hP = lattice_symmetrize_C66(C,'hP') C_hP = crystal_symmetrize_C66(C,'hP')
C_tI = lattice_symmetrize_C66(C,'tI') C_tI = crystal_symmetrize_C66(C,'tI')
if (any(dNeq(C_cI,transpose(C_cF)))) error stop 'SymmetryC66/cI-cF' 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' 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' if (any(dNeq(C(4,4),[C_tI(4,4),C_tI(5,5)]))) error stop 'SymmetryC_44-55/tI'
call random_number(T) call random_number(T)
T_cF = lattice_symmetrize_33(T,'cI') T_cF = crystal_symmetrize_33(T,'cI')
T_cI = lattice_symmetrize_33(T,'cF') T_cI = crystal_symmetrize_33(T,'cF')
T_hP = lattice_symmetrize_33(T,'hP') T_hP = crystal_symmetrize_33(T,'hP')
T_tI = lattice_symmetrize_33(T,'tI') 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_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' 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(4,4) = 0.5_pREAL * (C(1,1) - C(1,2))
C(6,6) = C(4,4) C(6,6) = C(4,4)
C_cI = lattice_symmetrize_C66(C,'cI') C_cI = crystal_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),crystal_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' 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) lambda = C_cI(1,2)
if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_cI,'isostrain','cI')), & if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_cI,'isostrain','cI')), &
lattice_isotropic_nu(C_cI,'isostrain','cI'),1.0e-12_pREAL)) error stop 'isotropic_nu/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+lattice_isotropic_mu(C_cI,'isostress','cI')), & if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_cI,'isostress','cI')), &
lattice_isotropic_nu(C_cI,'isostress','cI'),1.0e-12_pREAL)) error stop 'isotropic_nu/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') C_hP = crystal_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),crystal_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' 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) lambda = C_hP(1,2)
if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_hP,'isostrain','hP')), & if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_hP,'isostrain','hP')), &
lattice_isotropic_nu(C_hP,'isostrain','hP'),1.0e-12_pREAL)) error stop 'isotropic_nu/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+lattice_isotropic_mu(C_hP,'isostress','hP')), & if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_hP,'isostress','hP')), &
lattice_isotropic_nu(C_hP,'isostress','hP'),1.0e-12_pREAL)) error stop 'isotropic_nu/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') C_tI = crystal_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),crystal_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' 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) lambda = C_tI(1,2)
if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_tI,'isostrain','tI')), & if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_tI,'isostrain','tI')), &
lattice_isotropic_nu(C_tI,'isostrain','tI'),1.0e-12_pREAL)) error stop 'isotropic_nu/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+lattice_isotropic_mu(C_tI,'isostress','tI')), & if (dNeq(lambda*0.5_pREAL/(lambda+crystal_isotropic_mu(C_tI,'isostress','tI')), &
lattice_isotropic_nu(C_tI,'isostress','tI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/tI' crystal_isotropic_nu(C_tI,'isostress','tI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/tI'
call random_number(C) call random_number(C)
C = lattice_symmetrize_C66(C+math_eye(6),'cI') C = crystal_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)) & 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' 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' 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' 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' 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 material
use spectral_utilities use spectral_utilities
use grid_mechanical_spectral_basic use grid_mechanical_spectral_basic
use grid_mechanical_spectral_polarisation use grid_mechanical_spectral_polarization
use grid_mechanical_FEM use grid_mechanical_FEM
use grid_damage_spectral use grid_damage_spectral
use grid_thermal_spectral use grid_thermal_spectral
@ -75,7 +75,7 @@ program DAMASK_grid
cutBack = .false.,& cutBack = .false.,&
sig sig
integer :: & integer :: &
i, j, m, field, & i, j, field, &
errorID = 0, & errorID = 0, &
cutBackLevel = 0, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ cutBackLevel = 0, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
stepFraction = 0, & !< fraction of current time interval stepFraction = 0, & !< fraction of current time interval
@ -107,21 +107,14 @@ program DAMASK_grid
external :: & external :: &
quit quit
type(tDict), pointer :: & type(tDict), pointer :: &
config_load, & load, &
num_solver, &
num_grid, & num_grid, &
load_step, & solver
solver, &
step_bc, &
step_mech, &
step_discretization
type(tList), pointer :: &
#ifdef __INTEL_LLVM_COMPILER
tensor, &
#endif
load_steps
character(len=:), allocatable :: & character(len=:), allocatable :: &
fileContent, fname fileContent, fname
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! init DAMASK (all modules) ! init DAMASK (all modules)
@ -134,25 +127,29 @@ program DAMASK_grid
!------------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------------
! read (and check) field parameters from numerics file ! 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') num_solver => config_numerics%get_dict('solver',defaultVal=emptyDict)
if (maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack') 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 if (worldrank == 0) then
fileContent = IO_read(CLI_loadFile) fileContent = IO_read(CLI_loadFile)
fname = CLI_loadFile fname = CLI_loadFile
if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:) if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:)
call result_openJobFile(parallel=.false.) 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() call result_closeJobFile()
end if end if
call parallelization_bcast_str(fileContent) call parallelization_bcast_str(fileContent)
config_load => YAML_parse_str_asDict(fileContent) load => YAML_parse_str_asDict(fileContent)
solver => config_load%get_dict('solver') solver => load%get_dict('solver')
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! assign mechanics solver depending on selected type ! assign mechanics solver depending on selected type
@ -167,11 +164,11 @@ program DAMASK_grid
mechanical_restartWrite => grid_mechanical_spectral_basic_restartWrite mechanical_restartWrite => grid_mechanical_spectral_basic_restartWrite
case ('spectral_polarization') case ('spectral_polarization')
mechanical_init => grid_mechanical_spectral_polarisation_init mechanical_init => grid_mechanical_spectral_polarization_init
mechanical_forward => grid_mechanical_spectral_polarisation_forward mechanical_forward => grid_mechanical_spectral_polarization_forward
mechanical_solution => grid_mechanical_spectral_polarisation_solution mechanical_solution => grid_mechanical_spectral_polarization_solution
mechanical_updateCoords => grid_mechanical_spectral_polarisation_updateCoords mechanical_updateCoords => grid_mechanical_spectral_polarization_updateCoords
mechanical_restartWrite => grid_mechanical_spectral_polarisation_restartWrite mechanical_restartWrite => grid_mechanical_spectral_polarization_restartWrite
case ('FEM') case ('FEM')
mechanical_init => grid_mechanical_FEM_init mechanical_init => grid_mechanical_FEM_init
@ -204,13 +201,251 @@ program DAMASK_grid
ID(field) = FIELD_DAMAGE_ID ID(field) = FIELD_DAMAGE_ID
end if damageActive 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') ! write header of output file
allocate(loadCases(load_steps%length)) ! array of load cases 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 do l = 1, load_steps%length
load_step => load_steps%get_dict(l) load_step => load_steps%get_dict(l)
step_bc => load_step%get_dict('boundary_conditions') step_bc => load_step%get_dict('boundary_conditions')
step_mech => step_bc%get_dict('mechanical') step_mech => step_bc%get_dict('mechanical')
@ -310,226 +545,6 @@ program DAMASK_grid
end if reportAndCheck end if reportAndCheck
end do end do
end function parseLoadsteps
!--------------------------------------------------------------------------------------------------
! 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 program DAMASK_grid end program DAMASK_grid

14
src/grid/discretization_grid.f90
View File

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

194
src/grid/grid_damage_spectral.f90
View File

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

167
src/grid/grid_mech_FEM.f90
View File

@ -15,8 +15,9 @@ module grid_mechanical_FEM
use prec use prec
use parallelization use parallelization
use CLI
use IO use IO
use misc
use CLI
use HDF5 use HDF5
use HDF5_utilities use HDF5_utilities
use math use math
@ -52,9 +53,9 @@ module grid_mechanical_FEM
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc data ! PETSc data
DM :: mechanical_grid DM :: DM_mech
SNES :: SNES_mechanical SNES :: SNES_mech
Vec :: solution_current, solution_lastInc, solution_rate Vec :: u_PETSc, u_lastInc_PETSc, uDot_PETSc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! common pointwise data ! common pointwise data
@ -94,9 +95,11 @@ module grid_mechanical_FEM
contains 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 :: HGCoeff = 0.0e-2_pREAL
real(pREAL), parameter, dimension(4,8) :: & real(pREAL), parameter, dimension(4,8) :: &
@ -115,44 +118,44 @@ subroutine grid_mechanical_FEM_init
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
PetscScalar, pointer, dimension(:,:,:,:) :: & PetscScalar, pointer, dimension(:,:,:,:) :: &
u,u_lastInc u,u_lastInc
PetscInt, dimension(0:worldsize-1) :: localK integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: & type(tDict), pointer :: &
num_grid num_grid_mech
character(len=pSTRLEN) :: & character(len=:), allocatable :: &
extmsg = '' extmsg, &
petsc_options
print'(/,1x,a)', '<<<+- grid_mechanical_FEM init -+>>>'; flush(IO_STDOUT) print'(/,1x,a)', '<<<+- grid_mechanical_FEM init -+>>>'; flush(IO_STDOUT)
!------------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks ! 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%itmin = num_grid_mech%get_asInt('N_iter_min',defaultVal=1)
num%eps_div_rtol = num_grid%get_asReal('eps_div_rtol', defaultVal=5.0e-4_pREAL) num%itmax = num_grid_mech%get_asInt('N_iter_max',defaultVal=100)
num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL) num%eps_div_atol = num_grid_mech%get_asReal('eps_abs_div(P)',defaultVal=1.0e-4_pREAL)
num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL) num%eps_div_rtol = num_grid_mech%get_asReal('eps_rel_div(P)',defaultVal=5.0e-4_pREAL)
num%itmin = num_grid%get_asInt ('itmin',defaultVal=1) num%eps_stress_atol = num_grid_mech%get_asReal('eps_abs_P', defaultVal=1.0e3_pREAL)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250) 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' extmsg = ''
if (num%eps_div_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_rtol' if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_div(P)'
if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_atol' if (num%eps_div_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_div(P)'
if (num%eps_stress_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_rtol' if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_P'
if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax' if (num%eps_stress_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_P'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin' 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)) if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc ! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS, &
'-mechanical_snes_type newtonls -mechanical_ksp_type fgmres & petsc_options = misc_prefixOptions('-snes_type newtonls -ksp_type fgmres -ksp_max_it 25 '// &
&-mechanical_ksp_max_it 25', & num_grid_mech%get_asStr('PETSc_options',defaultVal='') ,'mechanical_')
err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc)
CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -163,59 +166,58 @@ subroutine grid_mechanical_FEM_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc ! 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) CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc) call SNESSetOptionsPrefix(SNES_mech,'mechanical_',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
localK = 0_pPetscInt call MPI_Allgather(int(cells3,MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
localK(worldrank) = int(cells3,pPetscInt) cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3d(PETSC_COMM_WORLD, & call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, & DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, &
DMDA_STENCIL_BOX, & DMDA_STENCIL_BOX, &
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
3_pPetscInt, 1_pPetscInt, & ! #dof (u, vector), ghost boundary width (domain overlap) 3_pPETSCINT, 1_pPETSCINT, & ! #dof (u, vector), ghost boundary width (domain overlap)
[int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells [int(cells(1),pPETSCINT)],[int(cells(2),pPETSCINT)],int(cells3_global,pPETSCINT), & ! local cells
mechanical_grid,err_PETSc) DM_mech,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call DMsetFromOptions(mechanical_grid,err_PETSc) call DMsetFromOptions(DM_mech,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call DMsetUp(mechanical_grid,err_PETSc) call DMsetUp(DM_mech,err_PETSc)
CHKERRQ(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) CHKERRQ(err_PETSc)
call DMCreateGlobalVector(mechanical_grid,solution_current,err_PETSc) call DMCreateGlobalVector(DM_mech,u_PETSc,err_PETSc)
CHKERRQ(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) CHKERRQ(err_PETSc)
call DMCreateGlobalVector(mechanical_grid,solution_rate ,err_PETSc) call DMCreateGlobalVector(DM_mech,uDot_PETSc,err_PETSc)
CHKERRQ(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) 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) 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) 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) CHKERRQ(err_PETSc)
call SNESSetDM(SNES_mechanical,mechanical_grid,err_PETSc) call SNESSetDM(SNES_mech,DM_mech,err_PETSc)
CHKERRQ(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) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! init fields ! init fields
call VecSet(solution_current,0.0_pREAL,err_PETSc) call VecSet(u_PETSc,0.0_pREAL,err_PETSc)
CHKERRQ(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) CHKERRQ(err_PETSc)
call VecSet(solution_rate ,0.0_pREAL,err_PETSc) call VecSet(uDot_PETSc ,0.0_pREAL,err_PETSc)
CHKERRQ(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) 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) CHKERRQ(err_PETSc)
delta = geomSize/real(cells,pREAL) ! grid spacing 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 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 F, & ! target F
0.0_pREAL) ! time increment 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) 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) CHKERRQ(err_PETSc)
restartRead2: if (CLI_restartInc > 0) then restartRead2: if (CLI_restartInc > 0) then
@ -316,9 +318,9 @@ function grid_mechanical_FEM_solution(incInfoIn) result(solution)
! update stiffness (and gamma operator) ! update stiffness (and gamma operator)
S = utilities_maskedCompliance(params%rotation_BC,params%stress_mask,C_volAvg) 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) CHKERRQ(err_PETSc)
call SNESGetConvergedReason(SNES_mechanical,reason,err_PETSc) call SNESGetConvergedReason(SNES_mech,reason,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
solution%converged = reason > 0 solution%converged = reason > 0
@ -351,15 +353,8 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai
rotation_BC rotation_BC
PetscErrorCode :: err_PETSc 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 if (cutBack) then
C_volAvg = C_volAvgLastInc C_volAvg = C_volAvgLastInc
else else
@ -382,15 +377,15 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai
end if end if
if (guess) then 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) 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) CHKERRQ(err_PETSc)
else else
call VecSet(solution_rate,0.0_pREAL,err_PETSc) call VecSet(uDot_PETSc,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
end if end if
call VecCopy(solution_current,solution_lastInc,err_PETSc) call VecCopy(u_PETSc,u_lastInc_PETSc,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
F_lastInc = F 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 & if (stress_BC%myType=='dot_P') P_aim = P_aim &
+ merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t + merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t
call VecAXPY(solution_current,Delta_t,solution_rate,err_PETSc) call VecAXPY(u_PETSc,Delta_t,uDot_PETSc,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)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -425,7 +416,7 @@ end subroutine grid_mechanical_FEM_forward
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Update coordinates !> @brief Update coordinates
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_FEM_updateCoords subroutine grid_mechanical_FEM_updateCoords()
call utilities_updateCoords(F) 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 !> @brief Write current solver and constitutive data for restart to file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_FEM_restartWrite subroutine grid_mechanical_FEM_restartWrite()
PetscErrorCode :: err_PETSc PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
PetscScalar, dimension(:,:,:,:), pointer :: u,u_lastInc 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) 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) CHKERRQ(err_PETSc)
print'(1x,a)', 'saving solver data required for restart'; flush(IO_STDOUT) 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) call HDF5_closeFile(fileHandle)
end if end if
call DMDAVecRestoreArrayF90(mechanical_grid,solution_current,u,err_PETSc) call DMDAVecRestoreArrayReadF90(DM_mech,u_PETSc,u,err_PETSc)
CHKERRQ(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) CHKERRQ(err_PETSc)
end subroutine grid_mechanical_FEM_restartWrite end subroutine grid_mechanical_FEM_restartWrite
@ -543,9 +534,9 @@ subroutine formResidual(da_local,x_local, &
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
real(pREAL), dimension(3,3,3,3) :: devNull 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) CHKERRQ(err_PETSc)
call SNESGetIterationNumber(SNES_mechanical,PETScIter,err_PETSc) call SNESGetIterationNumber(SNES_mech,PETScIter,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
@ -566,7 +557,7 @@ subroutine formResidual(da_local,x_local, &
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! get deformation gradient ! 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) CHKERRQ(err_PETSc)
do k = cells3Offset+1, cells3Offset+cells3; do j = 1, cells(2); do i = 1, cells(1) do k = cells3Offset+1, cells3Offset+cells3; do j = 1, cells(2); do i = 1, cells(1)
ctr = 0 ctr = 0
@ -576,7 +567,7 @@ subroutine formResidual(da_local,x_local, &
end do; end do; end do 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)) 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 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) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -596,7 +587,7 @@ subroutine formResidual(da_local,x_local, &
! constructing residual ! constructing residual
call DMDAVecGetArrayF90(da_local,f_local,r,err_PETSc) call DMDAVecGetArrayF90(da_local,f_local,r,err_PETSc)
CHKERRQ(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) CHKERRQ(err_PETSc)
ele = 0 ele = 0
r = 0.0_pREAL 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) 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
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) 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 prec
use parallelization use parallelization
use CLI use CLI
use misc
use IO use IO
use HDF5 use HDF5
use HDF5_utilities use HDF5_utilities
use math use math
use rotations use rotations
use spectral_utilities use spectral_utilities
use config
use homogenization use homogenization
use discretization_grid use discretization_grid
@ -51,9 +51,9 @@ module grid_mechanical_spectral_basic
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc data ! PETSc data
DM :: da DM :: DM_mech
SNES :: SNES_mechanical SNES :: SNES_mech
Vec :: solution_vec Vec :: F_PETSc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! common pointwise data ! common pointwise data
@ -82,12 +82,6 @@ module grid_mechanical_spectral_basic
err_BC, & !< deviation from stress BC err_BC, & !< deviation from stress BC
err_div !< RMS of div of P 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 :: & integer :: &
totalIter = 0 !< total iteration in current increment totalIter = 0 !< total iteration in current increment
@ -101,22 +95,26 @@ module grid_mechanical_spectral_basic
contains 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 real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: P
PetscErrorCode :: err_PETSc PetscErrorCode :: err_PETSc
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
real(pREAL), pointer, dimension(:,:,:,:) :: & real(pREAL), pointer, dimension(:,:,:,:) :: &
F ! pointer to solution data 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 real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: & type(tDict), pointer :: &
num_grid num_grid_fft, &
character(len=pSTRLEN) :: & num_grid_mech
extmsg = '' character(len=:), allocatable :: &
extmsg, &
petsc_options
print'(/,1x,a)', '<<<+- grid_mechanical_spectral_basic init -+>>>'; flush(IO_STDOUT) 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 ! 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%itmin = num_grid_mech%get_asInt('N_iter_min',defaultVal=1)
num%eps_div_atol = num_grid%get_asReal('eps_div_atol', defaultVal=1.0e-4_pREAL) num%itmax = num_grid_mech%get_asInt('N_iter_max',defaultVal=100)
num%eps_div_rtol = num_grid%get_asReal('eps_div_rtol', defaultVal=5.0e-4_pREAL) num%update_gamma = num_grid_mech%get_asBool('update_gamma',defaultVal=.false.)
num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL) num%eps_div_atol = num_grid_mech%get_asReal('eps_abs_div(P)', defaultVal=1.0e-4_pREAL)
num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL) num%eps_div_rtol = num_grid_mech%get_asReal('eps_rel_div(P)', defaultVal=5.0e-4_pREAL)
num%itmin = num_grid%get_asInt ('itmin',defaultVal=1) num%eps_stress_atol = num_grid_mech%get_asReal('eps_abs_P', defaultVal=1.0e3_pREAL)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250) 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' extmsg = ''
if (num%eps_div_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_rtol' if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_div(P)'
if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_atol' if (num%eps_div_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_div(P)'
if (num%eps_stress_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_rtol' if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_P'
if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax' if (num%eps_stress_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_P'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin' 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)) if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc ! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',err_PETSc) petsc_options = misc_prefixOptions('-snes_type ngmres '//num_grid_mech%get_asStr('PETSc_options',defaultVal=''), &
CHKERRQ(err_PETSc) 'mechanical_')
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -162,41 +162,40 @@ subroutine grid_mechanical_spectral_basic_init()
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc ! 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) CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc) call SNESSetOptionsPrefix(SNES_mech,'mechanical_',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
localK = 0_pPetscInt call MPI_Allgather(int(cells3,MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
localK(worldrank) = int(cells3,pPetscInt) cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3d(PETSC_COMM_WORLD, & call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
9_pPetscInt, 0_pPetscInt, & ! #dof (F, tensor), ghost boundary width (domain overlap) 9_pPETSCINT, 0_pPETSCINT, & ! #dof (F, tensor), ghost boundary width (domain overlap)
[int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells [int(cells(1),pPETSCINT)],[int(cells(2),pPETSCINT)],int(cells3_global,pPETSCINT), & ! local cells
da,err_PETSc) ! handle, error DM_mech,err_PETSc) ! handle, error
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call DMsetFromOptions(da,err_PETSc) call DMsetFromOptions(DM_mech,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call DMsetUp(da,err_PETSc) call DMsetUp(DM_mech,err_PETSc)
CHKERRQ(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) 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) 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) CHKERRQ(err_PETSc)
call SNESSetDM(SNES_mechanical,da,err_PETSc) call SNESSetDM(SNES_mech,DM_mech,err_PETSc)
CHKERRQ(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) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! init fields ! 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) CHKERRQ(err_PETSc)
restartRead: if (CLI_restartInc > 0) then 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 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 reshape(F,shape(F_lastInc)), & ! target F
0.0_pREAL) ! time increment 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) CHKERRQ(err_PETSc)
restartRead2: if (CLI_restartInc > 0) then 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) S = utilities_maskedCompliance(params%rotation_BC,params%stress_mask,C_volAvg)
if (num%update_gamma) call utilities_updateGamma(C_minMaxAvg) 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) CHKERRQ(err_PETSc)
call SNESGetConvergedReason(SNES_mechanical,reason,err_PETSc) call SNESGetConvergedReason(SNES_mech,reason,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
solution%converged = reason > 0 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 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) CHKERRQ(err_PETSc)
if (cutBack) then 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 & if (stress_BC%myType=='dot_P') P_aim = P_aim &
+ merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t + 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]) 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) 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 PetscErrorCode :: err_PETSc
real(pREAL), dimension(:,:,:,:), pointer :: F 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) CHKERRQ(err_PETSc)
call utilities_updateCoords(F) call utilities_updateCoords(reshape(F,[3,3,size(F,2),size(F,3),size(F,4)]))
call DMDAVecRestoreArrayF90(da,solution_vec,F,err_PETSc) call DMDAVecRestoreArrayReadF90(DM_mech,F_PETSc,F,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
end subroutine grid_mechanical_spectral_basic_updateCoords 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 PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
real(pREAL), dimension(:,:,:,:), pointer :: F 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) CHKERRQ(err_PETSc)
if (num%update_gamma) C_minMaxAvgRestart = C_minMaxAvg if (num%update_gamma) C_minMaxAvgRestart = C_minMaxAvg
@ -428,7 +427,7 @@ subroutine grid_mechanical_spectral_basic_restartWrite
call HDF5_closeFile(fileHandle) call HDF5_closeFile(fileHandle)
end if end if
call DMDAVecRestoreArrayF90(da,solution_vec,F,err_PETSc) call DMDAVecRestoreArrayReadF90(DM_mech,F_PETSc,F,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
end subroutine grid_mechanical_spectral_basic_restartWrite end subroutine grid_mechanical_spectral_basic_restartWrite
@ -499,9 +498,9 @@ subroutine formResidual(residual_subdomain, F, &
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
call SNESGetNumberFunctionEvals(SNES_mechanical,nfuncs,err_PETSc) call SNESGetNumberFunctionEvals(SNES_mech,nfuncs,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call SNESGetIterationNumber(SNES_mechanical,PETScIter,err_PETSc) call SNESGetIterationNumber(SNES_mech,PETScIter,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1 ! new increment if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1 ! new increment

177
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 !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Grid solver for mechanics: Spectral Polarisation !> @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/petscsnes.h>
#include <petsc/finclude/petscdmda.h> #include <petsc/finclude/petscdmda.h>
use PETScDMDA use PETScDMDA
@ -16,6 +16,7 @@ module grid_mechanical_spectral_polarisation
use prec use prec
use parallelization use parallelization
use CLI use CLI
use misc
use IO use IO
use HDF5 use HDF5
use HDF5_utilities use HDF5_utilities
@ -56,9 +57,9 @@ module grid_mechanical_spectral_polarisation
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc data ! PETSc data
DM :: da DM :: DM_mech
SNES :: SNES_mechanical SNES :: SNES_mech
Vec :: solution_vec Vec :: FandF_tau_PETSc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! common pointwise data ! common pointwise data
@ -93,28 +94,24 @@ module grid_mechanical_spectral_polarisation
err_curl, & !< RMS of curl of F err_curl, & !< RMS of curl of F
err_div !< RMS of div of P 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 :: & integer :: &
totalIter = 0 !< total iteration in current increment totalIter = 0 !< total iteration in current increment
public :: & public :: &
grid_mechanical_spectral_polarisation_init, & grid_mechanical_spectral_polarization_init, &
grid_mechanical_spectral_polarisation_solution, & grid_mechanical_spectral_polarization_solution, &
grid_mechanical_spectral_polarisation_forward, & grid_mechanical_spectral_polarization_forward, &
grid_mechanical_spectral_polarisation_updateCoords, & grid_mechanical_spectral_polarization_updateCoords, &
grid_mechanical_spectral_polarisation_restartWrite grid_mechanical_spectral_polarization_restartWrite
contains 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 real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: P
PetscErrorCode :: err_PETSc PetscErrorCode :: err_PETSc
@ -123,13 +120,15 @@ subroutine grid_mechanical_spectral_polarisation_init()
FandF_tau, & ! overall pointer to solution data FandF_tau, & ! overall pointer to solution data
F, & ! specific (sub)pointer F, & ! specific (sub)pointer
F_tau ! 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 real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: & type(tDict), pointer :: &
num_grid num_grid_fft,&
character(len=pSTRLEN) :: & num_grid_mech
extmsg = '' character(len=:), allocatable :: &
extmsg, &
petsc_options
print '(/,1x,a)', '<<<+- grid_mechanical_spectral_polarization init -+>>>'; flush(IO_STDOUT) 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)', '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' print '( 1x,a)', 'https://doi.org/10.1016/j.ijplas.2014.02.006'
!------------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks ! 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%itmin = num_grid_mech%get_asInt('N_iter_min',defaultVal=1)
num%eps_div_atol = num_grid%get_asReal('eps_div_atol', defaultVal=1.0e-4_pREAL) num%itmax = num_grid_mech%get_asInt('N_iter_max',defaultVal=100)
num%eps_div_rtol = num_grid%get_asReal('eps_div_rtol', defaultVal=5.0e-4_pREAL) num%update_gamma = num_grid_mech%get_asBool('update_gamma',defaultVal=.false.)
num%eps_curl_atol = num_grid%get_asReal('eps_curl_atol', defaultVal=1.0e-10_pREAL) num%eps_div_atol = num_grid_mech%get_asReal('eps_abs_div(P)', defaultVal=1.0e-4_pREAL)
num%eps_curl_rtol = num_grid%get_asReal('eps_curl_rtol', defaultVal=5.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%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL) num%eps_curl_atol = num_grid_mech%get_asReal('eps_abs_curl(F)',defaultVal=1.0e-10_pREAL)
num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL) num%eps_curl_rtol = num_grid_mech%get_asReal('eps_rel_curl(F)',defaultVal=5.0e-4_pREAL)
num%itmin = num_grid%get_asInt ('itmin', defaultVal=1) num%eps_stress_atol = num_grid_mech%get_asReal('eps_abs_P', defaultVal=1.0e3_pREAL)
num%itmax = num_grid%get_asInt ('itmax', defaultVal=250) num%eps_stress_rtol = num_grid_mech%get_asReal('eps_rel_P', defaultVal=1.0e-3_pREAL)
num%alpha = num_grid%get_asReal('alpha', defaultVal=1.0_pREAL) num%alpha = num_grid_mech%get_asReal('alpha', defaultVal=1.0_pREAL)
num%beta = num_grid%get_asReal('beta', 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' extmsg = ''
if (num%eps_div_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_rtol' if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_div(P)'
if (num%eps_curl_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_curl_atol' if (num%eps_div_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_div(P)'
if (num%eps_curl_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_curl_rtol' if (num%eps_curl_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_curl(F)'
if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_atol' if (num%eps_curl_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_curl(F)'
if (num%eps_stress_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_rtol' if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_abs_P'
if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax' if (num%eps_stress_rtol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_rel_P'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin'
if (num%alpha <= 0.0_pREAL .or. num%alpha > 2.0_pREAL) extmsg = trim(extmsg)//' alpha' 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%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)) if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc ! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',err_PETSc) petsc_options = misc_prefixOptions('-snes_type ngmres '//num_grid_mech%get_asStr('PETSc_options',defaultVal=''), &
CHKERRQ(err_PETSc) 'mechanical_')
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -183,41 +183,40 @@ subroutine grid_mechanical_spectral_polarisation_init()
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc ! 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) CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc) call SNESSetOptionsPrefix(SNES_mech,'mechanical_',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
localK = 0_pPetscInt call MPI_Allgather(int(cells3,pPetscInt),1_MPI_INTEGER_KIND,MPI_INTEGER,&
localK(worldrank) = int(cells3,pPetscInt) cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3d(PETSC_COMM_WORLD, & call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
18_pPetscInt, 0_pPetscInt, & ! #dof (2xtensor), ghost boundary width (domain overlap) 18_pPETSCINT, 0_pPETSCINT, & ! #dof (2xtensor), ghost boundary width (domain overlap)
[int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells [int(cells(1),pPETSCINT)],[int(cells(2),pPETSCINT)],int(cells3_global,pPETSCINT), & ! local cells
da,err_PETSc) ! handle, error DM_mech,err_PETSc) ! handle, error
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call DMsetFromOptions(da,err_PETSc) call DMsetFromOptions(DM_mech,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call DMsetUp(da,err_PETSc) call DMsetUp(DM_mech,err_PETSc)
CHKERRQ(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) 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) 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) CHKERRQ(err_PETSc)
call SNESSetDM(SNES_mechanical,da,err_PETSc) call SNESSetDM(SNES_mech,DM_mech,err_PETSc)
CHKERRQ(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) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! init fields ! 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) CHKERRQ(err_PETSc)
F => FandF_tau(0: 8,:,:,:) F => FandF_tau(0: 8,:,:,:)
F_tau => FandF_tau(9:17,:,:,:) 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 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 reshape(F,shape(F_lastInc)), & ! target F
0.0_pREAL) ! time increment 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) CHKERRQ(err_PETSc)
restartRead2: if (CLI_restartInc > 0) then restartRead2: if (CLI_restartInc > 0) then
@ -286,13 +285,13 @@ subroutine grid_mechanical_spectral_polarisation_init()
C_scale = C_minMaxAvg C_scale = C_minMaxAvg
S_scale = math_invSym3333(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 !> @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 ! input data for solution
@ -316,9 +315,9 @@ function grid_mechanical_spectral_polarisation_solution(incInfoIn) result(soluti
S_scale = math_invSym3333(C_minMaxAvg) S_scale = math_invSym3333(C_minMaxAvg)
end if 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) CHKERRQ(err_PETSc)
call SNESGetConvergedReason(SNES_mechanical,reason,err_PETSc) call SNESGetConvergedReason(SNES_mech,reason,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
solution%converged = reason > 0 solution%converged = reason > 0
@ -327,14 +326,14 @@ function grid_mechanical_spectral_polarisation_solution(incInfoIn) result(soluti
terminallyIll = .false. terminallyIll = .false.
P_aim = merge(P_av,P_aim,params%stress_mask) 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 !> @brief forwarding routine
!> @details find new boundary conditions and best F estimate for end of current timestep !> @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) deformation_BC,stress_BC,rotation_BC)
logical, intent(in) :: & 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 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) CHKERRQ(err_PETSc)
F => FandF_tau(0: 8,:,:,:) F => FandF_tau(0: 8,:,:,:)
F_tau => FandF_tau(9:17,:,:,:) 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 & if (stress_BC%myType=='dot_P') P_aim = P_aim &
+ merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t + 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.)),& rotation_BC%rotate(F_aim,active=.true.)),&
[9,cells(1),cells(2),cells3]) [9,cells(1),cells(2),cells3])
if (guess) then 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 [9,cells(1),cells(2),cells3]) ! does not have any average value as boundary condition
else else
do k = 1, cells3; do j = 1, cells(2); do i = 1, cells(1) 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 do; end do; end do
end if 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) CHKERRQ(err_PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -428,36 +427,36 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
params%rotation_BC = rotation_BC params%rotation_BC = rotation_BC
params%Delta_t = Delta_t 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 PetscErrorCode :: err_PETSc
real(pREAL), dimension(:,:,:,:), pointer :: FandF_tau 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) CHKERRQ(err_PETSc)
call utilities_updateCoords(FandF_tau(0:8,:,:,:)) call utilities_updateCoords(reshape(FandF_tau(0:8,:,:,:),[3,3,size(FandF_tau,2),size(FandF_tau,3),size(FandF_tau,4)]))
call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,err_PETSc) call DMDAVecRestoreArrayReadF90(DM_mech,FandF_tau_PETSc,FandF_tau,err_PETSc)
CHKERRQ(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 PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
real(pREAL), dimension(:,:,:,:), pointer :: FandF_tau, F, F_tau 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) CHKERRQ(err_PETSc)
F => FandF_tau(0: 8,:,:,:) F => FandF_tau(0: 8,:,:,:)
F_tau => FandF_tau(9:17,:,:,:) F_tau => FandF_tau(9:17,:,:,:)
@ -489,10 +488,10 @@ subroutine grid_mechanical_spectral_polarisation_restartWrite
call HDF5_closeFile(fileHandle) call HDF5_closeFile(fileHandle)
end if 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) 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) 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' 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) CHKERRQ(err_PETSc)
call SNESGetIterationNumber(SNES_mechanical,PETScIter,err_PETSc) call SNESGetIterationNumber(SNES_mech,PETScIter,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1 ! new increment if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1 ! new increment
@ -645,4 +644,4 @@ subroutine formResidual(residual_subdomain, FandF_tau, &
end subroutine formResidual end subroutine formResidual
end module grid_mechanical_spectral_polarisation end module grid_mechanical_spectral_polarization

190
src/grid/grid_thermal_spectral.f90
View File

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

71
src/grid/spectral_utilities.f90
View File

@ -100,12 +100,18 @@ module spectral_utilities
enum, bind(c); enumerator :: & enum, bind(c); enumerator :: &
DERIVATIVE_CONTINUOUS_ID, & DERIVATIVE_CONTINUOUS_ID, &
DERIVATIVE_CENTRAL_DIFF_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 end enum
integer(kind(DERIVATIVE_CONTINUOUS_ID)) :: & integer(kind(DERIVATIVE_CONTINUOUS_ID)) :: &
spectral_derivative_ID spectral_derivative_ID
integer(kind(DIVERGENCE_CORRECTION_NONE_ID)) :: &
divergence_correction_ID
public :: & public :: &
spectral_utilities_init, & spectral_utilities_init, &
utilities_updateGamma, & utilities_updateGamma, &
@ -118,7 +124,7 @@ module spectral_utilities
utilities_maskedCompliance, & utilities_maskedCompliance, &
utilities_constitutiveResponse, & utilities_constitutiveResponse, &
utilities_calculateRate, & utilities_calculateRate, &
utilities_forwardField, & utilities_forwardTensorField, &
utilities_updateCoords utilities_updateCoords
contains contains
@ -146,8 +152,9 @@ subroutine spectral_utilities_init()
vectorSize = 3_C_INTPTR_T, & vectorSize = 3_C_INTPTR_T, &
tensorSize = 9_C_INTPTR_T tensorSize = 9_C_INTPTR_T
type(tDict) , pointer :: & type(tDict) , pointer :: &
num_grid num_solver, &
num_grid, &
num_grid_fft
print'(/,1x,a)', '<<<+- spectral_utilities init -+>>>' 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)', 'P. Shanthraj et al., Handbook of Mechanics of Materials, 2019'
print'( 1x,a)', 'https://doi.org/10.1007/978-981-10-6855-3_80' 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) call PetscOptionsClear(PETSC_NULL_OPTIONS,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,& call PetscOptionsInsertString(PETSC_NULL_OPTIONS,&
@ -174,13 +183,21 @@ subroutine spectral_utilities_init()
cells1Red = cells(1)/2 + 1 cells1Red = cells(1)/2 + 1
wgt = real(product(cells),pREAL)**(-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%memory_efficient = num_grid_fft%get_asBool('memory_efficient', defaultVal=.true.)
num%divergence_correction = num_grid%get_asInt('divergence_correction', defaultVal=2)
if (num%divergence_correction < 0 .or. num%divergence_correction > 2) & select case (num_grid_fft%get_asStr('divergence_correction',defaultVal='grid+size'))
call IO_error(301,ext_msg='divergence_correction') 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') case ('continuous')
spectral_derivative_ID = DERIVATIVE_CONTINUOUS_ID spectral_derivative_ID = DERIVATIVE_CONTINUOUS_ID
case ('central_difference') case ('central_difference')
@ -188,18 +205,18 @@ subroutine spectral_utilities_init()
case ('FWBW_difference') case ('FWBW_difference')
spectral_derivative_ID = DERIVATIVE_FWBW_DIFF_ID spectral_derivative_ID = DERIVATIVE_FWBW_DIFF_ID
case default 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 end select
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! scale dimension to calculate either uncorrected, dimension-independent, or dimension- and ! scale dimension to calculate either uncorrected, dimension-independent, or dimension- and
! resolution-independent divergence ! resolution-independent divergence
if (num%divergence_correction == 1) then if (divergence_correction_ID == DIVERGENCE_CORRECTION_NONE_ID) then
do j = 1, 3 do j = 1, 3
if (j /= minloc(geomSize,1) .and. j /= maxloc(geomSize,1)) & if (j /= minloc(geomSize,1) .and. j /= maxloc(geomSize,1)) &
scaledGeomSize = geomSize/geomSize(j) scaledGeomSize = geomSize/geomSize(j)
end do end do
elseif (num%divergence_correction == 2) then elseif (divergence_correction_ID == DIVERGENCE_CORRECTION_SIZE_GRID_ID) then
do j = 1, 3 do j = 1, 3
if ( j /= int(minloc(geomSize/real(cells,pREAL),1)) & if ( j /= int(minloc(geomSize/real(cells,pREAL),1)) &
.and. j /= int(maxloc(geomSize/real(cells,pREAL),1))) & .and. j /= int(maxloc(geomSize/real(cells,pREAL),1))) &
@ -209,24 +226,24 @@ subroutine spectral_utilities_init()
scaledGeomSize = geomSize scaledGeomSize = geomSize
end if end if
select case(IO_lc(num_grid%get_asStr('fftw_plan_mode',defaultVal='FFTW_MEASURE'))) select case(IO_lc(num_grid_fft%get_asStr('FFTW_plan_mode',defaultVal='FFTW_MEASURE')))
case('fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution case('fftw_estimate', 'FFTW_ESTIMATE') ! ordered from slow execution (but fast plan creation) to fast execution
FFTW_planner_flag = FFTW_ESTIMATE FFTW_planner_flag = FFTW_ESTIMATE
case('fftw_measure') case('fftw_measure', 'FFTW_MEASURE')
FFTW_planner_flag = FFTW_MEASURE FFTW_planner_flag = FFTW_MEASURE
case('fftw_patient') case('fftw_patient', 'FFTW_PATIENT')
FFTW_planner_flag = FFTW_PATIENT FFTW_planner_flag = FFTW_PATIENT
case('fftw_exhaustive') case('fftw_exhaustive', 'FFTW_EXHAUSTIVE')
FFTW_planner_flag = FFTW_EXHAUSTIVE FFTW_planner_flag = FFTW_EXHAUSTIVE
case default 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 FFTW_planner_flag = FFTW_MEASURE
end select end select
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! general initialization of FFTW (see manual on fftw.org for more details) ! 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' 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) print'(/,1x,a)', 'FFTW initialized'; flush(IO_STDOUT)
@ -657,6 +674,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
logical :: errmatinv logical :: errmatinv
character(len=pSTRLEN):: formatString character(len=pSTRLEN):: formatString
mask_stressVector = .not. reshape(transpose(mask_stress), [9]) mask_stressVector = .not. reshape(transpose(mask_stress), [9])
size_reduced = count(mask_stressVector) size_reduced = count(mask_stressVector)
if (size_reduced > 0) then if (size_reduced > 0) then
@ -679,6 +697,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
write(formatString, '(i2)') size_reduced write(formatString, '(i2)') size_reduced
formatString = '(/,1x,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))' 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 * S (load) ', transpose(matmul(c_reduced,s_reduced))
print trim(formatString), 'C (load) ', transpose(c_reduced)
print trim(formatString), 'S (load) ', transpose(s_reduced) print trim(formatString), 'S (load) ', transpose(s_reduced)
if (errmatinv) error stop 'matrix inversion error' if (errmatinv) error stop 'matrix inversion error'
end if end if
@ -847,7 +866,7 @@ end function utilities_calculateRate
!> @brief forwards a field with a pointwise given rate, if aim is given, !> @brief forwards a field with a pointwise given rate, if aim is given,
!> ensures that the average matches the aim !> 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) :: & real(pREAL), intent(in) :: &
Delta_t !< Delta_t of current step 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 aim !< average field value aim
real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: & real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: &
utilities_forwardField utilities_forwardTensorField
real(pREAL), dimension(3,3) :: fieldDiff !< <a + adot*t> - aim real(pREAL), dimension(3,3) :: fieldDiff !< <a + adot*t> - aim
integer(MPI_INTEGER_KIND) :: err_MPI 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 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) 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' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
fieldDiff = fieldDiff - aim fieldDiff = fieldDiff - aim
utilities_forwardField = utilities_forwardField & utilities_forwardTensorField = utilities_forwardTensorField &
- spread(spread(spread(fieldDiff,3,cells(1)),4,cells(2)),5,cells3) - spread(spread(spread(fieldDiff,3,cells(1)),4,cells(2)),5,cells3)
end if 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
use HDF5_utilities use HDF5_utilities
use result use result
use lattice use crystal
implicit none(type,external) implicit none(type,external)
private private
@ -59,15 +59,6 @@ module homogenization
real(pREAL), dimension(:,:,:,:,:), allocatable, public :: & !, protected :: & real(pREAL), dimension(:,:,:,:,:), allocatable, public :: & !, protected :: &
homogenization_dPdF !< tangent of first P--K stress at IP 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 interface
@ -145,9 +136,8 @@ module homogenization
real(pREAL) :: f real(pREAL) :: f
end function homogenization_f_T end function homogenization_f_T
module subroutine homogenization_thermal_setField(T,dot_T, ce) module subroutine homogenization_thermal_setField(T,dot_T)
integer, intent(in) :: ce real(pREAL), dimension(:), intent(in) :: T, dot_T
real(pREAL), intent(in) :: T, dot_T
end subroutine homogenization_thermal_setField end subroutine homogenization_thermal_setField
module function homogenization_damage_active() result(active) module function homogenization_damage_active() result(active)
@ -170,10 +160,8 @@ module homogenization
real(pREAL) :: f real(pREAL) :: f
end function homogenization_f_phi end function homogenization_f_phi
module subroutine homogenization_set_phi(phi,ce) module subroutine homogenization_set_phi(phi)
integer, intent(in) :: ce real(pREAL), dimension(:), intent(in) :: phi
real(pREAL), intent(in) :: &
phi
end subroutine homogenization_set_phi end subroutine homogenization_set_phi
end interface end interface
@ -217,12 +205,6 @@ subroutine homogenization_init()
allocate(damageState_h (size(material_name_homogenization))) allocate(damageState_h (size(material_name_homogenization)))
call parseHomogenization() 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 mechanical_init()
call thermal_init() call thermal_init()
call damage_init() call damage_init()
@ -239,7 +221,6 @@ subroutine homogenization_mechanical_response(Delta_t,cell_start,cell_end)
integer, intent(in) :: & integer, intent(in) :: &
cell_start, cell_end cell_start, cell_end
integer :: & integer :: &
NiterationMPstate, &
co, ce, ho, en co, ce, ho, en
logical :: & logical :: &
converged converged
@ -247,7 +228,7 @@ subroutine homogenization_mechanical_response(Delta_t,cell_start,cell_end)
doneAndHappy 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 do ce = cell_start, cell_end
en = material_entry_homogenization(ce) en = material_entry_homogenization(ce)
@ -261,10 +242,7 @@ subroutine homogenization_mechanical_response(Delta_t,cell_start,cell_end)
doneAndHappy = [.false.,.true.] doneAndHappy = [.false.,.true.]
NiterationMPstate = 0 convergenceLooping: do while (.not. (terminallyIll .or. doneAndHappy(1)))
convergenceLooping: do while (.not. (terminallyIll .or. doneAndHappy(1)) &
.and. NiterationMPstate < num%nMPstate)
NiterationMPstate = NiterationMPstate + 1
call mechanical_partition(homogenization_F(1:3,1:3,ce),ce) 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))]) converged = all([(phase_mechanical_constitutive(Delta_t,co,ce),co=1,homogenization_Nconstituents(ho))])

15
src/homogenization_damage.f90
View File

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

56
src/homogenization_mechanical_RGC.f90
View File

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

15
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). !> @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), dimension(:), intent(in) :: T, dot_T
real(pREAL), intent(in) :: T, dot_T
integer :: ho, en, ce
current(material_ID_homogenization(ce))%T(material_entry_homogenization(ce)) = T do ce=max(lbound(T,1),lbound(dot_T,1)), min(ubound(T,1),ubound(dot_T,1))
current(material_ID_homogenization(ce))%dot_T(material_entry_homogenization(ce)) = dot_T 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) call thermal_partition(ce)
end do
end subroutine homogenization_thermal_setField end subroutine homogenization_thermal_setField

4
src/materialpoint.f90
View File

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

86
src/math.f90
View File

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

16
src/mesh/DAMASK_mesh.f90
View File

@ -66,6 +66,7 @@ program DAMASK_mesh
stagIter, & stagIter, &
component component
type(tDict), pointer :: & type(tDict), pointer :: &
num_solver, &
num_mesh num_mesh
character(len=pSTRLEN), dimension(:), allocatable :: fileContent character(len=pSTRLEN), dimension(:), allocatable :: fileContent
character(len=pSTRLEN) :: & character(len=pSTRLEN) :: &
@ -90,12 +91,13 @@ program DAMASK_mesh
!--------------------------------------------------------------------- !---------------------------------------------------------------------
! reading field information from numerics file and do sanity checks ! reading field information from numerics file and do sanity checks
num_mesh => config_numerics%get_dict('mesh', defaultVal=emptyDict) num_solver => config_numerics%get_dict('solver',defaultVal=emptyDict)
stagItMax = num_mesh%get_asInt('maxStaggeredIter',defaultVal=10) num_mesh => num_solver%get_dict('mesh',defaultVal=emptyDict)
maxCutBack = num_mesh%get_asInt('maxCutBack',defaultVal=3) 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 (stagItMax < 0) call IO_error(301,ext_msg='N_staggered_iter_max')
if (maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack') 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 ! 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) 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 ! doing initialization depending on active solvers
call FEM_Utilities_init() call FEM_Utilities_init(num_mesh)
call FEM_mechanical_init(loadCases(1)%fieldBC(1)) call FEM_mechanical_init(loadCases(1)%fieldBC(1),num_mesh)
call config_numerics_deallocate() call config_numerics_deallocate()
if (worldrank == 0) then if (worldrank == 0) then

32
src/mesh/FEM_utilities.f90
View File

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

6
src/mesh/discretization_mesh.f90
View File

@ -56,7 +56,7 @@ module discretization_mesh
real(pREAL), dimension(:,:,:), allocatable :: & real(pREAL), dimension(:,:,:), allocatable :: &
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) 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 :: & external :: &
DMDestroy DMDestroy
#endif #endif
@ -89,6 +89,7 @@ subroutine discretization_mesh_init(restart)
PetscInt, dimension(:), allocatable :: & PetscInt, dimension(:), allocatable :: &
materialAt materialAt
type(tDict), pointer :: & type(tDict), pointer :: &
num_solver, &
num_mesh num_mesh
integer :: p_i, dim !< integration order (quadrature rule) integer :: p_i, dim !< integration order (quadrature rule)
type(tvec) :: coords_node0 type(tvec) :: coords_node0
@ -99,7 +100,8 @@ subroutine discretization_mesh_init(restart)
!-------------------------------------------------------------------------------- !--------------------------------------------------------------------------------
! read numerics parameter ! read numerics parameter
num_mesh => config_numerics%get_dict('mesh',defaultVal=emptyDict) 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) p_i = num_mesh%get_asInt('p_i',defaultVal=2)
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>16) #if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>16)

36
src/mesh/mesh_mech_FEM.f90
View File

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

33
src/misc.f90
View File

@ -5,6 +5,7 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module misc module misc
use prec use prec
use constants
implicit none(type,external) implicit none(type,external)
private private
@ -18,7 +19,9 @@ module misc
public :: & public :: &
misc_init, & misc_init, &
misc_optional misc_selfTest, &
misc_optional, &
misc_prefixOptions
contains contains
@ -110,6 +113,28 @@ pure function misc_optional_str(given,default) result(var)
end function misc_optional_str 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. !> @brief Check correctness of some misc functions.
@ -117,6 +142,8 @@ end function misc_optional_str
subroutine misc_selfTest() subroutine misc_selfTest()
real(pREAL) :: r real(pREAL) :: r
character(len=:), allocatable :: str,out
call random_number(r) call random_number(r)
if (test_str('DAMASK') /= 'DAMASK') error stop 'optional_str, present' 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 (.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' 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 contains
function test_str(str_in) result(str_out) function test_str(str_in) result(str_out)

95
src/phase.f90
View File

@ -14,7 +14,7 @@ module phase
use config use config
use material use material
use result use result
use lattice use crystal
use discretization use discretization
use parallelization use parallelization
use HDF5 use HDF5
@ -49,6 +49,29 @@ module phase
type(tState), dimension(:), allocatable :: p !< tState for each active source mechanism in a phase type(tState), dimension(:), allocatable :: p !< tState for each active source mechanism in a phase
end type 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 character(len=2), allocatable, dimension(:) :: phase_lattice
real(pREAL), allocatable, dimension(:) :: phase_cOverA real(pREAL), allocatable, dimension(:) :: phase_cOverA
@ -61,17 +84,21 @@ module phase
type :: tNumerics type :: tNumerics
integer :: & integer :: &
iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp
iJacoLiresiduum, & !< frequency of Jacobian update of residuum in Li
nState, & !< state loop limit nState, & !< state loop limit
nStress !< stress loop limit nStress_Lp, & !< stress loop limit for Lp
nStress_Li !< stress loop limit for Li
real(pREAL) :: & real(pREAL) :: &
subStepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback stepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback
subStepSizeCryst, & !< size of first substep when cutback stepSizeCryst, & !< size of first substep when cutback
subStepSizeLp, & !< size of first substep when cutback in Lp calculation stepSizeLp, & !< size of first substep when cutback in Lp calculation
subStepSizeLi, & !< size of first substep when cutback in Li calculation stepSizeLi, & !< size of first substep when cutback in Li calculation
stepIncreaseCryst, & !< increase of next substep size when previous substep converged stepIncreaseCryst, & !< increase of next substep size when previous substep converged
rtol_crystalliteState, & !< relative tolerance in state loop rtol_crystalliteState, &
rtol_crystalliteStress, & !< relative tolerance in stress loop rtol_Lp, & !< relative tolerance in stress loop for Lp
atol_crystalliteStress !< absolute tolerance in stress loop 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 end type tNumerics
type(tNumerics) :: num ! numerics parameters. Better name? type(tNumerics) :: num ! numerics parameters. Better name?
@ -85,8 +112,8 @@ module phase
interface interface
! == cleaned:begin ================================================================================= ! == cleaned:begin =================================================================================
module subroutine mechanical_init(phases) module subroutine mechanical_init(phases,num_mech)
type(tDict), pointer :: phases type(tDict), pointer :: phases, num_mech
end subroutine mechanical_init end subroutine mechanical_init
module subroutine damage_init module subroutine damage_init
@ -336,7 +363,7 @@ module phase
config, & config, &
material, & material, &
result, & result, &
lattice, & crystal, &
discretization, & discretization, &
HDF5_utilities HDF5_utilities
#endif #endif
@ -381,7 +408,9 @@ subroutine phase_init
ph, ce, co, ma ph, ce, co, ma
type(tDict), pointer :: & type(tDict), pointer :: &
phases, & phases, &
phase phase, &
num_phase, &
num_mech
character(len=:), allocatable :: refs character(len=:), allocatable :: refs
@ -398,12 +427,12 @@ subroutine phase_init
phase => phases%get_dict(ph) phase => phases%get_dict(ph)
refs = config_listReferences(phase,indent=3) refs = config_listReferences(phase,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs 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') phase_lattice(ph) = phase%get_asStr('lattice')
if (all(phase_lattice(ph) /= ['cF','cI','hP','tI'])) & if (all(phase_lattice(ph) /= ['cF','cI','hP','tI'])) &
call IO_error(130,ext_msg='phase_init: '//phase%get_asStr('lattice')) call IO_error(130,ext_msg='phase_init: '//phase%get_asStr('lattice'))
if (any(phase_lattice(ph) == ['hP','tI'])) & if (any(phase_lattice(ph) == ['hP','tI'])) &
phase_cOverA(ph) = phase%get_asReal('c/a') 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))) allocate(phase_O_0(ph)%data(count(material_ID_phase==ph)))
end do end do
@ -420,7 +449,10 @@ subroutine phase_init
phase_O(ph)%data = phase_O_0(ph)%data phase_O(ph)%data = phase_O_0(ph)%data
end do 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 damage_init()
call thermal_init(phases) call thermal_init(phases)
@ -531,39 +563,8 @@ subroutine crystallite_init()
el, & !< counter in element loop el, & !< counter in element loop
en, ph en, ph
type(tDict), pointer :: & type(tDict), pointer :: &
num_crystallite, & num_phase, &
phases 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') 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 l_c = 0.0_pREAL !< characteristic length
end type tDamageParameters end type tDamageParameters
enum, bind(c); enumerator :: &
DAMAGE_UNDEFINED_ID, &
DAMAGE_ISOBRITTLE_ID, &
DAMAGE_ANISOBRITTLE_ID
end enum
integer :: phase_damage_maxSizeDotState integer :: phase_damage_maxSizeDotState
type :: tFieldQuantities
type :: tDataContainer
real(pREAL), dimension(:), allocatable :: phi 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 type(tDamageParameters), dimension(:), allocatable :: param
@ -114,11 +105,11 @@ module subroutine damage_init()
end do end do
allocate(phase_damage(phases%length), source = DAMAGE_UNDEFINED_ID) allocate(damage_type(phases%length), source = UNDEFINED)
if (damage_active) then if (damage_active) then
where(isobrittle_init() ) phase_damage = DAMAGE_ISOBRITTLE_ID where(isobrittle_init() ) damage_type = DAMAGE_ISOBRITTLE
where(anisobrittle_init()) phase_damage = DAMAGE_ANISOBRITTLE_ID where(anisobrittle_init()) damage_type = DAMAGE_ANISOBRITTLE
end if end if
phase_damage_maxSizeDotState = maxval(damageState%sizeDotState) 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 real(pREAL), dimension(6,6) :: C66_degraded
damageType: select case (phase_damage(ph)) damageType: select case (damage_type(ph))
case (DAMAGE_ISOBRITTLE_ID) damageType case (DAMAGE_ISOBRITTLE) damageType
C66_degraded = C66 * damage_phi(ph,en)**2 C66_degraded = C66 * damage_phi(ph,en)**2
case default damageType case default damageType
C66_degraded = C66 C66_degraded = C66
@ -204,13 +195,14 @@ module function phase_f_phi(phi,co,ce) result(f)
ph, & ph, &
en en
ph = material_ID_phase(co,ce) ph = material_ID_phase(co,ce)
en = material_entry_phase(co,ce) en = material_entry_phase(co,ce)
select case(phase_damage(ph)) select case(damage_type(ph))
case(DAMAGE_ISOBRITTLE_ID,DAMAGE_ANISOBRITTLE_ID) case(DAMAGE_ISOBRITTLE,DAMAGE_ANISOBRITTLE)
f = 1.0_pREAL & 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 case default
f = 0.0_pREAL f = 0.0_pREAL
end select end select
@ -318,8 +310,8 @@ module subroutine damage_restartWrite(groupHandle,ph)
integer, intent(in) :: ph integer, intent(in) :: ph
select case(phase_damage(ph)) select case(damage_type(ph))
case(DAMAGE_ISOBRITTLE_ID,DAMAGE_ANISOBRITTLE_ID) case(DAMAGE_ISOBRITTLE,DAMAGE_ANISOBRITTLE)
call HDF5_write(damageState(ph)%state,groupHandle,'omega_damage') call HDF5_write(damageState(ph)%state,groupHandle,'omega_damage')
end select end select
@ -332,8 +324,8 @@ module subroutine damage_restartRead(groupHandle,ph)
integer, intent(in) :: ph integer, intent(in) :: ph
select case(phase_damage(ph)) select case(damage_type(ph))
case(DAMAGE_ISOBRITTLE_ID,DAMAGE_ANISOBRITTLE_ID) case(DAMAGE_ISOBRITTLE,DAMAGE_ANISOBRITTLE)
call HDF5_read(damageState(ph)%state0,groupHandle,'omega_damage') call HDF5_read(damageState(ph)%state0,groupHandle,'omega_damage')
end select end select
@ -350,15 +342,15 @@ module subroutine damage_result(group,ph)
integer, intent(in) :: ph integer, intent(in) :: ph
if (phase_damage(ph) /= DAMAGE_UNDEFINED_ID) & if (damage_type(ph) /= UNDEFINED) &
call result_closeGroup(result_addGroup(group//'damage')) 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/') call isobrittle_result(ph,group//'damage/')
case (DAMAGE_ANISOBRITTLE_ID) sourceType case (DAMAGE_ANISOBRITTLE) sourceType
call anisobrittle_result(ph,group//'damage/') call anisobrittle_result(ph,group//'damage/')
end select sourceType end select sourceType
@ -381,9 +373,9 @@ function phase_damage_collectDotState(ph,en) result(broken)
if (damageState(ph)%sizeState > 0) then 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 call anisobrittle_dotState(mechanical_S(ph,en), ph,en) ! ToDo: use M_d
end select sourceType end select sourceType
@ -446,9 +438,9 @@ function phase_damage_deltaState(Fe, ph, en) result(broken)
if (damageState(ph)%sizeState == 0) return 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) call isobrittle_deltaState(phase_homogenizedC66(ph,en), Fe, ph,en)
broken = any(IEEE_is_NaN(damageState(ph)%deltaState(:,en))) broken = any(IEEE_is_NaN(damageState(ph)%deltaState(:,en)))
if (.not. broken) then 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 if (count(mySources) == 0) return
print'(/,1x,a)', '<<<+- phase:damage:anisobrittle init -+>>>' 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') phases => config_material%get_dict('phase')
@ -64,7 +64,7 @@ module function anisobrittle_init() result(mySources)
associate(prm => param(ph)) 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) refs = config_listReferences(src,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs 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%s_crit = src%get_as1dReal('s_crit',requiredSize=size(N_cl))
prm%g_crit = src%get_as1dReal('g_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 ! expand: family => system
prm%s_crit = math_expand(prm%s_crit,N_cl) 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 if (count(mySources) == 0) return
print'(/,1x,a)', '<<<+- phase:damage:isobrittle init -+>>>' 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') 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') 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) refs = config_listReferences(src,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs if (len(refs) > 0) print'(/,1x,a)', refs

280
src/phase_mechanical.f90
View File

@ -3,21 +3,6 @@
!---------------------------------------------------------------------------------------------------- !----------------------------------------------------------------------------------------------------
submodule(phase) mechanical 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 :: & type(tTensorContainer), dimension(:), allocatable :: &
! current value ! current value
phase_mechanical_Fe, & phase_mechanical_Fe, &
@ -37,9 +22,6 @@ submodule(phase) mechanical
phase_mechanical_S0 phase_mechanical_S0
integer(kind(PLASTIC_undefined_ID)), dimension(:), allocatable :: &
phase_plasticity !< plasticity of each phase
interface interface
module subroutine eigen_init(phases) module subroutine eigen_init(phases)
@ -198,10 +180,11 @@ contains
!> @brief Initialize mechanical field related constitutive models !> @brief Initialize mechanical field related constitutive models
!> @details Initialize elasticity, plasticity and stiffness degradation models. !> @details Initialize elasticity, plasticity and stiffness degradation models.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module subroutine mechanical_init(phases) module subroutine mechanical_init(phases, num_mech)
type(tDict), pointer :: & type(tDict), pointer :: &
phases phases, &
num_mech
integer :: & integer :: &
ce, & ce, &
@ -211,9 +194,11 @@ module subroutine mechanical_init(phases)
en, & en, &
Nmembers Nmembers
type(tDict), pointer :: & type(tDict), pointer :: &
num_crystallite, &
phase, & phase, &
mech mech, &
num_mech_plastic, &
num_mech_eigen
character(len=:), allocatable :: extmsg
print'(/,1x,a)', '<<<+- phase:mechanical init -+>>>' print'(/,1x,a)', '<<<+- phase:mechanical init -+>>>'
@ -283,15 +268,50 @@ module subroutine mechanical_init(phases)
call elastic_init(phases) call elastic_init(phases)
allocate(plasticState(phases%length)) allocate(plasticState(phases%length))
allocate(phase_plasticity(phases%length),source = PLASTIC_UNDEFINED_ID) allocate(mechanical_plasticity_type(phases%length),source = UNDEFINED)
call plastic_init() call plastic_init()
do ph = 1,phases%length do ph = 1,phases%length
plasticState(ph)%state0 = plasticState(ph)%state plasticState(ph)%state0 = plasticState(ph)%state
end do 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') case('FPI')
integrateState => integrateStateFPI integrateState => integrateStateFPI
@ -327,24 +347,24 @@ module subroutine mechanical_result(group,ph)
call results(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/') call plastic_isotropic_result(ph,group//'mechanical/')
case(PLASTIC_PHENOPOWERLAW_ID) case(MECHANICAL_PLASTICITY_PHENOPOWERLAW)
call plastic_phenopowerlaw_result(ph,group//'mechanical/') call plastic_phenopowerlaw_result(ph,group//'mechanical/')
case(PLASTIC_KINEHARDENING_ID) case(MECHANICAL_PLASTICITY_KINEHARDENING)
call plastic_kinehardening_result(ph,group//'mechanical/') call plastic_kinehardening_result(ph,group//'mechanical/')
case(PLASTIC_DISLOTWIN_ID) case(MECHANICAL_PLASTICITY_DISLOTWIN)
call plastic_dislotwin_result(ph,group//'mechanical/') call plastic_dislotwin_result(ph,group//'mechanical/')
case(PLASTIC_DISLOTUNGSTEN_ID) case(MECHANICAL_PLASTICITY_DISLOTUNGSTEN)
call plastic_dislotungsten_result(ph,group//'mechanical/') call plastic_dislotungsten_result(ph,group//'mechanical/')
case(PLASTIC_NONLOCAL_ID) case(MECHANICAL_PLASTICITY_NONLOCAL)
call plastic_nonlocal_result(ph,group//'mechanical/') call plastic_nonlocal_result(ph,group//'mechanical/')
end select 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 !> @brief calculation of stress (P) with time integration based on a residuum in Lp and
!> intermediate acceleration of the Newton-Raphson correction !> 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 real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en 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 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 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 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 if (error) return ! error
A = matmul(F,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp 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 NiterationStressLi = 0
LiLoop: do LiLoop: do
NiterationStressLi = NiterationStressLi + 1 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) invFi_new = matmul(invFi_current,math_I3 - Delta_t*Liguess)
Fi_new = math_inv33(invFi_new) Fi_new = math_inv33(invFi_new)
@ -447,7 +467,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
NiterationStressLp = 0 NiterationStressLp = 0
LpLoop: do LpLoop: do
NiterationStressLp = NiterationStressLp + 1 NiterationStressLp = NiterationStressLp + 1
if (NiterationStressLp>num%nStress) return ! error if (NiterationStressLp>num%nStress_Lp) return ! error
B = math_I3 - Delta_t*Lpguess B = math_I3 - Delta_t*Lpguess
Fe = matmul(matmul(A,B), invFi_new) 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) S, Fi_new, ph,en)
!* update current residuum and check for convergence of loop !* 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 atol_Lp = max(num%rtol_Lp * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error
num%atol_crystalliteStress) ! minimum lower cutoff num%atol_Lp) ! minimum lower cutoff
residuumLp = Lpguess - Lp_constitutive residuumLp = Lpguess - Lp_constitutive
if (any(IEEE_is_NaN(residuumLp))) then 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 Lpguess_old = Lpguess
steplengthLp = 1.0_pREAL ! ...proceed with normal step length (calculate new search direction) steplengthLp = 1.0_pREAL ! ...proceed with normal step length (calculate new search direction)
else ! not converged and residuum not improved... 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 & Lpguess = Lpguess_old &
+ deltaLp * stepLengthLp + deltaLp * stepLengthLp
cycle LpLoop cycle LpLoop
@ -499,8 +519,8 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
S, Fi_new, ph,en) S, Fi_new, ph,en)
!* update current residuum and check for convergence of loop !* 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 atol_Li = max(num%rtol_Li * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error
num%atol_crystalliteStress) ! minimum lower cutoff num%atol_Li) ! minimum lower cutoff
residuumLi = Liguess - Li_constitutive residuumLi = Liguess - Li_constitutive
if (any(IEEE_is_NaN(residuumLi))) then if (any(IEEE_is_NaN(residuumLi))) then
return ! error return ! error
@ -511,13 +531,13 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
Liguess_old = Liguess Liguess_old = Liguess
steplengthLi = 1.0_pREAL ! ...proceed with normal step length (calculate new search direction) steplengthLi = 1.0_pREAL ! ...proceed with normal step length (calculate new search direction)
else ! not converged and residuum not improved... 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 & Liguess = Liguess_old &
+ deltaLi * steplengthLi + deltaLi * steplengthLi
cycle LiLoop cycle LiLoop
end if end if
calculateJacobiLi: if (mod(jacoCounterLi, num%iJacoLpresiduum) == 0) then calculateJacobiLi: if (mod(jacoCounterLi, num%iJacoLiresiduum) == 0) then
jacoCounterLi = jacoCounterLi + 1 jacoCounterLi = jacoCounterLi + 1
temp_33 = matmul(matmul(A,B),invFi_current) 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 !> @brief integrate stress, state with adaptive 1st order explicit Euler method
!> using Fixed Point Iteration to adapt the stepsize !> 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(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: subState0 real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: & integer, intent(in) :: &
ph, & 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 if (any(IEEE_is_NaN(dotState))) return
sizeDotState = plasticState(ph)%sizeDotState 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 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,2) = merge(dotState_last(1:sizeDotState,1),0.0_pREAL, nIterationState > 1)
dotState_last(1:sizeDotState,1) = dotState 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 if (broken) exit iteration
dotState = plastic_dotState(Delta_t,ph,en) 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 = dotState * zeta &
+ dotState_last(1:sizeDotState,1) * (1.0_pREAL - zeta) + dotState_last(1:sizeDotState,1) * (1.0_pREAL - zeta)
r = plasticState(ph)%state(1:sizeDotState,en) & r = plasticState(ph)%state(1:sizeDotState,en) &
- subState0 & - state0 &
- dotState * Delta_t - dotState * Delta_t
plasticState(ph)%state(1:sizeDotState,en) = plasticState(ph)%state(1:sizeDotState,en) - r 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 !> @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(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: subState0 real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: & integer, intent(in) :: &
ph, & 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 if (any(IEEE_is_NaN(dotState))) return
sizeDotState = plasticState(ph)%sizeDotState sizeDotState = plasticState(ph)%sizeDotState
#ifndef __INTEL_LLVM_COMPILER plasticState(ph)%state(1:sizeDotState,en) = state0 + dotState*Delta_t
plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState*Delta_t
#else
plasticState(ph)%state(1:sizeDotState,en) = IEEE_FMA(dotState,Delta_t,subState0)
#endif
broken = plastic_deltaState(ph,en) broken = plastic_deltaState(ph,en)
if (broken) return if (broken) return
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en) broken = integrateStress(F,Fp0,Fi0,Delta_t,ph,en)
end function integrateStateEuler end function integrateStateEuler
@ -690,10 +706,10 @@ end function integrateStateEuler
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief integrate stress, state with 1st order Euler method with adaptive step size !> @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(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: subState0 real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: & integer, intent(in) :: &
ph, & ph, &
@ -716,16 +732,12 @@ function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en
sizeDotState = plasticState(ph)%sizeDotState sizeDotState = plasticState(ph)%sizeDotState
r = - dotState * 0.5_pREAL * Delta_t r = - dotState * 0.5_pREAL * Delta_t
#ifndef __INTEL_LLVM_COMPILER plasticState(ph)%state(1:sizeDotState,en) = state0 + dotState*Delta_t
plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState*Delta_t
#else
plasticState(ph)%state(1:sizeDotState,en) = IEEE_FMA(dotState,Delta_t,subState0)
#endif
broken = plastic_deltaState(ph,en) broken = plastic_deltaState(ph,en)
if (broken) return if (broken) return
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en) broken = integrateStress(F,Fp0,Fi0,Delta_t,ph,en)
if (broken) return if (broken) return
dotState = plastic_dotState(Delta_t,ph,en) 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 !> @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(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: subState0 real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en integer, intent(in) :: ph, en
logical :: broken 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) 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 end function integrateStateRK4
@ -769,10 +781,10 @@ end function integrateStateRK4
!--------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------
!> @brief Integrate state (including stress integration) with the Cash-Carp method !> @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(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: subState0 real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en integer, intent(in) :: ph, en
logical :: broken 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] 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 end function integrateStateRKCK45
@ -805,10 +817,10 @@ end function integrateStateRKCK45
!> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an !> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an
!! embedded explicit Runge-Kutta method !! 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(3,3) :: F_0,F,Fp0,Fi0
real(pREAL), intent(in),dimension(:) :: subState0 real(pREAL), intent(in),dimension(:) :: state0
real(pREAL), intent(in) :: Delta_t real(pREAL), intent(in) :: Delta_t
real(pREAL), dimension(:,:), intent(in) :: A real(pREAL), dimension(:,:), intent(in) :: A
real(pREAL), dimension(:), intent(in) :: B, C 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) dotState = A(1,stage) * plastic_RKdotState(1:sizeDotState,1)
do n = 2, stage do n = 2, stage
#ifndef __INTEL_LLVM_COMPILER
dotState = dotState + A(n,stage)*plastic_RKdotState(1:sizeDotState,n) 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 end do
#ifndef __INTEL_LLVM_COMPILER plasticState(ph)%state(1:sizeDotState,en) = state0 + dotState*Delta_t
plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState*Delta_t
#else
plasticState(ph)%state(1:sizeDotState,en) = IEEE_FMA(dotState,Delta_t,subState0)
#endif
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 if (broken) exit
dotState = plastic_dotState(Delta_t*C(stage), ph,en) 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 plastic_RKdotState(1:sizeDotState,size(B)) = dotState
dotState = matmul(plastic_RKdotState,B) dotState = matmul(plastic_RKdotState,B)
#ifndef __INTEL_LLVM_COMPILER plasticState(ph)%state(1:sizeDotState,en) = state0 + dotState*Delta_t
plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState*Delta_t
#else
plasticState(ph)%state(1:sizeDotState,en) = IEEE_FMA(dotState,Delta_t,subState0)
#endif
if (present(DB)) & if (present(DB)) &
broken = .not. converged(matmul(plastic_RKdotState(1:sizeDotState,1:size(DB)),DB) * Delta_t, & 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) broken = plastic_deltaState(ph,en)
if (broken) return if (broken) return
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en) broken = integrateStress(F,Fp0,Fi0,Delta_t,ph,en)
end function integrateStateRK end function integrateStateRK
@ -993,75 +993,75 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
logical :: converged_ logical :: converged_
real(pREAL) :: & real(pREAL) :: &
formerSubStep formerStep
integer :: & integer :: &
ph, en, sizeDotState ph, en, sizeDotState
logical :: todo logical :: todo
real(pREAL) :: subFrac,subStep real(pREAL) :: stepFrac,step
real(pREAL), dimension(3,3) :: & real(pREAL), dimension(3,3) :: &
subFp0, & Fp0, &
subFi0, & Fi0, &
subLp0, & Lp0, &
subLi0, & Li0, &
subF0, & F0, &
subF F
real(pREAL), dimension(plasticState(material_ID_phase(co,ce))%sizeState) :: subState0 real(pREAL), dimension(plasticState(material_ID_phase(co,ce))%sizeState) :: state0
ph = material_ID_phase(co,ce) ph = material_ID_phase(co,ce)
en = material_entry_phase(co,ce) en = material_entry_phase(co,ce)
subState0 = plasticState(ph)%state0(:,en) state0 = plasticState(ph)%state0(:,en)
subLi0 = phase_mechanical_Li0(ph)%data(1:3,1:3,en) Li0 = phase_mechanical_Li0(ph)%data(1:3,1:3,en)
subLp0 = phase_mechanical_Lp0(ph)%data(1:3,1:3,en) Lp0 = phase_mechanical_Lp0(ph)%data(1:3,1:3,en)
subFp0 = phase_mechanical_Fp0(ph)%data(1:3,1:3,en) Fp0 = phase_mechanical_Fp0(ph)%data(1:3,1:3,en)
subFi0 = phase_mechanical_Fi0(ph)%data(1:3,1:3,en) Fi0 = phase_mechanical_Fi0(ph)%data(1:3,1:3,en)
subF0 = phase_mechanical_F0(ph)%data(1:3,1:3,en) F0 = phase_mechanical_F0(ph)%data(1:3,1:3,en)
subFrac = 0.0_pREAL stepFrac = 0.0_pREAL
todo = .true. todo = .true.
subStep = 1.0_pREAL/num%subStepSizeCryst step = 1.0_pREAL/num%stepSizeCryst
converged_ = .false. ! pretend failed step of 1/subStepSizeCryst converged_ = .false. ! pretend failed step of 1/stepSizeCryst
todo = .true. todo = .true.
cutbackLooping: do while (todo) cutbackLooping: do while (todo)
if (converged_) then if (converged_) then
formerSubStep = subStep formerStep = step
subFrac = subFrac + subStep stepFrac = stepFrac + step
subStep = min(1.0_pREAL - subFrac, num%stepIncreaseCryst * subStep) 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 if (todo) then
subF0 = subF F0 = F
subLp0 = phase_mechanical_Lp(ph)%data(1:3,1:3,en) Lp0 = phase_mechanical_Lp(ph)%data(1:3,1:3,en)
subLi0 = phase_mechanical_Li(ph)%data(1:3,1:3,en) Li0 = phase_mechanical_Li(ph)%data(1:3,1:3,en)
subFp0 = phase_mechanical_Fp(ph)%data(1:3,1:3,en) Fp0 = phase_mechanical_Fp(ph)%data(1:3,1:3,en)
subFi0 = phase_mechanical_Fi(ph)%data(1:3,1:3,en) Fi0 = phase_mechanical_Fi(ph)%data(1:3,1:3,en)
subState0 = plasticState(ph)%state(:,en) state0 = plasticState(ph)%state(:,en)
end if end if
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! cut back (reduced time and restore) ! cut back (reduced time and restore)
else else
subStep = num%subStepSizeCryst * subStep step = num%stepSizeCryst * step
phase_mechanical_Fp(ph)%data(1:3,1:3,en) = subFp0 phase_mechanical_Fp(ph)%data(1:3,1:3,en) = Fp0
phase_mechanical_Fi(ph)%data(1:3,1:3,en) = subFi0 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) 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 if (step < 1.0_pREAL) then ! actual (not initial) cutback
phase_mechanical_Lp(ph)%data(1:3,1:3,en) = subLp0 phase_mechanical_Lp(ph)%data(1:3,1:3,en) = Lp0
phase_mechanical_Li(ph)%data(1:3,1:3,en) = subLi0 phase_mechanical_Li(ph)%data(1:3,1:3,en) = Li0
end if end if
plasticState(ph)%state(:,en) = subState0 plasticState(ph)%state(:,en) = state0
todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) todo = step > num%stepMinCryst ! still on track or already done (beyond repair)
end if end if
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! prepare for integration ! prepare for integration
if (todo) then if (todo) then
sizeDotState = plasticState(ph)%sizeDotState sizeDotState = plasticState(ph)%sizeDotState
subF = subF0 & F = F0 &
+ subStep * (phase_mechanical_F(ph)%data(1:3,1:3,en) - phase_mechanical_F0(ph)%data(1:3,1:3,en)) + step * (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) converged_ = .not. integrateState(F0,F,Fp0,Fi0,state0(1:sizeDotState),step * Delta_t,ph,en)
end if end if
end do cutbackLooping end do cutbackLooping
@ -1154,18 +1154,12 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
else else
lhs_3333 = 0.0_pREAL; rhs_3333 = 0.0_pREAL lhs_3333 = 0.0_pREAL; rhs_3333 = 0.0_pREAL
do o=1,3; do p=1,3 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) & 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 + 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) & lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) &
+ invFi*invFi(p,o) + invFi*invFi(p,o)
rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & 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 - 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 end do; end do
call math_invert(temp_99,error,math_3333to99(lhs_3333)) call math_invert(temp_99,error,math_3333to99(lhs_3333))
if (error) then 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) & 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)) + matmul(temp_33_3,dLidS(1:3,1:3,p,o))
end do; end do end do; end do
#ifndef __INTEL_LLVM_COMPILER
lhs_3333 = math_mul3333xx3333(dSdFe,temp_3333) * Delta_t & lhs_3333 = math_mul3333xx3333(dSdFe,temp_3333) * Delta_t &
+ math_mul3333xx3333(dSdFi,dFidS) + 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)) call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333))
if (error) then if (error) then

71
src/phase_mechanical_eigen.f90
View File

@ -3,15 +3,7 @@ submodule(phase:mechanical) eigen
integer, dimension(:), allocatable :: & integer, dimension(:), allocatable :: &
Nmodels Nmodels
integer(kind(EIGEN_UNDEFINED_ID)), dimension(:,:), allocatable :: &
model
integer(kind(EIGEN_UNDEFINED_ID)), dimension(:), allocatable :: &
model_damage
interface 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) module function thermalexpansion_init(kinematics_length) result(myKinematics)
integer, intent(in) :: kinematics_length integer, intent(in) :: kinematics_length
@ -60,17 +52,12 @@ module subroutine eigen_init(phases)
Nmodels(ph) = kinematics%length Nmodels(ph) = kinematics%length
end do 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 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 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 end subroutine eigen_init
@ -108,34 +95,6 @@ function kinematics_active(kinematics_label,kinematics_length) result(active_ki
end function kinematics_active 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 !> @brief contains the constitutive equation for calculating the velocity gradient
! ToDo: MD: S is Mi? ! ToDo: MD: S is Mi?
@ -173,17 +132,9 @@ module subroutine phase_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
dLi_dFi = 0.0_pREAL 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) KinematicsLoop: do k = 1, Nmodels(ph)
kinematicsType: select case (model(k,ph)) kinematicsType: select case (mechanical_eigen_kinematics_type(k,ph))
case (EIGEN_thermal_expansion_ID) kinematicsType case (MECHANICAL_EIGEN_THERMALEXPANSION) kinematicsType
call thermalexpansion_LiAndItsTangent(my_Li, my_dLi_dS, ph,en) call thermalexpansion_LiAndItsTangent(my_Li, my_dLi_dS, ph,en)
Li = Li + my_Li Li = Li + my_Li
dLi_dS = dLi_dS + my_dLi_dS dLi_dS = dLi_dS + my_dLi_dS
@ -191,13 +142,21 @@ module subroutine phase_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
end select kinematicsType end select kinematicsType
end do KinematicsLoop end do KinematicsLoop
select case (model_damage(ph)) plasticType: select case (mechanical_plasticity_type(ph))
case (EIGEN_cleavage_opening_ID) 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) call damage_anisobrittle_LiAndItsTangent(my_Li, my_dLi_dS, S, ph, en)
Li = Li + my_Li Li = Li + my_Li
dLi_dS = dLi_dS + my_dLi_dS dLi_dS = dLi_dS + my_dLi_dS
active = .true. active = .true.
end select end select damageType
if (.not. active) return 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 integer, intent(in) :: kinematics_length
logical, dimension(:,:), allocatable :: myKinematics logical, dimension(:,:), allocatable :: myKinematics
integer :: Ninstances, p, k integer :: p, k
type(tList), pointer :: & type(tList), pointer :: &
kinematics kinematics
type(tDict), pointer :: & type(tDict), pointer :: &
@ -37,15 +37,13 @@ module function thermalexpansion_init(kinematics_length) result(myKinematics)
myKinematics = kinematics_active('thermalexpansion',kinematics_length) myKinematics = kinematics_active('thermalexpansion',kinematics_length)
Ninstances = count(myKinematics) if (count(myKinematics) == 0) return
print'(/,a,i2)', ' # phases: ',Ninstances; flush(IO_STDOUT)
if (Ninstances == 0) return
print'(/,1x,a)', '<<<+- phase:mechanical:eigen:thermalexpansion init -+>>>' 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') phases => config_material%get_dict('phase')
allocate(param(Ninstances)) allocate(param(count(myKinematics)))
allocate(kinematics_thermal_expansion_instance(phases%length), source=0) allocate(kinematics_thermal_expansion_instance(phases%length), source=0)
do p = 1, phases%length do p = 1, phases%length
@ -92,7 +90,7 @@ module subroutine thermalexpansion_LiAndItsTangent(Li, dLi_dTstar, ph,me)
Alpha = 0.0_pREAL Alpha = 0.0_pREAL
Alpha(1,1) = prm%Alpha_11%at(T) Alpha(1,1) = prm%Alpha_11%at(T)
if (any(phase_lattice(ph) == ['hP','tI'])) Alpha(3,3) = prm%Alpha_33%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 Li = dot_T * Alpha
end associate 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 init -+>>>'
print'(/,1x,a)', '<<<+- phase:mechanical:elastic:Hooke 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)) allocate(param(phases%length))
@ -43,7 +43,7 @@ module subroutine elastic_init(phases)
phase => phases%get_dict(ph) phase => phases%get_dict(ph)
mech => phase%get_dict('mechanical') mech => phase%get_dict('mechanical')
elastic => mech%get_dict('elastic') 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) refs = config_listReferences(elastic,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs if (len(refs) > 0) print'(/,1x,a)', refs
if (elastic%get_asStr('type') /= 'Hooke') call IO_error(200,ext_msg=elastic%get_asStr('type')) 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) 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 end associate
@ -119,7 +119,7 @@ pure module function elastic_mu(ph,en,isotropic_bound) result(mu)
associate(prm => param(ph)) 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 end associate
@ -141,7 +141,7 @@ pure module function elastic_nu(ph,en,isotropic_bound) result(nu)
associate(prm => param(ph)) 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 end associate
@ -199,8 +199,8 @@ module function phase_homogenizedC66(ph,en) result(C)
integer, intent(in) :: ph, en integer, intent(in) :: ph, en
plasticType: select case (phase_plasticity(ph)) plasticType: select case (mechanical_plasticity_type(ph))
case (PLASTIC_DISLOTWIN_ID) plasticType case (MECHANICAL_PLASTICITY_DISLOTWIN) plasticType
C = plastic_dislotwin_homogenizedC(ph,en) C = plastic_dislotwin_homogenizedC(ph,en)
case default plasticType case default plasticType
C = elastic_C66(ph,en) C = elastic_C66(ph,en)

68
src/phase_mechanical_plastic.f90
View File

@ -211,17 +211,17 @@ contains
module subroutine plastic_init 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_none_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_NONE
where(plastic_isotropic_init()) phase_plasticity = PLASTIC_ISOTROPIC_ID where(plastic_isotropic_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_ISOTROPIC
where(plastic_phenopowerlaw_init()) phase_plasticity = PLASTIC_PHENOPOWERLAW_ID where(plastic_phenopowerlaw_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_PHENOPOWERLAW
where(plastic_kinehardening_init()) phase_plasticity = PLASTIC_KINEHARDENING_ID where(plastic_kinehardening_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_KINEHARDENING
where(plastic_dislotwin_init()) phase_plasticity = PLASTIC_DISLOTWIN_ID where(plastic_dislotwin_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_DISLOTWIN
where(plastic_dislotungsten_init()) phase_plasticity = PLASTIC_DISLOTUNGSTEN_ID where(plastic_dislotungsten_init()) mechanical_plasticity_type = MECHANICAL_PLASTICITY_DISLOTUNGSTEN
where(plastic_nonlocal_init()) phase_plasticity = PLASTIC_NONLOCAL_ID 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 end subroutine plastic_init
@ -251,7 +251,7 @@ module subroutine plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
i, j i, j
if (phase_plasticity(ph) == PLASTIC_NONE_ID) then if (mechanical_plasticity_type(ph) == MECHANICAL_PLASTICITY_NONE) then
Lp = 0.0_pREAL Lp = 0.0_pREAL
dLp_dFi = 0.0_pREAL dLp_dFi = 0.0_pREAL
dLp_dS = 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) 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) 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) 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) 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) 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) 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) call dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
end select plasticType end select plasticType
@ -308,28 +308,28 @@ module function plastic_dotState(subdt,ph,en) result(dotState)
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)),& 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)) 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) dotState = isotropic_dotState(Mp,ph,en)
case (PLASTIC_PHENOPOWERLAW_ID) plasticType case (MECHANICAL_PLASTICITY_PHENOPOWERLAW) plasticType
dotState = phenopowerlaw_dotState(Mp,ph,en) dotState = phenopowerlaw_dotState(Mp,ph,en)
case (PLASTIC_KINEHARDENING_ID) plasticType case (MECHANICAL_PLASTICITY_KINEHARDENING) plasticType
dotState = plastic_kinehardening_dotState(Mp,ph,en) dotState = plastic_kinehardening_dotState(Mp,ph,en)
case (PLASTIC_DISLOTWIN_ID) plasticType case (MECHANICAL_PLASTICITY_DISLOTWIN) plasticType
dotState = dislotwin_dotState(Mp,ph,en) dotState = dislotwin_dotState(Mp,ph,en)
case (PLASTIC_DISLOTUNGSTEN_ID) plasticType case (MECHANICAL_PLASTICITY_DISLOTUNGSTEN) plasticType
dotState = dislotungsten_dotState(Mp,ph,en) dotState = dislotungsten_dotState(Mp,ph,en)
case (PLASTIC_NONLOCAL_ID) plasticType case (MECHANICAL_PLASTICITY_NONLOCAL) plasticType
call nonlocal_dotState(Mp,subdt,ph,en) call nonlocal_dotState(Mp,subdt,ph,en)
dotState = plasticState(ph)%dotState(:,en) dotState = plasticState(ph)%dotState(:,en)
@ -349,15 +349,15 @@ module subroutine plastic_dependentState(ph,en)
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) call dislotwin_dependentState(ph,en)
case (PLASTIC_DISLOTUNGSTEN_ID) plasticType case (MECHANICAL_PLASTICITY_DISLOTUNGSTEN) plasticType
call dislotungsten_dependentState(ph,en) call dislotungsten_dependentState(ph,en)
case (PLASTIC_NONLOCAL_ID) plasticType case (MECHANICAL_PLASTICITY_NONLOCAL) plasticType
call nonlocal_dependentState(ph,en) call nonlocal_dependentState(ph,en)
end select plasticType end select plasticType
@ -384,19 +384,19 @@ module function plastic_deltaState(ph, en) result(broken)
broken = .false. broken = .false.
select case (phase_plasticity(ph)) select case (mechanical_plasticity_type(ph))
case (PLASTIC_NONLOCAL_ID,PLASTIC_KINEHARDENING_ID) case (MECHANICAL_PLASTICITY_NONLOCAL,MECHANICAL_PLASTICITY_KINEHARDENING)
Mp = matmul(matmul(transpose(phase_mechanical_Fi(ph)%data(1:3,1:3,en)),& 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_Fi(ph)%data(1:3,1:3,en)),&
phase_mechanical_S(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) call plastic_kinehardening_deltaState(Mp,ph,en)
case (PLASTIC_NONLOCAL_ID) plasticType case (MECHANICAL_PLASTICITY_NONLOCAL) plasticType
call plastic_nonlocal_deltaState(Mp,ph,en) call plastic_nonlocal_deltaState(Mp,ph,en)
end select plasticType end select plasticType

162
src/phase_mechanical_plastic_dislotungsten.f90
View File

@ -92,8 +92,9 @@ module function plastic_dislotungsten_init() result(myPlasticity)
real(pREAL),dimension(:), allocatable :: & real(pREAL),dimension(:), allocatable :: &
f_edge, & !< edge character fraction of total dislocation density f_edge, & !< edge character fraction of total dislocation density
rho_mob_0, & !< initial dislocation density rho_mob_0, & !< initial dislocation density
rho_dip_0, & !< initial dipole density rho_dip_0 !< initial dipole density
a !< non-Schmid coefficients real(pREAL), dimension(:,:), allocatable :: &
a_nS !< non-Schmid coefficients
character(len=:), allocatable :: & character(len=:), allocatable :: &
refs, & refs, &
extmsg extmsg
@ -108,11 +109,11 @@ module function plastic_dislotungsten_init() result(myPlasticity)
if (count(myPlasticity) == 0) return if (count(myPlasticity) == 0) return
print'(/,1x,a)', '<<<+- phase:mechanical:plastic:dislotungsten init -+>>>' 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)', '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)', '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') phases => config_material%get_dict('phase')
allocate(param(phases%length)) allocate(param(phases%length))
@ -149,16 +150,18 @@ module function plastic_dislotungsten_init() result(myPlasticity)
N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray) N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray)
prm%sum_N_sl = sum(abs(N_sl)) prm%sum_N_sl = sum(abs(N_sl))
slipActive: if (prm%sum_N_sl > 0) then slipActive: if (prm%sum_N_sl > 0) then
prm%systems_sl = lattice_labels_slip(N_sl,phase_lattice(ph)) prm%systems_sl = crystal_labels_slip(N_sl,phase_lattice(ph))
prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph)) prm%P_sl = crystal_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph))
if (phase_lattice(ph) == 'cI') then if (phase_lattice(ph) == 'cI') then
a = pl%get_as1dReal('a_nonSchmid',defaultVal = emptyRealArray) allocate(a_nS(3,size(pl%get_as1dReal('a_nonSchmid_110',defaultVal=emptyRealArray))))
prm%P_nS_pos = lattice_nonSchmidMatrix(N_sl,a,+1) a_nS(1,:) = pl%get_as1dReal('a_nonSchmid_110',defaultVal=emptyRealArray)
prm%P_nS_neg = lattice_nonSchmidMatrix(N_sl,a,-1) 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 else
prm%P_nS_pos = prm%P_sl prm%P_nS_pos = +prm%P_sl
prm%P_nS_neg = prm%P_sl prm%P_nS_neg = -prm%P_sl
end if end if
prm%dipoleformation = .not. pl%get_asBool('no_dipole_formation', defaultVal=.false.) 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%d_caron = prm%b_sl * pl%get_asReal('D_a')
prm%f_at = prm%b_sl**3*pl%get_asReal('f_at') 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)) phase_lattice(ph))
prm%forestProjection = spread( f_edge,1,prm%sum_N_sl) & 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) & + 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 ! sanity checks
if ( prm%D_0 < 0.0_pREAL) extmsg = trim(extmsg)//' D_0' if ( prm%D_0 < 0.0_pREAL) extmsg = trim(extmsg)//' D_0'
@ -291,8 +294,7 @@ pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, &
real(pREAL) :: & real(pREAL) :: &
T !< temperature T !< temperature
real(pREAL), dimension(param(ph)%sum_N_sl) :: & real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos,dot_gamma_neg, & dot_gamma, ddot_gamma_dtau
ddot_gamma_dtau_pos,ddot_gamma_dtau_neg
T = thermal_T(ph,en) T = thermal_T(ph,en)
@ -301,13 +303,14 @@ pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, &
associate(prm => param(ph)) 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 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) & 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) & 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(i) * prm%P_sl(k,l,i) &
+ ddot_gamma_dtau_neg(i) * prm%P_sl(k,l,i) * prm%P_nS_neg(m,n,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 do
end associate end associate
@ -329,52 +332,50 @@ module function dislotungsten_dotState(Mp,ph,en) result(dotState)
dotState dotState
real(pREAL), dimension(param(ph)%sum_N_sl) :: & real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos, dot_gamma_neg,& tau_eff, &
tau_pos,&
tau_neg, &
v_cl, & v_cl, &
dot_rho_dip_formation, & dot_rho_dip_formation, &
dot_rho_dip_climb, & dot_rho_dip_climb, &
d_hat d_hat
real(pREAL) :: & real(pREAL) :: &
mu, T mu, nu, T
associate(prm => param(ph), stt => state(ph), dst => dependentState(ph), & 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_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_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) mu = elastic_mu(ph,en,prm%isotropic_bound)
nu = elastic_nu(ph,en,prm%isotropic_bound)
T = thermal_T(ph,en) T = thermal_T(ph,en)
call kinetics(Mp,T,ph,en,& call kinetics(Mp,T,ph,en,&
dot_gamma_pos,dot_gamma_neg, & dot_gamma, tau = tau_eff)
tau_pos_out = tau_pos,tau_neg_out = tau_neg)
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_formation = 0.0_pREAL
dot_rho_dip_climb = 0.0_pREAL dot_rho_dip_climb = 0.0_pREAL
else where 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), & d_hat = math_clip(mu*prm%b_sl/(8.0_pREAL*PI*(1.0_pREAL-nu)*tau_eff), &
prm%d_caron, & ! lower limit left = prm%d_caron, & ! lower limit
dst%Lambda_sl(:,en)) ! upper limit right = 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, & 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, & 0.0_pREAL, &
prm%dipoleformation) 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)) * (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? 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 end where
dot_rho_mob = dot_gamma_sl/(prm%b_sl*dst%Lambda_sl(:,en)) & ! multiplication dot_rho_mob = dot_gamma / (prm%b_sl*dst%Lambda_sl(:,en)) & ! multiplication
- dot_rho_dip_formation & - 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_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 & 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 end associate
@ -457,7 +458,7 @@ end subroutine plastic_dislotungsten_result
! at the end since some of them are optional. ! at the end since some of them are optional.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure subroutine kinetics(Mp,T,ph,en, & 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 Mp !< Mandel stress
@ -467,41 +468,34 @@ pure subroutine kinetics(Mp,T,ph,en, &
ph, & ph, &
en en
real(pREAL), intent(out), dimension(param(ph)%sum_N_sl) :: & real(pREAL), dimension(param(ph)%sum_N_sl), intent(out) :: &
dot_gamma_pos, & dot_gamma
dot_gamma_neg real(pREAL), dimension(param(ph)%sum_N_sl), optional, intent(out) :: &
real(pREAL), intent(out), optional, dimension(param(ph)%sum_N_sl) :: & ddot_gamma_dtau, &
ddot_gamma_dtau_pos, & tau
ddot_gamma_dtau_neg, &
tau_pos_out, &
tau_neg_out
real(pREAL), dimension(param(ph)%sum_N_sl) :: & real(pREAL), dimension(param(ph)%sum_N_sl) :: &
StressRatio, & StressRatio, &
StressRatio_p,StressRatio_pminus1, & StressRatio_p,StressRatio_pminus1, &
dvel, &
tau_pos, tau_neg, tau_eff, & tau_pos, tau_neg, tau_eff, &
t_n,t_k, dtk,dtn t_n,t_k, dtk,dtn
integer :: j integer :: i
associate(prm => param(ph), stt => state(ph), dst => dependentState(ph)) associate(prm => param(ph), stt => state(ph), dst => dependentState(ph))
do j = 1, prm%sum_N_sl tau_pos = [(math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,i)),i=1,prm%sum_N_sl)]
tau_pos(j) = math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,j)) tau_neg = [(math_tensordot(Mp,prm%P_nS_neg(1:3,1:3,i)),i=1,prm%sum_N_sl)]
tau_neg(j) = math_tensordot(Mp,prm%P_nS_neg(1:3,1:3,j)) tau_eff = math_clip(max(tau_pos,tau_neg) - dst%tau_pass(:,en),left = 0.0_pREAL)
end do
if (present(tau_pos_out)) tau_pos_out = tau_pos if (present(tau)) tau = tau_eff
if (present(tau_neg_out)) tau_neg_out = tau_neg
associate(BoltzmannRatio => prm%Q_s/(K_B*T), & 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) 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 = tau_eff/prm%tau_Peierls
StressRatio_p = StressRatio** prm%p StressRatio_p = StressRatio** prm%p
StressRatio_pminus1 = StressRatio**(prm%p-1.0_pREAL) StressRatio_pminus1 = StressRatio**(prm%p-1.0_pREAL)
@ -510,53 +504,21 @@ pure subroutine kinetics(Mp,T,ph,en, &
/ (prm%omega*effectiveLength) / (prm%omega*effectiveLength)
t_k = effectiveLength * prm%B /(2.0_pREAL*prm%b_sl*tau_eff) ! corrected eq. (14) 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) dot_gamma = b_rho * prm%h/(t_n + t_k) * merge(+1.0_pREAL,-1.0_pREAL, tau_pos>tau_neg)
else where significantPositiveTau else where
dot_gamma_pos = 0.0_pREAL dot_gamma = 0.0_pREAL
end where significantPositiveTau end where
if (present(ddot_gamma_dtau_pos)) then if (present(ddot_gamma_dtau)) then
significantPositiveTau2: where(abs(tau_pos)-dst%tau_pass(:,en) > tol_math_check) 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) & 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 * 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 = -1.0_pREAL * dot_gamma * (dtn + dtk) / (t_n + t_k)
else where
ddot_gamma_dtau_pos = b_rho_half * dvel ddot_gamma_dtau = 0.0_pREAL
else where significantPositiveTau2 end where
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
end if end if
end associate end associate

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