diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ca1b2959a..5aef9c54c 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -95,7 +95,7 @@ checkout: - release ################################################################################################### -Pytest_python: +pytest_python: stage: python script: - cd $DAMASKROOT/python @@ -252,7 +252,7 @@ setup_mesh: - release ################################################################################################### -Pytest_grid: +pytest_fortran: stage: grid script: - module load $IntelCompiler $MPI_Intel $PETSc_Intel @@ -287,14 +287,6 @@ J2_plasticBehavior: - master - release -Marc_elementLib: - stage: marc - script: - - module load $IntelMarc $HDF5Marc $MSC - - Marc_elementLib/test.py - except: - - master - - release ################################################################################################### SpectralRuntime: diff --git a/.gitmodules b/.gitmodules index 0587fff4c..c415745bc 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,5 +1,5 @@ [submodule "PRIVATE"] - path = PRIVATE + path = PRIVATE url = ../PRIVATE.git branch = master - shallow = true + shallow = true diff --git a/DAMASK_prerequisites.sh b/DAMASK_prerequisites.sh index 25a2e46e0..181fd46b5 100755 --- a/DAMASK_prerequisites.sh +++ b/DAMASK_prerequisites.sh @@ -84,7 +84,7 @@ for executable in python python3; do done secondLevel "Details on $DEFAULT_PYTHON:" echo $(ls -la $(which $DEFAULT_PYTHON)) -for module in numpy scipy pandas;do +for module in numpy scipy pandas matplotlib yaml h5py;do thirdLevel $module $DEFAULT_PYTHON -c "import $module; \ print('Version: {}'.format($module.__version__)); \ @@ -94,10 +94,6 @@ thirdLevel vtk $DEFAULT_PYTHON -c "import vtk; \ print('Version: {}'.format(vtk.vtkVersion.GetVTKVersion())); \ print('Location: {}'.format(vtk.__file__))" -thirdLevel h5py -$DEFAULT_PYTHON -c "import h5py; \ - print('Version: {}'.format(h5py.version.version)); \ - print('Location: {}'.format(h5py.__file__))" firstLevel "GNU Compiler Collection" for executable in gcc g++ gfortran ;do diff --git a/LICENSE b/LICENSE index 3ffc3b9e3..4290d15bd 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2011-20 Max-Planck-Institut für Eisenforschung GmbH +Copyright 2011-21 Max-Planck-Institut für Eisenforschung GmbH DAMASK is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/PRIVATE b/PRIVATE index 45ef93dbf..13dfa0ee9 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 45ef93dbfa3e0e6fa830914b3632e188c308a099 +Subproject commit 13dfa0ee9d702782f0b7999f3f7fb2384f58d768 diff --git a/VERSION b/VERSION index 62c706093..bbcfb4711 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-173-g584c7cc3a +v3.0.0-alpha2-602-ge2d4ab427 diff --git a/env/CONFIG b/env/CONFIG index 52057526a..4407f4d2b 100644 --- a/env/CONFIG +++ b/env/CONFIG @@ -1,5 +1,5 @@ # "set"-syntax needed only for tcsh (but works with bash and zsh) -set DAMASK_NUM_THREADS = 4 +set OMP_NUM_THREADS = 4 -set MSC_ROOT = /opt/msc -set MSC_VERSION = 2020 +set MSC_ROOT = /opt/msc +set MSC_VERSION = 2020 diff --git a/env/DAMASK.csh b/env/DAMASK.csh deleted file mode 100644 index cc61449d2..000000000 --- a/env/DAMASK.csh +++ /dev/null @@ -1,54 +0,0 @@ -# sets up an environment for DAMASK on tcsh -# usage: source DAMASK_env.csh - -set CALLED=($_) -set ENV_ROOT=`dirname $CALLED[2]` -set DAMASK_ROOT=`python3 -c "import os,sys; print(os.path.realpath(os.path.expanduser(sys.argv[1])))" $ENV_ROOT"/../"` - -source $ENV_ROOT/CONFIG - -set path = ($DAMASK_ROOT/bin $path) - -set SOLVER=`which DAMASK_grid` -if ( "x$DAMASK_NUM_THREADS" == "x" ) then - set DAMASK_NUM_THREADS=1 -endif - -# currently, there is no information that unlimited stack size causes problems -# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it -# more info https://jblevins.org/log/segfault -# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap -# http://superuser.com/questions/220059/what-parameters-has-ulimit -limit stacksize unlimited # maximum stack size (kB) - -# disable output in case of scp -if ( $?prompt ) then - echo '' - echo Düsseldorf Advanced Materials Simulation Kit --- DAMASK - echo Max-Planck-Institut für Eisenforschung GmbH, Düsseldorf - echo https://damask.mpie.de - echo - echo Using environment with ... - echo "DAMASK $DAMASK_ROOT" - echo "Grid Solver $SOLVER" - if ( $?PETSC_DIR) then - echo "PETSc location $PETSC_DIR" - endif - if ( $?MSC_ROOT) then - echo "MSC.Marc/Mentat $MSC_ROOT" - endif - echo - echo "Multithreading DAMASK_NUM_THREADS=$DAMASK_NUM_THREADS" - echo `limit datasize` - echo `limit stacksize` - echo -endif - -setenv DAMASK_NUM_THREADS $DAMASK_NUM_THREADS -if ( ! $?PYTHONPATH ) then - setenv PYTHONPATH $DAMASK_ROOT/python -else - setenv PYTHONPATH $DAMASK_ROOT/python:$PYTHONPATH -endif -setenv MSC_ROOT -setenv MSC_VERSION diff --git a/env/DAMASK.sh b/env/DAMASK.sh index 2151e842b..f8ccfc1e0 100644 --- a/env/DAMASK.sh +++ b/env/DAMASK.sh @@ -38,7 +38,7 @@ PATH=${DAMASK_ROOT}/bin:$PATH SOLVER=$(type -p DAMASK_grid || true 2>/dev/null) [ "x$SOLVER" == "x" ] && SOLVER=$(blink 'Not found!') -[ "x$DAMASK_NUM_THREADS" == "x" ] && DAMASK_NUM_THREADS=1 +[ "x$OMP_NUM_THREADS" == "x" ] && OMP_NUM_THREADS=1 # currently, there is no information that unlimited stack size causes problems # still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it @@ -66,7 +66,7 @@ if [ ! -z "$PS1" ]; then echo -n "MSC.Marc/Mentat " [ -d $MSC_ROOT ] && echo $MSC_ROOT || blink $MSC_ROOT echo - echo "Multithreading DAMASK_NUM_THREADS=$DAMASK_NUM_THREADS" + echo "Multithreading OMP_NUM_THREADS=$OMP_NUM_THREADS" echo -n "heap size " [[ "$(ulimit -d)" == "unlimited" ]] \ && echo "unlimited" \ @@ -86,11 +86,13 @@ if [ ! -z "$PS1" ]; then echo fi -export DAMASK_NUM_THREADS +export OMP_NUM_THREADS +export MSC_ROOT +export MSC_VERSION +export DAMASK_ROOT export PYTHONPATH=$DAMASK_ROOT/python:$PYTHONPATH for var in BASE STAT SOLVER BRANCH; do unset "${var}" done unset "ENV_ROOT" -unset "DAMASK_ROOT" diff --git a/env/DAMASK.zsh b/env/DAMASK.zsh index 377aa5304..2c74657fd 100644 --- a/env/DAMASK.zsh +++ b/env/DAMASK.zsh @@ -30,7 +30,7 @@ PATH=${DAMASK_ROOT}/bin:$PATH SOLVER=$(which DAMASK_grid || true 2>/dev/null) [[ "x$SOLVER" == "x" ]] && SOLVER=$(blink 'Not found!') -[[ "x$DAMASK_NUM_THREADS" == "x" ]] && DAMASK_NUM_THREADS=1 +[[ "x$OMP_NUM_THREADS" == "x" ]] && OMP_NUM_THREADS=1 # currently, there is no information that unlimited stack size causes problems # still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it @@ -60,7 +60,7 @@ if [ ! -z "$PS1" ]; then echo -n "MSC.Marc/Mentat " [ -d $MSC_ROOT ] && echo $MSC_ROOT || blink $MSC_ROOT echo - echo "Multithreading DAMASK_NUM_THREADS=$DAMASK_NUM_THREADS" + echo "Multithreading OMP_NUM_THREADS=$OMP_NUM_THREADS" echo -n "heap size " [[ "$(ulimit -d)" == "unlimited" ]] \ && echo "unlimited" \ @@ -80,11 +80,13 @@ if [ ! -z "$PS1" ]; then echo fi -export DAMASK_NUM_THREADS +export OMP_NUM_THREADS +export MSC_ROOT +export MSC_VERSION +export DAMASK_ROOT export PYTHONPATH=$DAMASK_ROOT/python:$PYTHONPATH for var in SOLVER BRANCH; do unset "${var}" done unset "ENV_ROOT" -unset "DAMASK_ROOT" diff --git a/examples/ConfigFiles/Homogenization_multiField.config b/examples/ConfigFiles/Homogenization_multiField.config deleted file mode 100644 index 7dd63cc73..000000000 --- a/examples/ConfigFiles/Homogenization_multiField.config +++ /dev/null @@ -1,8 +0,0 @@ -[SX] -type isostrain -Ngrains 1 -{./Homogenization_Damage_NonLocal.config} -{./Homogenization_Thermal_Conduction.config} -{./Homogenization_VacancyFlux_CahnHilliard.config} -{./Homogenization_Porosity_PhaseField.config} -{./Homogenization_HydrogenFlux_CahnHilliard.config} diff --git a/examples/ConfigFiles/Microstructure_DP_Steel.config b/examples/ConfigFiles/Microstructure_DP_Steel.config deleted file mode 100644 index 6c083e2c7..000000000 --- a/examples/ConfigFiles/Microstructure_DP_Steel.config +++ /dev/null @@ -1,4 +0,0 @@ -[DP_Steel] -crystallite 1 -(constituent) phase 1 texture 1 fraction 0.82 -(constituent) phase 2 texture 2 fraction 0.18 diff --git a/examples/ConfigFiles/Phase_Dislotwin_TWIP-Steel-FeMnC.config b/examples/ConfigFiles/Phase_Dislotwin_TWIP-Steel-FeMnC.config deleted file mode 100644 index 3ca635d73..000000000 --- a/examples/ConfigFiles/Phase_Dislotwin_TWIP-Steel-FeMnC.config +++ /dev/null @@ -1,64 +0,0 @@ -[TWIP_Steel_FeMnC] - -elasticity hooke -plasticity dislotwin - -(output) rho_mob -(output) rho_dip -(output) gamma_sl -(output) lambda_sl -(output) tau_pass -(output) f_tw -(output) lambda_tw -(output) tau_hat_tw -(output) f_tr - - -### Material parameters ### -lattice_structure fcc -C11 175.0e9 # From Music et al. Applied Physics Letters 91, 191904 (2007) -C12 115.0e9 -C44 135.0e9 -grainsize 2.0e-5 # Average grain size [m] -SolidSolutionStrength 1.5e8 # Strength due to elements in solid solution - -### Dislocation glide parameters ### -Nslip 12 -slipburgers 2.56e-10 # Burgers vector of slip system [m] -rhoedgedip0 1.0 # Initial dislocation density [m/m**3] -rhoedge0 1.0e12 # Initial dislocation density [m/m**3] -v0 1.0e-4 # Initial glide velocity [m/s] -Qedge 3.7e-19 # Activation energy for dislocation glide [J] -p_slip 1.0 # p-exponent in glide velocity -q_slip 1.0 # q-exponent in glide velocity - -# hardening of glide -CLambdaSlip 10.0 # Adj. parameter controlling dislocation mean free path -D0 4.0e-5 # Vacancy diffusion prefactor [m**2/s] -Qsd 4.5e-19 # Activation energy for climb [J] -Catomicvolume 1.0 # Adj. parameter controlling the atomic volume [in b^3] -Cedgedipmindistance 1.0 # Adj. parameter controlling the minimum dipole distance [in b] -interactionSlipSlip 0.122 0.122 0.625 0.07 0.137 0.122 # Interaction coefficients (Kubin et al. 2008) - -### Shearband parameters ### -shearbandresistance 180e6 -shearbandvelocity 0e-4 # set to zero to turn shear banding of -QedgePerSbSystem 3.7e-19 # Activation energy for shear banding [J] -p_shearband 1.0 # p-exponent in glide velocity -q_shearband 1.0 # q-exponent in glide velocity - -### Twinning parameters ### -Ntwin 12 -twinburgers 1.47e-10 # Burgers vector of twin system [m] -twinsize 5.0e-8 # Twin stack mean thickness [m] -L0_twin 442.0 # Length of twin nuclei in Burgers vectors -maxtwinfraction 1.0 # Maximum admissible twin volume fraction -xc_twin 1.0e-9 # critical distance for formation of twin nucleus -VcrossSlip 1.67e-29 # cross slip volume -r_twin 10.0 # r-exponent in twin formation probability -Cmfptwin 1.0 # Adj. parameter controlling twin mean free path -Cthresholdtwin 1.0 # Adj. parameter controlling twin threshold stress -interactionSlipTwin 0.0 1.0 1.0 # Dislocation-Twin interaction coefficients -interactionTwinTwin 0.0 1.0 # Twin-Twin interaction coefficients -SFE_0K -0.0396 # stacking fault energy at zero K; TWIP steel: -0.0526; Cu: -0.0396 -dSFE_dT 0.0002 # temperature dependance of stacking fault energy diff --git a/examples/ConfigFiles/Phase_Dislotwin_TWIP-Steel-FeMnC.yaml b/examples/ConfigFiles/Phase_Dislotwin_TWIP-Steel-FeMnC.yaml new file mode 100644 index 000000000..009443284 --- /dev/null +++ b/examples/ConfigFiles/Phase_Dislotwin_TWIP-Steel-FeMnC.yaml @@ -0,0 +1,41 @@ +TWIP_Steel_FeMnC: + lattice: cF + mechanics: + elasticity: {type: hooke, C_11: 175.0e9, C_12: 115.0e9, C_44: 135.0e9} + plasticity: + type: dislotwin + output: [rho_mob, rho_dip, gamma_sl, Lambda_sl, tau_pass, f_tw, Lambda_tw, tau_hat_tw, f_tr] + D: 2.0e-5 + N_sl: [12] + b_sl: [2.56e-10] + rho_mob_0: [1.0e12] + rho_dip_0: [1.0] + v_0: [1.0e4] + Q_s: [3.7e-19] + p_sl: [1.0] + q_sl: [1.0] + tau_0: [1.5e8] + i_sl: [10.0] # Adj. parameter controlling dislocation mean free path + D_0: 4.0e-5 # Vacancy diffusion prefactor / m^2/s + D_a: 1.0 # minimum dipole distance / b + Q_cl: 4.5e-19 # Activation energy for climb / J + h_sl_sl: [0.122, 0.122, 0.625, 0.07, 0.137, 0.122] # Interaction coefficients (Kubin et al. 2008) +# shear band parameters + xi_sb: 180.0e6 + Q_sb: 3.7e-19 + p_sb: 1.0 + q_sb: 1.0 + v_sb: 0.0 # set to 0, to turn it off +# twinning parameters + N_tw: [12] + b_tw: [1.47e-10] # Burgers vector length of twin system / b + t_tw: [5.0e-8] # Twin stack mean thickness / m + L_tw: 442.0 # Length of twin nuclei / b + x_c_tw: 1.0e-9 # critical distance for formation of twin nucleus / m + V_cs: 1.67e-29 # cross slip volume / m^3 + p_tw: [10.0] # r-exponent in twin formation probability + i_tw: 1.0 # Adj. parameter controlling twin mean free path + h_sl_tw: [0.0, 1.0, 1.0] # dislocation-twin interaction coefficients + h_tw_tw: [0.0, 1.0] # twin-twin interaction coefficients + Gamma_sf_0K: -0.0396 # stacking fault energy / J/m^2 at zero K; TWIP steel: -0.0526; Cu: -0.0396 + dGamma_sf_dT: 0.0002 # temperature dependence / J/(m^2 K) of stacking fault energy diff --git a/examples/ConfigFiles/Phase_Dislotwin_Tungsten.config b/examples/ConfigFiles/Phase_Dislotwin_Tungsten.config deleted file mode 100644 index 30c04cb9a..000000000 --- a/examples/ConfigFiles/Phase_Dislotwin_Tungsten.config +++ /dev/null @@ -1,36 +0,0 @@ -[Tungsten] - -elasticity hooke -plasticity dislotwin - -### Material parameters ### -lattice_structure bcc -C11 523.0e9 # From Marinica et al. Journal of Physics: Condensed Matter(2013) -C12 202.0e9 -C44 161.0e9 - -grainsize 2.0e-5 # Average grain size [m] -SolidSolutionStrength 1.5e8 # Strength due to elements in solid solution - -### Dislocation glide parameters ### -#per family -Nslip 12 -slipburgers 2.72e-10 # Burgers vector of slip system [m] -rhoedge0 1.0e12 # Initial edge dislocation density [m/m**3] -rhoedgedip0 1.0 # Initial edged dipole dislocation density [m/m**3] -v0 1.0e-4 # Initial glide velocity [m/s] -Qedge 2.725e-19 # Activation energy for dislocation glide [J] -p_slip 0.78 # p-exponent in glide velocity -q_slip 1.58 # q-exponent in glide velocity -tau_peierls 2.03e9 # peierls stress (for bcc) -dipoleformationfactor 0 # to have hardening due to dipole formation off - -#hardening -CLambdaSlip 10.0 # Adj. parameter controlling dislocation mean free path -D0 4.0e-5 # Vacancy diffusion prefactor [m**2/s] -Qsd 4.5e-19 # Activation energy for climb [J] -Catomicvolume 1.0 # Adj. parameter controlling the atomic volume [in b] -Cedgedipmindistance 1.0 # Adj. parameter controlling the minimum dipole distance [in b] -interaction_slipslip 1 1 1.4 1.4 1.4 1.4 - - diff --git a/examples/ConfigFiles/Phase_Dislotwin_Tungsten.yaml b/examples/ConfigFiles/Phase_Dislotwin_Tungsten.yaml new file mode 100644 index 000000000..36467192b --- /dev/null +++ b/examples/ConfigFiles/Phase_Dislotwin_Tungsten.yaml @@ -0,0 +1,21 @@ +Tungsten: + lattice: cI + mechanics: + elasticity: {type: hooke, C_11: 523.0e9, C_12: 202.0e9, C_44: 161.0e9} # Marinica et al. Journal of Physics: Condensed Matter(2013) + plasticity: + type: dislotwin + D: 2.0e-5 # Average grain size / m + N_sl: [12] + b_sl: [2.72e-10] # Burgers vector length of slip families / m + rho_mob_0: [1.0e12] + rho_dip_0: [1.0] + v_0: [1.0e4] # Initial glide velocity / m/s + Q_s: [2.725e-19] # Activation energy for dislocation glide / J + p_sl: [0.78] # p-exponent in glide velocity + q_sl: [1.58] # q-exponent in glide velocity + tau_0: [1.5e8] # solid solution strength / Pa + i_sl: [10.0] # Adj. parameter controlling dislocation mean free path + D_0: 4.0e-5 # Vacancy diffusion prefactor / m^2/s + D_a: 1.0 # minimum dipole distance / b + Q_cl: 4.5e-19 # Activation energy for climb / J + h_sl_sl: [1, 1, 1.4, 1.4, 1.4, 1.4] diff --git a/examples/ConfigFiles/Phase_Hydrogen.config b/examples/ConfigFiles/Phase_Hydrogen.config deleted file mode 100644 index c9ccfdc86..000000000 --- a/examples/ConfigFiles/Phase_Hydrogen.config +++ /dev/null @@ -1,3 +0,0 @@ -hydrogenflux_diffusion11 1.0 -hydrogenflux_mobility11 1.0 -hydrogenVolume 1e-28 diff --git a/examples/ConfigFiles/Phase_Isotropic_AluminumIsotropic.yaml b/examples/ConfigFiles/Phase_Isotropic_AluminumIsotropic.yaml index 7b05140cb..02e2d9a28 100644 --- a/examples/ConfigFiles/Phase_Isotropic_AluminumIsotropic.yaml +++ b/examples/ConfigFiles/Phase_Isotropic_AluminumIsotropic.yaml @@ -1,9 +1,9 @@ # Kuo, J. C., Mikrostrukturmechanik von Bikristallen mit Kippkorngrenzen. Shaker-Verlag 2004. http://edoc.mpg.de/204079 Aluminum: + lattice: aP mechanics: - lattice: aP - elasticity: {C_11: 110.9e9, C_12: 58.34e9, type: hooke} - output: [F, P, Fe, Fp, Lp] + output: [F, P, F_e, F_p, L_p] + elasticity: {type: hooke, C_11: 110.9e9, C_12: 58.34e9} plasticity: type: isotropic output: [xi] diff --git a/examples/ConfigFiles/Phase_Isotropic_FreeSurface.yaml b/examples/ConfigFiles/Phase_Isotropic_FreeSurface.yaml index 4d9690f44..90f88d679 100644 --- a/examples/ConfigFiles/Phase_Isotropic_FreeSurface.yaml +++ b/examples/ConfigFiles/Phase_Isotropic_FreeSurface.yaml @@ -1,9 +1,8 @@ -# Maiti and Eisenlohr 2018 Scripta Materialia Air: + lattice: aP mechanics: - lattice: aP - elasticity: {C_11: 10e9, C_12: 0.0, type: hooke} - output: [F, P, Fe, Fp, Lp] + output: [F, P, F_e, F_p, L_p] + elasticity: {type: hooke, C_11: 1e8, C_12: 1e6} plasticity: type: isotropic output: [xi] @@ -14,4 +13,4 @@ Air: M: 3 h_0: 1e6 a: 2 - dilatation: true + dilatation: True diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_Aluminum.config b/examples/ConfigFiles/Phase_Phenopowerlaw_Aluminum.config deleted file mode 100644 index 72421a640..000000000 --- a/examples/ConfigFiles/Phase_Phenopowerlaw_Aluminum.config +++ /dev/null @@ -1,21 +0,0 @@ -[Aluminum] -elasticity hooke -plasticity phenopowerlaw - -(output) resistance_slip -(output) accumulatedshear_slip - -lattice_structure fcc -Nslip 12 # per family - -c11 106.75e9 -c12 60.41e9 -c44 28.34e9 - -gdot0_slip 0.001 -n_slip 20 -tau0_slip 31e6 # per family -tausat_slip 63e6 # per family -a_slip 2.25 -h0_slipslip 75e6 -interaction_slipslip 1 1 1.4 1.4 1.4 1.4 diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_Aluminum.yaml b/examples/ConfigFiles/Phase_Phenopowerlaw_Aluminum.yaml new file mode 100644 index 000000000..1c15206b7 --- /dev/null +++ b/examples/ConfigFiles/Phase_Phenopowerlaw_Aluminum.yaml @@ -0,0 +1,16 @@ +Aluminum: + lattice: cF + mechanics: + output: [F, P, F_e, F_p, L_p, O] + elasticity: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: hooke} + plasticity: + N_sl: [12] + a_sl: 2.25 + dot_gamma_0_sl: 0.001 + h_0_sl_sl: 75e6 + h_sl_sl: [1, 1, 1.4, 1.4, 1.4, 1.4] + n_sl: 20 + output: [xi_sl, gamma_sl] + type: phenopowerlaw + xi_0_sl: [31e6] + xi_inf_sl: [63e6] diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Ferrite.yaml b/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Ferrite.yaml index ce3bbadb7..7cb84eb4f 100644 --- a/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Ferrite.yaml +++ b/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Ferrite.yaml @@ -2,8 +2,8 @@ # Tasan et.al. 2015 International Journal of Plasticity # Diehl et.al. 2015 Meccanica Ferrite: + lattice: cI mechanics: - lattice: cI elasticity: {C_11: 233.3e9, C_12: 135.5e9, C_44: 118.0e9, type: hooke} plasticity: N_sl: [12, 12] diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.yaml b/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.yaml index ab79ceeb1..3a5becc57 100644 --- a/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.yaml +++ b/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.yaml @@ -2,8 +2,8 @@ # Tasan et.al. 2015 International Journal of Plasticity # Diehl et.al. 2015 Meccanica Martensite: + lattice: cI mechanics: - lattice: cI elasticity: {C_11: 417.4e9, C_12: 242.4e9, C_44: 211.1e9, type: hooke} plasticity: N_sl: [12, 12] diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_Gold.config b/examples/ConfigFiles/Phase_Phenopowerlaw_Gold.config deleted file mode 100644 index c7fc670ac..000000000 --- a/examples/ConfigFiles/Phase_Phenopowerlaw_Gold.config +++ /dev/null @@ -1,27 +0,0 @@ -# parameters fitted by D. Ma to: -# I. Kovács, G. Vörös -# On the mathematical description of the tensile stress-strain curves of polycrystalline face centered cubic metals -# International Journal of Plasticity, Volume 12, Issue 1, 1996, Pages 35–43 -# DOI: 10.1016/S0749-6419(95)00043-7 - -[gold_phenopowerlaw] -elasticity hooke -plasticity phenopowerlaw - -(output) resistance_slip - -lattice_structure fcc -Nslip 12 # per family - -c11 191.0e9 -c12 162.0e9 -c44 42.20e9 - -gdot0_slip 0.001 -n_slip 83.3 -tau0_slip 26.25e6 # per family -tausat_slip 53.00e6 # per family -a_slip 1.0 -h0_slipslip 75e6 -interaction_slipslip 1 1 1.4 1.4 1.4 1.4 - diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_Gold.yaml b/examples/ConfigFiles/Phase_Phenopowerlaw_Gold.yaml new file mode 100644 index 000000000..f84b2eb05 --- /dev/null +++ b/examples/ConfigFiles/Phase_Phenopowerlaw_Gold.yaml @@ -0,0 +1,21 @@ +# parameters fitted by D. Ma to: +# On the mathematical description of the tensile stress-strain curves of polycrystalline face centered cubic metals +# International Journal of Plasticity, Volume 12, Issue 1, 1996, Pages 35-43 +# DOI: 10.1016/S0749-6419(95)00043-7 + +Gold: + lattice: cF + mechanics: + output: [F, P, F_e, F_p, L_p, O] + elasticity: {type: hooke, C_11: 191e9, C_12: 162e9, C_44: 42.2e9} + plasticity: + type: phenopowerlaw + output: [xi_sl] + N_sl: [12] + n_sl: 83 + dot_gamma_0_sl: 0.001 + h_0_sl_sl: 75e6 + h_sl_sl: [1, 1, 1.4, 1.4, 1.4, 1.4] + a_sl: 1.0 + xi_0_sl: [26e6] + xi_inf_sl: [53e6] diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_Magnesium.config b/examples/ConfigFiles/Phase_Phenopowerlaw_Magnesium.config deleted file mode 100644 index 4647a868f..000000000 --- a/examples/ConfigFiles/Phase_Phenopowerlaw_Magnesium.config +++ /dev/null @@ -1,56 +0,0 @@ -#-------------------# - -#-------------------# -/echo/ -[Mg] -plasticity phenopowerlaw -elasticity hooke - -(output) resistance_slip -(output) resistance_twin - -lattice_structure hex -c/a 1.62350 # from Tromans 2011, Elastic Anisotropy of HCP Metal Crystals and Polycrystals -c11 59.3e9 # - " - -c33 61.5e9 # - " - -c44 16.4e9 # - " - -c12 25.7e9 # - " - -c13 21.4e9 # - " - - -# basal prism prism pyr(a) pyr(c+a) pyr(c+a) -Nslip 3 3 0 6 0 6 # from Agnew et al 2006, Validating a polycrystal model for the elastoplastic response of mg alloy AZ32 using in situ neutron diffraction -# T1 C1 T2 C2 -Ntwin 6 0 0 6 # - " - -# basal prism prism pyr(a) pyr(c+a) pyr(c+a) -tau0_slip 10.0e6 55.0e6 0 60.0e6 0.0 60.0e6 # - " - table 1, pyr(a) set to pyr(c+a) -tausat_slip 40.0e6 135.0e6 0 150.0e6 0.0 150.0e6 # - " - table 1, pyr(a) set to pyr(c+a) -# T1 C1 T2 C2 -tau0_twin 40e6 0.0 0.0 60.0e6 # - " - table 1, compressive twin guessed by Steffi, tensile twin modified to match experimental results - -h0_twintwin 50.0e6 # - " - table 1, same range as theta_0 -h0_slipslip 500.0e6 # - " - table 1, same range as theta_0 -h0_twinslip 150.0e6 # guessing - -interaction_slipslip 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 # just guessing -interaction_twintwin 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 # - " - -interaction_sliptwin 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 # - " - -interaction_twinslip 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 # - " - - - - -#################################################### -# open for discussion -#################################################### -n_twin 20 -n_slip 20 - -gdot0_twin 0.001 -gdot0_slip 0.001 - -twin_b 0 -twin_c 0 -twin_d 20 -twin_e 20 - -a_slip 2.25 -s_pr 10.0 # push-up factor for slip saturation due to twinning diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_Magnesium.yaml b/examples/ConfigFiles/Phase_Phenopowerlaw_Magnesium.yaml new file mode 100644 index 000000000..7ae4699e0 --- /dev/null +++ b/examples/ConfigFiles/Phase_Phenopowerlaw_Magnesium.yaml @@ -0,0 +1,31 @@ +# Tromans 2011, Elastic Anisotropy of HCP Metal Crystals and Polycrystals +Magnesium: + lattice: hP + c/a: 1.62350 + mechanics: + output: [F, P, F_e, F_p, L_p, O] + elasticity: {C_11: 59.3e9, C_12: 25.7e9, C_13: 21.4e9, C_33: 61.5e9, C_44: 16.4e9, type: hooke} + plasticity: + N_sl: [3, 3, 0, 6, 0, 6] + N_tw: [6, 0, 0, 6] + h_0_tw_tw: 50.0e6 + h_0_sl_sl: 500.0e6 + h_0_tw_sl: 150.0e6 + h_sl_sl: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1] + h_tw_tw: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1] + h_sl_tw: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1] + h_tw_sl: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1] + output: [xi_sl, xi_tw] + type: phenopowerlaw + xi_0_sl: [10.0e6, 55.0e6, 0, 60.0e6, 0.0, 60.0e6] + xi_inf_sl: [40.0e6, 135.0e6, 0, 150.0e6, 0.0, 150.0e6] + xi_0_tw: [40e6, 0.0, 0.0, 60.0e6] +#################################################### +# open for discussion +#################################################### + a_sl: 2.25 + dot_gamma_0_sl: 0.001 + dot_gamma_0_tw: 0.001 + n_sl: 20 + n_tw: 20 + f_sl_sat_tw: 10.0 diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_cpTi-alpha.config b/examples/ConfigFiles/Phase_Phenopowerlaw_cpTi-alpha.config deleted file mode 100644 index 93d45def7..000000000 --- a/examples/ConfigFiles/Phase_Phenopowerlaw_cpTi-alpha.config +++ /dev/null @@ -1,23 +0,0 @@ -[cpTi-alpha] -plasticity phenopowerlaw -elasticity hooke - -lattice_structure hex -covera_ratio 1.587 - -# M. Levy, Handbook of Elastic Properties of Solids, Liquids, and Gases (2001) -c11 160.0e9 -c12 90.0e9 -c13 66.0e9 -c33 181.7e9 -c44 46.5e9 -# C. Zambaldi, "Orientation informed nanoindentation of a-titanium: Indentation pileup in hexagonal metals deforming by prismatic slip", J. Mater. Res., Vol. 27, No. 1, Jan 14, 2012 -gdot0_slip 0.001 -n_slip 20 -nslip 3 3 0 6 -tau0_slip 349.3e6 150e6 0 1107.9e6 -tausat_slip 568.6e6 1502.2e6 0 3420.1e6 -a_slip 2 -h0_slipslip 15e6 - -interaction_slipslip 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_cpTi.yaml b/examples/ConfigFiles/Phase_Phenopowerlaw_cpTi.yaml new file mode 100644 index 000000000..aa5262454 --- /dev/null +++ b/examples/ConfigFiles/Phase_Phenopowerlaw_cpTi.yaml @@ -0,0 +1,20 @@ +# M. Levy, Handbook of Elastic Properties of Solids, Liquids, and Gases (2001) +# C. Zambaldi, "Orientation informed nanoindentation of a-titanium: Indentation pileup in hexagonal metals deforming by prismatic slip", J. Mater. Res., Vol. 27, No. 1, Jan 14, 2012 +# Better use values from L. Wang, Z. Zheng, H. Phukan, P. Kenesei, J.-S. Park, J. Lind, R.M. Suter, T.R. Bieler, Direct measurement of critical resolved shear stress of prismatic and basal slip in polycrystalline Ti using high energy X-ray diffraction microscopy, Acta Mater 2017 +cpTi: + lattice: hP + c/a: 1.587 + mechanics: + output: [F, P, F_e, F_p, L_p, O] + elasticity: {C_11: 160.0e9, C_12: 90.0e9, C_13: 66.0e9, C_33: 181.7e9, C_44: 46.5e9, type: hooke} + plasticity: + N_sl: [3, 3, 0, 6, 12] + a_sl: 2.0 + dot_gamma_0_sl: 0.001 + h_0_sl_sl: 200e6 + h_sl_sl: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1] + n_sl: 20 + output: [gamma_sl] + type: phenopowerlaw + xi_0_sl: [0.15e9, 0.09e9, 0, 0.20e9, 0.25e9] + xi_inf_sl: [0.24e9, 0.5e9, 0, 0.6e9, 0.8e9] diff --git a/examples/ConfigFiles/Texture_Gauss_001.config b/examples/ConfigFiles/Texture_Gauss_001.config deleted file mode 100644 index 4fb519f08..000000000 --- a/examples/ConfigFiles/Texture_Gauss_001.config +++ /dev/null @@ -1,2 +0,0 @@ -[001] -(gauss) phi1 0.000 Phi 0.000 phi2 0.000 diff --git a/examples/ConfigFiles/Texture_Gauss_101.config b/examples/ConfigFiles/Texture_Gauss_101.config deleted file mode 100644 index c6c1b5dbe..000000000 --- a/examples/ConfigFiles/Texture_Gauss_101.config +++ /dev/null @@ -1,2 +0,0 @@ -[101] -(gauss) phi1 0.000 Phi 45.000 phi2 90.000 diff --git a/examples/ConfigFiles/Texture_Gauss_111.config b/examples/ConfigFiles/Texture_Gauss_111.config deleted file mode 100644 index 0d685a66e..000000000 --- a/examples/ConfigFiles/Texture_Gauss_111.config +++ /dev/null @@ -1,2 +0,0 @@ -[111] -(gauss) phi1 0.000 Phi 54.7356 phi2 45.000 diff --git a/examples/ConfigFiles/Texture_Gauss_123.config b/examples/ConfigFiles/Texture_Gauss_123.config deleted file mode 100644 index da4fa30ab..000000000 --- a/examples/ConfigFiles/Texture_Gauss_123.config +++ /dev/null @@ -1,2 +0,0 @@ -[123] -(gauss) phi1 209.805 Phi 29.206 phi2 63.435 diff --git a/examples/ConfigFiles/material.config b/examples/ConfigFiles/material.config deleted file mode 100644 index c863ca8a2..000000000 --- a/examples/ConfigFiles/material.config +++ /dev/null @@ -1,20 +0,0 @@ -# The material.config file needs to specify five parts: -# homogenization, microstructure, crystallite, phase, and texture. -# You can either put the full text in here or include suited separate files - - -{./Homogenization_Isostrain_SX.config} - - -[one_only] -crystallite 1 -(constituent) phase 1 texture 1 fraction 1.0 - - -{./Crystallite_All.config} - - -{./Phase_Phenopowerlaw_Aluminum.config} - - -{./Texture_Gauss_001.config} diff --git a/examples/SpectralMethod/Polycrystal/shearXY.yaml b/examples/SpectralMethod/Polycrystal/shearXY.yaml deleted file mode 100644 index 559bdfe56..000000000 --- a/examples/SpectralMethod/Polycrystal/shearXY.yaml +++ /dev/null @@ -1,9 +0,0 @@ -step: - - mechanics: - dot_F: [0, 0, 0, - 1e-3, 0, 0, - 0, 0, 0] - discretization: - t: 60 - N: 120 - f_out: 20 diff --git a/examples/SpectralMethod/Polycrystal/shearZX.yaml b/examples/SpectralMethod/Polycrystal/shearZX.yaml deleted file mode 100644 index df7b887e5..000000000 --- a/examples/SpectralMethod/Polycrystal/shearZX.yaml +++ /dev/null @@ -1,10 +0,0 @@ ---- -step: - - mechanics: - dot_F: [0, 0, 1e-3, - 0, 0, 0, - 0, 0, 0] - discretization: - t: 60 - N: 120 - f_out: 20 diff --git a/examples/SpectralMethod/Polycrystal/tensionX.yaml b/examples/SpectralMethod/Polycrystal/tensionX.yaml deleted file mode 100644 index 2f1d11f91..000000000 --- a/examples/SpectralMethod/Polycrystal/tensionX.yaml +++ /dev/null @@ -1,25 +0,0 @@ ---- - -step: - - mechanics: - dot_F: [1.0e-3, 0, 0, - 0, x, 0, - 0, 0, x] - P: [x, x, x, - x, 0, x, - x, x, 0] - discretization: - t: 10 - N: 40 - f_out: 4 - - mechanics: - dot_F: [1.0e-3, 0, 0, - 0, x, 0, - 0, 0, x] - P: [x, x, x, - x, 0, x, - x, x, 0] - discretization: - t: 60 - N: 60 - f_out: 4 diff --git a/examples/SpectralMethod/Polycrystal/20grains.seeds b/examples/grid/20grains.seeds similarity index 100% rename from examples/SpectralMethod/Polycrystal/20grains.seeds rename to examples/grid/20grains.seeds diff --git a/examples/SpectralMethod/Polycrystal/20grains16x16x16.vtr b/examples/grid/20grains16x16x16.vtr similarity index 100% rename from examples/SpectralMethod/Polycrystal/20grains16x16x16.vtr rename to examples/grid/20grains16x16x16.vtr diff --git a/examples/SpectralMethod/Polycrystal/20grains32x32x32.vtr b/examples/grid/20grains32x32x32.vtr similarity index 100% rename from examples/SpectralMethod/Polycrystal/20grains32x32x32.vtr rename to examples/grid/20grains32x32x32.vtr diff --git a/examples/SpectralMethod/Polycrystal/20grains64x64x64.vtr b/examples/grid/20grains64x64x64.vtr similarity index 100% rename from examples/SpectralMethod/Polycrystal/20grains64x64x64.vtr rename to examples/grid/20grains64x64x64.vtr diff --git a/examples/SpectralMethod/Polycrystal/material.yaml b/examples/grid/material.yaml similarity index 88% rename from examples/SpectralMethod/Polycrystal/material.yaml rename to examples/grid/material.yaml index b560a919d..09176d531 100644 --- a/examples/SpectralMethod/Polycrystal/material.yaml +++ b/examples/grid/material.yaml @@ -2,108 +2,108 @@ homogenization: SX: N_constituents: 1 - mechanics: {type: none} + mechanics: {type: pass} material: - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [1.0, 0.0, 0.0, 0.0] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.7936696712125002, -0.28765777461664166, -0.3436487135089419, 0.4113964260949434] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.3986143167493579, -0.7014883552495493, 0.2154871765709027, 0.5500781677772945] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.28645844315788244, -0.022571491243423537, -0.467933059311115, -0.8357456192708106] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.33012772942625784, -0.6781865350268957, 0.6494525351030648, 0.09638521992649676] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.43596817439583935, -0.5982537129781701, 0.046599032277502436, 0.6707106499919265] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.169734823419553, -0.699615227367322, -0.6059581215838098, -0.33844257746495854] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.9698864809294915, 0.1729052643205874, -0.15948307917616958, 0.06315956884687175] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.46205660912967883, 0.3105054068891252, -0.617849551030653, 0.555294529545738] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.4512443497461787, -0.7636045534540555, -0.04739348426715133, -0.45939142396805815] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.2161856212656443, -0.6581450184826598, -0.5498086209601588, 0.4667112513346289] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.8753220715350803, -0.4561599367657419, -0.13298279533852678, -0.08969369719975541] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.11908260752431069, 0.18266024809834172, -0.7144822594012615, -0.664807992845101] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.751104669484278, 0.5585633382623958, -0.34579336397009175, 0.06538900566860861] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.08740438971703973, 0.8991264096610437, -0.4156704205935976, 0.10559485570696363] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.5584325870096193, 0.6016408353068798, -0.14280340445801173, 0.5529814994483859] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.4052725440888093, 0.25253073423599154, 0.5693263597910454, -0.669215876471182] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.7570164606888676, 0.15265448024694664, -0.5998021466848317, 0.20942796551297105] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.6987659297138081, -0.132172211261028, -0.19693254724422338, 0.6748883269678543] - homogenization: SX constituents: - phase: Aluminum - fraction: 1.0 + v: 1.0 O: [0.7729330445886478, 0.21682179052722322, -0.5207379472917645, 0.2905078484066341] phase: diff --git a/examples/SpectralMethod/Polycrystal/numerics.yaml b/examples/grid/numerics.yaml similarity index 100% rename from examples/SpectralMethod/Polycrystal/numerics.yaml rename to examples/grid/numerics.yaml diff --git a/examples/grid/shearXY.yaml b/examples/grid/shearXY.yaml new file mode 100644 index 000000000..58471e8f1 --- /dev/null +++ b/examples/grid/shearXY.yaml @@ -0,0 +1,15 @@ +--- + +solver: + mechanical: spectral_basic + +loadstep: + - boundary_conditions: + mechanical: + dot_F: [0, 0, 0, + 1e-3, 0, 0, + 0, 0, 0] + discretization: + t: 60 + N: 120 + f_out: 20 diff --git a/examples/grid/shearZX.yaml b/examples/grid/shearZX.yaml new file mode 100644 index 000000000..a32fafb85 --- /dev/null +++ b/examples/grid/shearZX.yaml @@ -0,0 +1,15 @@ +--- + +solver: + mechanical: spectral_basic + +loadstep: + - boundary_conditions: + mechanical: + dot_F: [0, 0, 1e-3, + 0, 0, 0, + 0, 0, 0] + discretization: + t: 60 + N: 120 + f_out: 20 diff --git a/examples/grid/tensionX.yaml b/examples/grid/tensionX.yaml new file mode 100644 index 000000000..870755d58 --- /dev/null +++ b/examples/grid/tensionX.yaml @@ -0,0 +1,30 @@ +--- + +solver: + mechanical: spectral_basic + +loadstep: + - boundary_conditions: + mechanical: + dot_F: [1.0e-3, 0, 0, + 0, x, 0, + 0, 0, x] + P: [x, x, x, + x, 0, x, + x, x, 0] + discretization: + t: 10 + N: 40 + f_out: 4 + - boundary_conditions: + mechanical: + dot_F: [1.0e-3, 0, 0, + 0, x, 0, + 0, 0, x] + P: [x, x, x, + x, 0, x, + x, x, 0] + discretization: + t: 60 + N: 60 + f_out: 4 diff --git a/installation/mods_MarcMentat/apply_DAMASK_modifications.py b/installation/mods_MarcMentat/apply_DAMASK_modifications.py index 407c33558..1cd93c47c 100755 --- a/installation/mods_MarcMentat/apply_DAMASK_modifications.py +++ b/installation/mods_MarcMentat/apply_DAMASK_modifications.py @@ -5,13 +5,9 @@ import glob import argparse from pathlib import Path -import damask - -msc_version = float(damask.environment.options['MSC_VERSION']) -if int(msc_version) == msc_version: - msc_version = int(msc_version) -msc_root = Path(damask.environment.options['MSC_ROOT']) -damask_root = damask.environment.root_dir +msc_version = os.environ['MSC_VERSION'] +msc_root = Path(os.environ['MSC_ROOT']) +damask_root = Path(os.environ['DAMASK_ROOT']) parser = argparse.ArgumentParser( description='Apply DAMASK modification to MSC.Marc/Mentat', @@ -24,7 +20,7 @@ def copy_and_replace(in_file,dst): with open(in_file) as f: content = f.read() content = content.replace('%INSTALLDIR%',str(msc_root)) - content = content.replace('%VERSION%',str(msc_version)) + content = content.replace('%VERSION%', msc_version) content = content.replace('%EDITOR%', parser.parse_args().editor) with open(dst/Path(in_file).name,'w') as f: f.write(content) @@ -53,8 +49,8 @@ for in_file in glob.glob(str(src/'job_run.ms')): print('compiling Mentat menu binaries...') -executable = str(msc_root/f'mentat{msc_version}/bin/mentat') -menu_file = str(msc_root/f'mentat{msc_version}/menus/linux64/main.msb') +executable = msc_root/f'mentat{msc_version}/bin/mentat' +menu_file = msc_root/f'mentat{msc_version}/menus/linux64/main.msb' os.system(f'xvfb-run {executable} -compile {menu_file}') diff --git a/installation/symlink_Processing.py b/installation/symlink_Processing.py index c9cf6e32a..ef2274028 100755 --- a/installation/symlink_Processing.py +++ b/installation/symlink_Processing.py @@ -3,11 +3,9 @@ # Makes postprocessing routines accessible from everywhere. import sys from pathlib import Path +import os -import damask - -env = damask.Environment() -bin_dir = env.root_dir/Path('bin') +bin_dir = Path(os.environ['DAMASK_ROOT'])/'bin' if not bin_dir.exists(): bin_dir.mkdir() @@ -15,7 +13,7 @@ if not bin_dir.exists(): sys.stdout.write('\nsymbolic linking...\n') for sub_dir in ['pre','post']: - the_dir = env.root_dir/Path('processing')/Path(sub_dir) + the_dir = Path(os.environ['DAMASK_ROOT'])/'processing'/sub_dir for the_file in the_dir.glob('*.py'): src = the_dir/the_file diff --git a/processing/post/DADF5_postResults.py b/processing/post/DADF5_postResults.py index a1b162e3d..81babcc57 100755 --- a/processing/post/DADF5_postResults.py +++ b/processing/post/DADF5_postResults.py @@ -41,15 +41,15 @@ for filename in options.filenames: table = damask.Table(np.ones(np.product(results.cells),dtype=int)*int(inc[3:]),{'inc':(1,)})\ .add('pos',coords.reshape(-1,3)) - results.pick('homogenizations',False) - results.pick('phases',True) + results.view('homogenizations',False) + results.view('phases',True) for label in options.con: x = results.get_dataset_location(label) if len(x) != 0: table = table.add(label,results.read_dataset(x,0,plain=True).reshape(results.cells.prod(),-1)) - results.pick('phases',False) - results.pick('homogenizations',True) + results.view('phases',False) + results.view('homogenizations',True) for label in options.mat: x = results.get_dataset_location(label) if len(x) != 0: diff --git a/python/damask/__init__.py b/python/damask/__init__.py index fa1af9f4f..e356d0bc4 100644 --- a/python/damask/__init__.py +++ b/python/damask/__init__.py @@ -16,8 +16,6 @@ with open(_Path(__file__).parent/_Path('VERSION')) as _f: __version__ = version # make classes directly accessible as damask.Class -from ._environment import Environment as _ # noqa -environment = _() from . import util # noqa from . import seeds # noqa from . import tensor # noqa @@ -38,7 +36,6 @@ from ._result import Result # noqa # deprecated -Environment = _ from ._asciitable import ASCIItable # noqa from ._test import Test # noqa from .util import extendableOption # noqa diff --git a/python/damask/_colormap.py b/python/damask/_colormap.py index 5a22f049b..7e8860dae 100644 --- a/python/damask/_colormap.py +++ b/python/damask/_colormap.py @@ -223,25 +223,46 @@ class Colormap(mpl.colors.ListedColormap): return Colormap(np.array(rev.colors),rev.name[:-4] if rev.name.endswith('_r_r') else rev.name) + def _get_file_handle(self,fname,extension): + """ + Provide file handle. + + Parameters + ---------- + fname : file, str, pathlib.Path, or None + Filename or filehandle, will be name of the colormap+extension if None. + + extension: str + Extension of the filename. + + Returns + ------- + f + File handle + + """ + if fname is None: + fhandle = open(self.name.replace(' ','_')+'.'+extension,'w',newline='\n') + else: + try: + fhandle = open(fname,'w',newline='\n') + except TypeError: + fhandle = fname + + return fhandle + + def save_paraview(self,fname=None): """ Save as JSON file for use in Paraview. Parameters ---------- - fname : file, str, or pathlib.Path, optional. + fname : file, str, or pathlib.Path, optional Filename to store results. If not given, the filename will consist of the name of the colormap and extension '.json'. """ - if fname is None: - fhandle = None - else: - try: - fhandle = open(fname,'w') - except TypeError: - fhandle = fname - colors = [] for i,c in enumerate(np.round(self.colors,6).tolist()): colors+=[i]+c @@ -254,8 +275,7 @@ class Colormap(mpl.colors.ListedColormap): 'RGBPoints':colors }] - with open(self.name.replace(' ','_')+'.json', 'w') if fhandle is None else fhandle as f: - json.dump(out, f,indent=4) + json.dump(out,self._get_file_handle(fname,'json'),indent=4) def save_ASCII(self,fname=None): @@ -264,24 +284,14 @@ class Colormap(mpl.colors.ListedColormap): Parameters ---------- - fname : file, str, or pathlib.Path, optional. + fname : file, str, or pathlib.Path, optional Filename to store results. If not given, the filename will consist of the name of the colormap and extension '.txt'. """ - if fname is None: - fhandle = None - else: - try: - fhandle = open(fname,'w') - except TypeError: - fhandle = fname - labels = {'RGBA':4} if self.colors.shape[1] == 4 else {'RGB': 3} t = Table(self.colors,labels,f'Creator: {util.execution_stamp("Colormap")}') - - with open(self.name.replace(' ','_')+'.txt', 'w') if fhandle is None else fhandle as f: - t.save(f) + t.save(self._get_file_handle(fname,'txt')) def save_GOM(self,fname=None): @@ -290,26 +300,19 @@ class Colormap(mpl.colors.ListedColormap): Parameters ---------- - fname : file, str, or pathlib.Path, optional. + fname : file, str, or pathlib.Path, optional Filename to store results. If not given, the filename will consist of the name of the colormap and extension '.legend'. """ - if fname is None: - fhandle = None - else: - try: - fhandle = open(fname,'w') - except TypeError: - fhandle = fname # ToDo: test in GOM GOM_str = '1 1 {name} 9 {name} '.format(name=self.name.replace(" ","_")) \ + '0 1 0 3 0 0 -1 9 \\ 0 0 0 255 255 255 0 0 255 ' \ + f'30 NO_UNIT 1 1 64 64 64 255 1 0 0 0 0 0 0 3 0 {len(self.colors)}' \ + ' '.join([f' 0 {c[0]} {c[1]} {c[2]} 255 1' for c in reversed((self.colors*255).astype(int))]) \ + '\n' - with open(self.name.replace(' ','_')+'.legend', 'w') if fhandle is None else fhandle as f: - f.write(GOM_str) + + self._get_file_handle(fname,'legend').write(GOM_str) def save_gmsh(self,fname=None): @@ -318,24 +321,16 @@ class Colormap(mpl.colors.ListedColormap): Parameters ---------- - fname : file, str, or pathlib.Path, optional. + fname : file, str, or pathlib.Path, optional Filename to store results. If not given, the filename will consist of the name of the colormap and extension '.msh'. """ - if fname is None: - fhandle = None - else: - try: - fhandle = open(fname,'w') - except TypeError: - fhandle = fname # ToDo: test in gmsh gmsh_str = 'View.ColorTable = {\n' \ +'\n'.join([f'{c[0]},{c[1]},{c[2]},' for c in self.colors[:,:3]*255]) \ +'\n}\n' - with open(self.name.replace(' ','_')+'.msh', 'w') if fhandle is None else fhandle as f: - f.write(gmsh_str) + self._get_file_handle(fname,'msh').write(gmsh_str) @staticmethod diff --git a/python/damask/_config.py b/python/damask/_config.py index 76955588f..85f0c208c 100644 --- a/python/damask/_config.py +++ b/python/damask/_config.py @@ -1,4 +1,6 @@ +import copy from io import StringIO +from collections.abc import Iterable import abc import numpy as np @@ -35,6 +37,50 @@ class Config(dict): output.seek(0) return ''.join(output.readlines()) + + def __copy__(self): + """Create deep copy.""" + return copy.deepcopy(self) + + copy = __copy__ + + + def __or__(self,other): + """ + Update configuration with contents of other. + + Parameters + ---------- + other : damask.Config or dict + Key-value pairs that update self. + + """ + duplicate = self.copy() + duplicate.update(other) + return duplicate + + + def __ior__(self,other): + """Update configuration with contents of other.""" + return self.__or__(other) + + + def delete(self,keys): + """ + Remove configuration keys. + + Parameters + ---------- + keys : iterable or scalar + Label of the key(s) to remove. + + """ + duplicate = self.copy() + for k in keys if isinstance(keys, Iterable) and not isinstance(keys, str) else [keys]: + del duplicate[k] + return duplicate + + @classmethod def load(cls,fname): """ @@ -52,6 +98,7 @@ class Config(dict): fhandle = fname return cls(yaml.safe_load(fhandle)) + def save(self,fname,**kwargs): """ Save to yaml file. @@ -65,7 +112,7 @@ class Config(dict): """ try: - fhandle = open(fname,'w') + fhandle = open(fname,'w',newline='\n') except TypeError: fhandle = fname @@ -95,6 +142,7 @@ class Config(dict): """Check for completeness.""" pass + @property @abc.abstractmethod def is_valid(self): diff --git a/python/damask/_configmaterial.py b/python/damask/_configmaterial.py index e6c86f39c..d47526790 100644 --- a/python/damask/_configmaterial.py +++ b/python/damask/_configmaterial.py @@ -1,4 +1,3 @@ -import copy from os import path import numpy as np @@ -7,6 +6,7 @@ import h5py from . import Config from . import Rotation from . import Orientation +from . import util class ConfigMaterial(Config): """Material configuration.""" @@ -15,11 +15,10 @@ class ConfigMaterial(Config): 'homogenization': {}, 'phase': {}} - def __init__(self,d={}): + def __init__(self,d=_defaults): """Initialize object with default dictionary keys.""" super().__init__(d) - for k,v in self._defaults.items(): - if k not in self: self[k] = v + def save(self,fname='material.yaml',**kwargs): """ @@ -51,7 +50,7 @@ class ConfigMaterial(Config): @staticmethod - def from_table(table,constituents={},**kwargs): + def from_table(table,**kwargs): """ Load from an ASCII table. @@ -59,12 +58,9 @@ class ConfigMaterial(Config): ---------- table : damask.Table Table that contains material information. - constituents : dict, optional - Entries for 'constituents'. The key is the name and the value specifies - the label of the data column in the table **kwargs - Keyword arguments where the key is the name and the value specifies - the label of the data column in the table + Keyword arguments where the key is the name and the value specifies + the label of the data column in the table. Examples -------- @@ -75,32 +71,30 @@ class ConfigMaterial(Config): pos pos pos qu qu qu qu phase homog 0 0 0 0 0.19 0.8 0.24 -0.51 Aluminum SX 1 1 0 0 0.8 0.19 0.24 -0.51 Steel SX - >>> cm.from_table(t,{'O':'qu','phase':'phase'},homogenization='homog') + 1 1 1 0 0.8 0.19 0.24 -0.51 Steel SX + >>> cm.from_table(t,O='qu',phase='phase',homogenization='homog') material: - constituents: - O: [0.19, 0.8, 0.24, -0.51] - fraction: 1.0 + v: 1.0 phase: Aluminum homogenization: SX - constituents: - O: [0.8, 0.19, 0.24, -0.51] - fraction: 1.0 + v: 1.0 phase: Steel homogenization: SX homogenization: {} phase: {} """ - constituents_ = {k:table.get(v) for k,v in constituents.items()} kwargs_ = {k:table.get(v) for k,v in kwargs.items()} - _,idx = np.unique(np.hstack(list({**constituents_,**kwargs_}.values())),return_index=True,axis=0) - + _,idx = np.unique(np.hstack(list(kwargs_.values())),return_index=True,axis=0) idx = np.sort(idx) - constituents_ = {k:np.atleast_1d(v[idx].squeeze()) for k,v in constituents_.items()} - kwargs_ = {k:np.atleast_1d(v[idx].squeeze()) for k,v in kwargs_.items()} + kwargs_ = {k:np.atleast_1d(v[idx].squeeze()) for k,v in kwargs_.items()} - return ConfigMaterial().material_add(constituents_,**kwargs_) + return ConfigMaterial().material_add(**kwargs_) @staticmethod @@ -108,11 +102,11 @@ class ConfigMaterial(Config): r""" Load material data from DREAM3D file. - The parts of homogenization and phase need to be added by the user. + The parts of homogenization and phase need to be added by the user. Parameters ---------- - fname : str + fname : str path to the DREAM3D file. base_group : str Name of the group (folder) below 'DataContainers', @@ -126,7 +120,7 @@ class ConfigMaterial(Config): phase_id : str Name of the dataset containing phase IDs for each grain, for example 'Phases'. - phase_name : list + phase_name : list List with name of the phases. Examples @@ -135,25 +129,25 @@ class ConfigMaterial(Config): >>> import damask >>> import damask.ConfigMaterial as cm >>> cm.load_from_Dream3D('20grains16x16x16.dream3D','SyntheticVolumeDataContainer', 'Grain Data'\ - 'EulerAngles','Phases',['Ferrite']) + 'EulerAngles','Phases',['Ferrite']) for point based data with single phase >>> import damask >>> import damask.ConfigMaterial as cm >>> cm.load_from_Dream3D('20grains16x16x16.dream3D','SyntheticVolumeDataContainer', 'CellData'\ - 'EulerAngles','Phases',['Ferrite']) + 'EulerAngles','Phases',['Ferrite']) for grain based data with dual phase >>> import damask >>> import damask.ConfigMaterial as cm >>> cm.load_from_Dream3D('20grains16x16x16.dream3D','SyntheticVolumeDataContainer', 'Grain Data'\ - 'EulerAngles','Phases',['Ferrite','Martensite']) + 'EulerAngles','Phases',['Ferrite','Martensite']) for point based data with dual phase >>> import damask >>> import damask.ConfigMaterial as cm >>> cm.load_from_Dream3D('20grains16x16x16.dream3D','SyntheticVolumeDataContainer', 'CellData'\ - 'EulerAngles','Phases',['Ferrite','Martensite']) + 'EulerAngles','Phases',['Ferrite','Martensite']) """ root_dir = 'DataContainers' @@ -162,13 +156,13 @@ class ConfigMaterial(Config): config_info = ConfigMaterial() # empty yaml dictionary - orientation_path = path.join(root_dir,base_group,data_group,ori_data) + orientation_path = path.join(root_dir,base_group,data_group,ori_data) if hdf[orientation_path].attrs['TupleDimensions'].shape == (3,): grain_orientations = np.array(hdf[orientation_path]).reshape(cells.prod(),3,order='F') else: grain_orientations = np.array(hdf[orientation_path])[1:] - - grain_quats = Rotation.from_Euler_angles(grain_orientations).as_quaternion() + + grain_quats = Rotation.from_Euler_angles(grain_orientations).as_quaternion() phase_path = path.join(root_dir,base_group,data_group,phase_id) if hdf[phase_path].attrs['TupleDimensions'].shape == (3,): @@ -181,13 +175,12 @@ class ConfigMaterial(Config): material_dict = config_info.material_add(constituents={'phase':phase_name_list,'O':grain_quats},homogenization='SX') material_dict.save() - + @property def is_complete(self): """Check for completeness.""" ok = True for top_level in ['homogenization','phase','material']: - # ToDo: With python 3.8 as prerequisite we can shorten with := ok &= top_level in self if top_level not in self: print(f'{top_level} entry missing') @@ -238,7 +231,7 @@ class ConfigMaterial(Config): @property def is_valid(self): - """Check for valid file layout.""" + """Check for valid content.""" ok = True if 'phase' in self: @@ -247,25 +240,23 @@ class ConfigMaterial(Config): try: Orientation(lattice=v['lattice']) except KeyError: - s = v['lattice'] - print(f"Invalid lattice: '{s}' in phase '{k}'") + print(f"Invalid lattice '{v['lattice']}' in phase '{k}'") ok = False if 'material' in self: - for i,v in enumerate(self['material']): - if 'constituents' in v: - f = 0.0 - for c in v['constituents']: - f+= float(c['fraction']) + for i,m in enumerate(self['material']): + if 'constituents' in m: + v = 0.0 + for c in m['constituents']: + v += float(c['v']) if 'O' in c: try: Rotation.from_quaternion(c['O']) except ValueError: - o = c['O'] - print(f"Invalid orientation: '{o}' in material '{i}'") + print(f"Invalid orientation '{c['O']}' in material '{i}'") ok = False - if not np.isclose(f,1.0): - print(f"Invalid total fraction '{f}' in material '{i}'") + if not np.isclose(v,1.0): + print(f"Total fraction v = {v} ≠ 1 in material '{i}'") ok = False return ok @@ -284,10 +275,15 @@ class ConfigMaterial(Config): constituent: list of ints, optional Limit renaming to selected constituents. + Returns + ------- + cfg : damask.ConfigMaterial + Updated material configuration. + """ - dup = copy.deepcopy(self) + dup = self.copy() for i,m in enumerate(dup['material']): - if ID and i not in ID: continue + if ID is not None and i not in ID: continue for c in m['constituents']: if constituent is not None and c not in constituent: continue try: @@ -308,10 +304,15 @@ class ConfigMaterial(Config): ID: list of ints, optional Limit renaming to selected homogenization IDs. + Returns + ------- + cfg : damask.ConfigMaterial + Updated material configuration. + """ - dup = copy.deepcopy(self) + dup = self.copy() for i,m in enumerate(dup['material']): - if ID and i not in ID: continue + if ID is not None and i not in ID: continue try: m['homogenization'] = mapping[m['homogenization']] except KeyError: @@ -319,93 +320,92 @@ class ConfigMaterial(Config): return dup - def material_add(self,constituents=None,**kwargs): + def material_add(self,**kwargs): """ Add material entries. Parameters ---------- - constituents : dict, optional - Entries for 'constituents' as key-value pair. **kwargs Key-value pairs. + Returns + ------- + cfg : damask.ConfigMaterial + Updated material configuration. + Examples -------- + >>> import numpy as np >>> import damask - >>> O = damask.Rotation.from_random(3).as_quaternion() - >>> phase = ['Aluminum','Steel','Aluminum'] - >>> m = damask.ConfigMaterial().material_add(constituents={'phase':phase,'O':O}, - ... homogenization='SX') + >>> m = damask.ConfigMaterial().material_add(phase = ['Aluminum','Steel'], + ... O = damask.Rotation.from_random(2), + ... homogenization = 'SX') >>> m material: - constituents: - O: [0.577764, -0.146299, -0.617669, 0.513010] - fraction: 1.0 + v: 1.0 phase: Aluminum homogenization: SX - constituents: - O: [0.184176, 0.340305, 0.737247, 0.553840] - fraction: 1.0 + v: 1.0 phase: Steel homogenization: SX - - constituents: - - O: [0.0886257, -0.144848, 0.615674, -0.769487] - fraction: 1.0 - phase: Aluminum - homogenization: SX + homogenization: {} + phase: {} + + >>> m = damask.ConfigMaterial().material_add(phase = np.array(['Austenite','Martensite']).reshape(1,2), + ... O = damask.Rotation.from_random((2,2)), + ... v = np.array([0.2,0.8]).reshape(1,2), + ... homogenization = ['A','B']) + >>> m + material: + - constituents: + - phase: Austenite + O: [0.659802978293224, 0.6953785848195171, 0.22426295326327111, -0.17554139512785227] + v: 0.2 + - phase: Martensite + O: [0.49356745891301596, 0.2841806579193434, -0.7487679215072818, -0.339085707289975] + v: 0.8 + homogenization: A + - constituents: + - phase: Austenite + O: [0.26542221365204055, 0.7268854930702071, 0.4474726435701472, -0.44828201137283735] + v: 0.2 + - phase: Martensite + O: [0.6545817158479885, -0.08004812803625233, -0.6226561293931374, 0.4212059104577611] + v: 0.8 + homogenization: B homogenization: {} phase: {} """ - length = -1 - for v in kwargs.values(): - if hasattr(v,'__len__') and not isinstance(v,str): - if length != -1 and len(v) != length: - raise ValueError('Cannot add entries of different length') - else: - length = len(v) - length = max(1,length) - - c = [{} for _ in range(length)] if constituents is None else \ - [{'constituents':u} for u in ConfigMaterial._constituents(**constituents)] - - if len(c) == 1: c = [copy.deepcopy(c[0]) for _ in range(length)] - - if length != 1 and length != len(c): - raise ValueError('Cannot add entries of different length') + N,n,shaped = 1,1,{} for k,v in kwargs.items(): - if hasattr(v,'__len__') and not isinstance(v,str): - for i,vv in enumerate(v): - c[i][k] = vv.item() if isinstance(vv,np.generic) else vv - else: - for i in range(len(c)): - c[i][k] = v - dup = copy.deepcopy(self) - dup['material'] = dup['material'] + c if 'material' in dup else c + shaped[k] = np.array(v) + s = shaped[k].shape[:-1] if k=='O' else shaped[k].shape + N = max(N,s[0]) if len(s)>0 else N + n = max(n,s[1]) if len(s)>1 else n + + mat = [{'constituents':[{} for _ in range(n)]} for _ in range(N)] + + if 'v' not in kwargs: + shaped['v'] = np.broadcast_to(1/n,(N,n)) + + for k,v in shaped.items(): + target = (N,n,4) if k=='O' else (N,n) + obj = np.broadcast_to(v.reshape(util.shapeshifter(v.shape,target,mode='right')),target) + for i in range(N): + if k in ['phase','O','v']: + for j in range(n): + mat[i]['constituents'][j][k] = obj[i,j].item() if isinstance(obj[i,j],np.generic) else obj[i,j] + else: + mat[i][k] = obj[i,0].item() if isinstance(obj[i,0],np.generic) else obj[i,0] + + dup = self.copy() + dup['material'] = dup['material'] + mat if 'material' in dup else mat return dup - - - @staticmethod - def _constituents(N=1,**kwargs): - """Construct list of constituents.""" - N_material=1 - for v in kwargs.values(): - if hasattr(v,'__len__') and not isinstance(v,str): N_material = len(v) - - if N == 1: - m = [[{'fraction':1.0}] for _ in range(N_material)] - for k,v in kwargs.items(): - if hasattr(v,'__len__') and not isinstance(v,str): - if len(v) != N_material: - raise ValueError('Cannot add entries of different length') - for i,vv in enumerate(np.array(v)): - m[i][0][k] = vv.item() if isinstance(vv,np.generic) else vv - else: - for i in range(N_material): - m[i][0][k] = v - return m - else: - raise NotImplementedError diff --git a/python/damask/_environment.py b/python/damask/_environment.py deleted file mode 100644 index 7d93b83e0..000000000 --- a/python/damask/_environment.py +++ /dev/null @@ -1,41 +0,0 @@ -import os -from pathlib import Path - -class Environment: - - @property - def screen_size(self): - try: - import wx - _ = wx.App(False) # noqa - width, height = wx.GetDisplaySize() - except ImportError: - try: - import tkinter - tk = tkinter.Tk() - width = tk.winfo_screenwidth() - height = tk.winfo_screenheight() - tk.destroy() - except Exception as e: - width = 1024 - height = 768 - - return (width,height) - - - @property - def options(self): - options = {} - for item in ['DAMASK_NUM_THREADS', - 'MSC_ROOT', - 'MSC_VERSION', - ]: - options[item] = os.environ[item] if item in os.environ else None - - return options - - - @property - def root_dir(self): - """Return DAMASK root path.""" - return Path(__file__).parents[2] diff --git a/python/damask/_grid.py b/python/damask/_grid.py index 8380bbc5b..a58f2ca2c 100644 --- a/python/damask/_grid.py +++ b/python/damask/_grid.py @@ -1,7 +1,7 @@ import copy import multiprocessing as mp from functools import partial -from os import path +import os import warnings import numpy as np @@ -10,7 +10,6 @@ import h5py from scipy import ndimage, spatial from vtk.util.numpy_support import vtk_to_numpy as vtk_to_np -from . import environment from . import VTK from . import util from . import grid_filters @@ -57,13 +56,10 @@ class Grid: def __copy__(self): - """Copy grid.""" + """Create deep copy.""" return copy.deepcopy(self) - - def copy(self): - """Copy grid.""" - return self.__copy__() + copy = __copy__ def diff(self,other): @@ -126,7 +122,7 @@ class Grid: @size.setter def size(self,size): - if len(size) != 3 or any(np.array(size) <= 0): + if len(size) != 3 or any(np.array(size) < 0): raise ValueError(f'invalid size {size}') else: self._size = np.array(size) @@ -206,7 +202,7 @@ class Grid: Geometry file to read. """ - warnings.warn('Support for ASCII-based geom format will be removed in DAMASK 3.1.0', DeprecationWarning) + warnings.warn('Support for ASCII-based geom format will be removed in DAMASK 3.1.0', DeprecationWarning,2) try: f = open(fname) except TypeError: @@ -281,14 +277,14 @@ class Grid: """ root_dir ='DataContainers' f = h5py.File(fname, 'r') - g = path.join(root_dir,base_group,'_SIMPL_GEOMETRY') - cells = f[path.join(g,'DIMENSIONS')][()] - size = f[path.join(g,'SPACING')][()] * cells - origin = f[path.join(g,'ORIGIN')][()] + g = os.path.join(root_dir,base_group,'_SIMPL_GEOMETRY') + cells = f[os.path.join(g,'DIMENSIONS')][()] + size = f[os.path.join(g,'SPACING')][()] * cells + origin = f[os.path.join(g,'ORIGIN')][()] ma = np.arange(cells.prod(),dtype=int) \ if point_data is None else \ - np.reshape(f[path.join(root_dir,base_group,point_data,material)],cells.prod()) + np.reshape(f[os.path.join(root_dir,base_group,point_data,material)],cells.prod()) return Grid(ma.reshape(cells,order='F'),size,origin,util.execution_stamp('Grid','load_DREAM3D')) @@ -307,7 +303,7 @@ class Grid: Need to be ordered (1./x fast, 3./z slow). labels : str or list of str Label(s) of the columns containing the material definition. - Each unique combintation of values results in one material ID. + Each unique combination of values results in one material ID. """ cells,size,origin = grid_filters.cellsSizeOrigin_coordinates0_point(table.get(coordinates)) @@ -358,7 +354,7 @@ class Grid: seeds_p = seeds coords = grid_filters.coordinates0_point(cells,size).reshape(-1,3) - pool = mp.Pool(processes = int(environment.options['DAMASK_NUM_THREADS'])) + pool = mp.Pool(int(os.environ.get('OMP_NUM_THREADS',1))) result = pool.map_async(partial(Grid._find_closest_seed,seeds_p,weights_p), [coord for coord in coords]) pool.close() pool.join() @@ -545,7 +541,7 @@ class Grid: Compress geometry with 'x of y' and 'a to b'. """ - warnings.warn('Support for ASCII-based geom format will be removed in DAMASK 3.1.0', DeprecationWarning) + warnings.warn('Support for ASCII-based geom format will be removed in DAMASK 3.1.0', DeprecationWarning,2) header = [f'{len(self.comments)+4} header'] + self.comments \ + ['grid a {} b {} c {}'.format(*self.cells), 'size x {} y {} z {}'.format(*self.size), @@ -764,26 +760,21 @@ class Grid: """ if fill is None: fill = np.nanmax(self.material) + 1 - dtype = float if np.isnan(fill) or int(fill) != fill or self.material.dtype==np.float else int - - Eulers = R.as_Euler_angles(degrees=True) - material_in = self.material.copy() + dtype = float if isinstance(fill,float) or self.material.dtype in np.sctypes['float'] else int + material = self.material # These rotations are always applied in the reference coordinate system, i.e. (z,x,z) not (z,x',z'') # see https://www.cs.utexas.edu/~theshark/courses/cs354/lectures/cs354-14.pdf - for angle,axes in zip(Eulers[::-1], [(0,1),(1,2),(0,1)]): - material_out = ndimage.rotate(material_in,angle,axes,order=0, - prefilter=False,output=dtype,cval=fill) - if np.prod(material_in.shape) == np.prod(material_out.shape): - # avoid scipy interpolation errors for rotations close to multiples of 90° - material_in = np.rot90(material_in,k=np.rint(angle/90.).astype(int),axes=axes) - else: - material_in = material_out + for angle,axes in zip(R.as_Euler_angles(degrees=True)[::-1], [(0,1),(1,2),(0,1)]): + material_temp = ndimage.rotate(material,angle,axes,order=0,prefilter=False,output=dtype,cval=fill) + # avoid scipy interpolation errors for rotations close to multiples of 90° + material = material_temp if np.prod(material_temp.shape) != np.prod(material.shape) else \ + np.rot90(material,k=np.rint(angle/90.).astype(int),axes=axes) - origin = self.origin-(np.asarray(material_in.shape)-self.cells)*.5 * self.size/self.cells + origin = self.origin-(np.asarray(material.shape)-self.cells)*.5 * self.size/self.cells - return Grid(material = material_in, - size = self.size/self.cells*np.asarray(material_in.shape), + return Grid(material = material, + size = self.size/self.cells*np.asarray(material.shape), origin = origin, comments = self.comments+[util.execution_stamp('Grid','rotate')], ) diff --git a/python/damask/_orientation.py b/python/damask/_orientation.py index e6434813e..a14af98af 100644 --- a/python/damask/_orientation.py +++ b/python/damask/_orientation.py @@ -1,3 +1,5 @@ +import inspect + import numpy as np from . import Rotation @@ -7,7 +9,7 @@ from . import tensor _parameter_doc = \ """lattice : str Either a crystal family out of [triclinic, monoclinic, orthorhombic, tetragonal, hexagonal, cubic] - or a Bravais lattice out of [aP, mP, mS, oP, oS, oI, oF, tP, tI, hP, cP, cI, cF]. + or a Bravais lattice out of [aP, mP, mS, oP, oS, oI, oF, tP, tI, hP, cP, cI, cF]. When specifying a Bravais lattice, additional lattice parameters might be required: a : float, optional Length of lattice parameter "a". @@ -107,8 +109,7 @@ class Orientation(Rotation): lattice = None, a = None,b = None,c = None, alpha = None,beta = None,gamma = None, - degrees = False, - **kwargs): + degrees = False): """ Initialize orientation object. @@ -199,7 +200,7 @@ class Orientation(Rotation): def __copy__(self,**kwargs): - """Copy.""" + """Create deep copy.""" return self.__class__(rotation=kwargs['rotation'] if 'rotation' in kwargs else self.quaternion, lattice =kwargs['lattice'] if 'lattice' in kwargs else self.lattice if self.lattice is not None else self.family, @@ -225,96 +226,150 @@ class Orientation(Rotation): Orientation to check for equality. """ - return super().__eq__(other) \ - and hasattr(other, 'family') and self.family == other.family \ - and hasattr(other, 'lattice') and self.lattice == other.lattice \ - and hasattr(other, 'parameters') and self.parameters == other.parameters + matching_type = all([hasattr(other,attr) and getattr(self,attr) == getattr(other,attr) + for attr in ['family','lattice','parameters']]) + return np.logical_and(super().__eq__(other),matching_type) - - def __matmul__(self,other): + def __ne__(self,other): """ - Rotation of vector, second or fourth order tensor, or rotation object. + Not equal to other. Parameters ---------- - other : numpy.ndarray, Rotation, or Orientation - Vector, second or fourth order tensor, or rotation object that is rotated. + other : Orientation + Orientation to check for equality. + + """ + return np.logical_not(self==other) + + + def __mul__(self,other): + """ + Compose this orientation with other. + + Parameters + ---------- + other : Rotation or Orientation + Object for composition. Returns ------- - other_rot : numpy.ndarray or Rotation - Rotated vector, second or fourth order tensor, or rotation object. + composition : Orientation + Compound rotation self*other, i.e. first other then self rotation. """ - return self.copy(rotation=Rotation.__matmul__(self,Rotation(other.quaternion))) \ - if isinstance(other,self.__class__) else \ - Rotation.__matmul__(self,other) + if isinstance(other,Orientation) or isinstance(other,Rotation): + return self.copy(rotation=Rotation.__mul__(self,Rotation(other.quaternion))) + else: + raise TypeError('Use "O@b", i.e. matmul, to apply Orientation "O" to object "b"') + + + @staticmethod + def _split_kwargs(kwargs,target): + """ + Separate keyword arguments in 'kwargs' targeted at 'target' from general keyword arguments of Orientation objects. + + Parameters + ---------- + kwargs : dictionary + Contains all **kwargs. + target: method + Function to scan for kwarg signature. + + Returns + ------- + rot_kwargs: dictionary + Valid keyword arguments of 'target' function of Rotation class. + ori_kwargs: dictionary + Valid keyword arguments of Orientation object. + + """ + kws = () + for t in (target,Orientation.__init__): + kws += ({key: kwargs[key] for key in set(inspect.signature(t).parameters) & set(kwargs)},) + + invalid_keys = set(kwargs)-(set(kws[0])|set(kws[1])) + if invalid_keys: + raise TypeError(f"{inspect.stack()[1][3]}() got an unexpected keyword argument '{invalid_keys.pop()}'") + + return kws @classmethod @util.extended_docstring(Rotation.from_random,_parameter_doc) def from_random(cls,**kwargs): - return cls(rotation=Rotation.from_random(**kwargs),**kwargs) + kwargs_rot,kwargs_ori = Orientation._split_kwargs(kwargs,Rotation.from_random) + return cls(rotation=Rotation.from_random(**kwargs_rot),**kwargs_ori) @classmethod @util.extended_docstring(Rotation.from_quaternion,_parameter_doc) def from_quaternion(cls,**kwargs): - return cls(rotation=Rotation.from_quaternion(**kwargs),**kwargs) + kwargs_rot,kwargs_ori = Orientation._split_kwargs(kwargs,Rotation.from_quaternion) + return cls(rotation=Rotation.from_quaternion(**kwargs_rot),**kwargs_ori) @classmethod @util.extended_docstring(Rotation.from_Euler_angles,_parameter_doc) def from_Euler_angles(cls,**kwargs): - return cls(rotation=Rotation.from_Euler_angles(**kwargs),**kwargs) + kwargs_rot,kwargs_ori = Orientation._split_kwargs(kwargs,Rotation.from_Euler_angles) + return cls(rotation=Rotation.from_Euler_angles(**kwargs_rot),**kwargs_ori) @classmethod @util.extended_docstring(Rotation.from_axis_angle,_parameter_doc) def from_axis_angle(cls,**kwargs): - return cls(rotation=Rotation.from_axis_angle(**kwargs),**kwargs) + kwargs_rot,kwargs_ori = Orientation._split_kwargs(kwargs,Rotation.from_axis_angle) + return cls(rotation=Rotation.from_axis_angle(**kwargs_rot),**kwargs_ori) @classmethod @util.extended_docstring(Rotation.from_basis,_parameter_doc) def from_basis(cls,**kwargs): - return cls(rotation=Rotation.from_basis(**kwargs),**kwargs) + kwargs_rot,kwargs_ori = Orientation._split_kwargs(kwargs,Rotation.from_basis) + return cls(rotation=Rotation.from_basis(**kwargs_rot),**kwargs_ori) @classmethod @util.extended_docstring(Rotation.from_matrix,_parameter_doc) def from_matrix(cls,**kwargs): - return cls(rotation=Rotation.from_matrix(**kwargs),**kwargs) + kwargs_rot,kwargs_ori = Orientation._split_kwargs(kwargs,Rotation.from_matrix) + return cls(rotation=Rotation.from_matrix(**kwargs_rot),**kwargs_ori) @classmethod @util.extended_docstring(Rotation.from_Rodrigues_vector,_parameter_doc) def from_Rodrigues_vector(cls,**kwargs): - return cls(rotation=Rotation.from_Rodrigues_vector(**kwargs),**kwargs) + kwargs_rot,kwargs_ori = Orientation._split_kwargs(kwargs,Rotation.from_Rodrigues_vector) + return cls(rotation=Rotation.from_Rodrigues_vector(**kwargs_rot),**kwargs_ori) @classmethod @util.extended_docstring(Rotation.from_homochoric,_parameter_doc) def from_homochoric(cls,**kwargs): - return cls(rotation=Rotation.from_homochoric(**kwargs),**kwargs) + kwargs_rot,kwargs_ori = Orientation._split_kwargs(kwargs,Rotation.from_homochoric) + return cls(rotation=Rotation.from_homochoric(**kwargs_rot),**kwargs_ori) @classmethod @util.extended_docstring(Rotation.from_cubochoric,_parameter_doc) def from_cubochoric(cls,**kwargs): - return cls(rotation=Rotation.from_cubochoric(**kwargs),**kwargs) + kwargs_rot,kwargs_ori = Orientation._split_kwargs(kwargs,Rotation.from_cubochoric) + return cls(rotation=Rotation.from_cubochoric(**kwargs_rot),**kwargs_ori) @classmethod @util.extended_docstring(Rotation.from_spherical_component,_parameter_doc) def from_spherical_component(cls,**kwargs): - return cls(rotation=Rotation.from_spherical_component(**kwargs),**kwargs) + kwargs_rot,kwargs_ori = Orientation._split_kwargs(kwargs,Rotation.from_spherical_component) + return cls(rotation=Rotation.from_spherical_component(**kwargs_rot),**kwargs_ori) @classmethod @util.extended_docstring(Rotation.from_fiber_component,_parameter_doc) def from_fiber_component(cls,**kwargs): - return cls(rotation=Rotation.from_fiber_component(**kwargs),**kwargs) + kwargs_rot,kwargs_ori = Orientation._split_kwargs(kwargs,Rotation.from_fiber_component) + return cls(rotation=Rotation.from_fiber_component(**kwargs_rot),**kwargs_ori) @classmethod @@ -429,7 +484,7 @@ class Orientation(Rotation): raise ValueError('Missing crystal symmetry') o = self.symmetry_operations.broadcast_to(self.symmetry_operations.shape+self.shape,mode='right') - return self.copy(rotation=o@Rotation(self.quaternion).broadcast_to(o.shape,mode='left')) + return self.copy(rotation=o*Rotation(self.quaternion).broadcast_to(o.shape,mode='left')) @property @@ -469,26 +524,26 @@ class Orientation(Rotation): if self.family is None: raise ValueError('Missing crystal symmetry') - rho_abs = np.abs(self.as_Rodrigues_vector(compact=True)) + rho_abs = np.abs(self.as_Rodrigues_vector(compact=True))*(1.-1.e-9) with np.errstate(invalid='ignore'): # using '*'/prod for 'and' if self.family == 'cubic': return (np.prod(np.sqrt(2)-1. >= rho_abs,axis=-1) * - (1. >= np.sum(rho_abs,axis=-1))).astype(np.bool) + (1. >= np.sum(rho_abs,axis=-1))).astype(bool) elif self.family == 'hexagonal': return (np.prod(1. >= rho_abs,axis=-1) * (2. >= np.sqrt(3)*rho_abs[...,0] + rho_abs[...,1]) * (2. >= np.sqrt(3)*rho_abs[...,1] + rho_abs[...,0]) * - (2. >= np.sqrt(3) + rho_abs[...,2])).astype(np.bool) + (2. >= np.sqrt(3) + rho_abs[...,2])).astype(bool) elif self.family == 'tetragonal': return (np.prod(1. >= rho_abs[...,:2],axis=-1) * (np.sqrt(2) >= rho_abs[...,0] + rho_abs[...,1]) * - (np.sqrt(2) >= rho_abs[...,2] + 1.)).astype(np.bool) + (np.sqrt(2) >= rho_abs[...,2] + 1.)).astype(bool) elif self.family == 'orthorhombic': - return (np.prod(1. >= rho_abs,axis=-1)).astype(np.bool) + return (np.prod(1. >= rho_abs,axis=-1)).astype(bool) elif self.family == 'monoclinic': - return (1. >= rho_abs[...,1]).astype(np.bool) + return (1. >= rho_abs[...,1]).astype(bool) else: return np.all(np.isfinite(rho_abs),axis=-1) @@ -512,28 +567,28 @@ class Orientation(Rotation): if self.family is None: raise ValueError('Missing crystal symmetry') - rho = self.as_Rodrigues_vector(compact=True) + rho = self.as_Rodrigues_vector(compact=True)*(1.0-1.0e-9) with np.errstate(invalid='ignore'): if self.family == 'cubic': return ((rho[...,0] >= rho[...,1]) & (rho[...,1] >= rho[...,2]) & - (rho[...,2] >= 0)).astype(np.bool) + (rho[...,2] >= 0)).astype(bool) elif self.family == 'hexagonal': return ((rho[...,0] >= rho[...,1]*np.sqrt(3)) & (rho[...,1] >= 0) & - (rho[...,2] >= 0)).astype(np.bool) + (rho[...,2] >= 0)).astype(bool) elif self.family == 'tetragonal': return ((rho[...,0] >= rho[...,1]) & (rho[...,1] >= 0) & - (rho[...,2] >= 0)).astype(np.bool) + (rho[...,2] >= 0)).astype(bool) elif self.family == 'orthorhombic': return ((rho[...,0] >= 0) & (rho[...,1] >= 0) & - (rho[...,2] >= 0)).astype(np.bool) + (rho[...,2] >= 0)).astype(bool) elif self.family == 'monoclinic': return ((rho[...,1] >= 0) & - (rho[...,2] >= 0)).astype(np.bool) + (rho[...,2] >= 0)).astype(bool) else: return np.ones_like(rho[...,0],dtype=bool) @@ -608,7 +663,7 @@ class Orientation(Rotation): o,lattice = self.relation_operations(model,return_lattice=True) target = Orientation(lattice=lattice) o = o.broadcast_to(o.shape+self.shape,mode='right') - return self.copy(rotation=o@Rotation(self.quaternion).broadcast_to(o.shape,mode='left'), + return self.copy(rotation=o*Rotation(self.quaternion).broadcast_to(o.shape,mode='left'), lattice=lattice, b = self.b if target.ratio['b'] is None else self.a*target.ratio['b'], c = self.c if target.ratio['c'] is None else self.a*target.ratio['c'], diff --git a/python/damask/_result.py b/python/damask/_result.py index 5e37042e0..4ecd0ba51 100644 --- a/python/damask/_result.py +++ b/python/damask/_result.py @@ -80,12 +80,12 @@ class Result: self.out_type_ho += f['/'.join([self.increments[0],'homogenization',m])].keys() self.out_type_ho = list(set(self.out_type_ho)) # make unique - self.selection = {'increments': self.increments, - 'phases': self.phases, - 'homogenizations': self.homogenizations, - 'out_type_ph': self.out_type_ph, - 'out_type_ho': self.out_type_ho - } + self.visible = {'increments': self.increments, + 'phases': self.phases, + 'homogenizations': self.homogenizations, + 'out_type_ph': self.out_type_ph, + 'out_type_ho': self.out_type_ho + } self.fname = Path(fname).absolute() @@ -94,23 +94,23 @@ class Result: def __repr__(self): """Show summary of file content.""" - all_selected_increments = self.selection['increments'] + visible_increments = self.visible['increments'] - self.pick('increments',all_selected_increments[0:1]) + self.view('increments',visible_increments[0:1]) first = self.list_data() - self.pick('increments',all_selected_increments[-1:]) - last = '' if len(all_selected_increments) < 2 else self.list_data() + self.view('increments',visible_increments[-1:]) + last = '' if len(visible_increments) < 2 else self.list_data() - self.pick('increments',all_selected_increments) + self.view('increments',visible_increments) - in_between = '' if len(all_selected_increments) < 3 else \ - ''.join([f'\n{inc}\n ...\n' for inc in all_selected_increments[1:-2]]) + in_between = '' if len(visible_increments) < 3 else \ + ''.join([f'\n{inc}\n ...\n' for inc in visible_increments[1:-1]]) return util.srepr(first + in_between + last) - def _manage_selection(self,action,what,datasets): + def _manage_view(self,action,what,datasets): """ Manages the visibility of the groups. @@ -119,10 +119,10 @@ class Result: action : str Select from 'set', 'add', and 'del'. what : str - Attribute to change (must be from self.selection). + Attribute to change (must be from self.visible). datasets : list of str or bool - Name of datasets as list, supports ? and * wildcards. - True is equivalent to [*], False is equivalent to [] + Name of datasets as list; supports ? and * wildcards. + True is equivalent to [*], False is equivalent to []. """ def natural_sort(key): @@ -156,18 +156,18 @@ class Result: choice.append(self.increments[idx+1]) valid = [e for e_ in [glob.fnmatch.filter(getattr(self,what),s) for s in choice] for e in e_] - existing = set(self.selection[what]) + existing = set(self.visible[what]) if action == 'set': - self.selection[what] = valid + self.visible[what] = valid elif action == 'add': add = existing.union(valid) add_sorted = sorted(add, key=natural_sort) - self.selection[what] = add_sorted + self.visible[what] = add_sorted elif action == 'del': diff = existing.difference(valid) diff_sorted = sorted(diff, key=natural_sort) - self.selection[what] = diff_sorted + self.visible[what] = diff_sorted def _get_attribute(self,path,attr): @@ -200,7 +200,7 @@ class Result: self._allow_modification = True def disallow_modification(self): - """Disllow to overwrite existing data (default case).""" + """Disallow to overwrite existing data (default case).""" self._allow_modification = False @@ -245,84 +245,84 @@ class Result: def iterate(self,what): """ - Iterate over selection items by setting each one selected. + Iterate over visible items and view them independently. Parameters ---------- what : str - Attribute to change (must be from self.selection). + Attribute to change (must be from self.visible). """ - datasets = self.selection[what] - last_selection = datasets.copy() + datasets = self.visible[what] + last_view = datasets.copy() for dataset in datasets: - if last_selection != self.selection[what]: - self._manage_selection('set',what,datasets) + if last_view != self.visible[what]: + self._manage_view('set',what,datasets) raise Exception - self._manage_selection('set',what,dataset) - last_selection = self.selection[what] + self._manage_view('set',what,dataset) + last_view = self.visible[what] yield dataset - self._manage_selection('set',what,datasets) + self._manage_view('set',what,datasets) - def pick(self,what,datasets): + def view(self,what,datasets): """ - Set selection. + Set view. Parameters ---------- what : str - attribute to change (must be from self.selection) + Attribute to change (must be from self.visible). datasets : list of str or bool - name of datasets as list, supports ? and * wildcards. - True is equivalent to [*], False is equivalent to [] + Name of datasets as list; supports ? and * wildcards. + True is equivalent to [*], False is equivalent to []. """ - self._manage_selection('set',what,datasets) + self._manage_view('set',what,datasets) - def pick_more(self,what,datasets): + def view_more(self,what,datasets): """ - Add to selection. + Add to view. Parameters ---------- what : str - attribute to change (must be from self.selection) + Attribute to change (must be from self.visible). datasets : list of str or bool - name of datasets as list, supports ? and * wildcards. - True is equivalent to [*], False is equivalent to [] + Name of datasets as list; supports ? and * wildcards. + True is equivalent to [*], False is equivalent to []. """ - self._manage_selection('add',what,datasets) + self._manage_view('add',what,datasets) - def pick_less(self,what,datasets): + def view_less(self,what,datasets): """ - Delete from selection. + Delete from view. Parameters ---------- what : str - attribute to change (must be from self.selection) + Attribute to change (must be from self.visible). datasets : list of str or bool - name of datasets as list, supports ? and * wildcards. - True is equivalent to [*], False is equivalent to [] + Name of datasets as list; supports ? and * wildcards. + True is equivalent to [*], False is equivalent to []. """ - self._manage_selection('del',what,datasets) + self._manage_view('del',what,datasets) def rename(self,name_old,name_new): """ - Rename datasets. + Rename dataset. Parameters ---------- name_old : str - name of the datasets to be renamed + Name of the dataset to be renamed. name_new : str - new name of the datasets + New name of the dataset. """ if self._allow_modification: @@ -353,13 +353,13 @@ class Result: ---------- datasets : iterable or str constituent : int - Constituent to consider for phase data + Constituent to consider for phase data. tagged : bool - tag Table.column name with '#constituent' - defaults to False + Tag Table.column name with '#constituent'. + Defaults to False. split : bool - split Table by increment and return dictionary of Tables - defaults to True + Split Table by increment and return dictionary of Tables. + Defaults to True. """ sets = datasets if hasattr(datasets,'__iter__') and not isinstance(datasets,str) else \ @@ -371,7 +371,7 @@ class Result: with h5py.File(self.fname,'r') as f: for dataset in sets: for group in self.groups_with_datasets(dataset): - path = os.path.join(group,dataset) + path = '/'.join([group,dataset]) inc,prop,name,cat,item = (path.split('/') + ['']*5)[:5] key = '/'.join([prop,name+tag]) if key not in inGeom: @@ -388,15 +388,15 @@ class Result: np.nan, dtype=np.dtype(f[path])) data[inGeom[key]] = (f[path] if len(shape)>1 else np.expand_dims(f[path],1))[inData[key]] - path = (os.path.join(*([prop,name]+([cat] if cat else [])+([item] if item else []))) if split else path)+tag + path = ('/'.join([prop,name]+([cat] if cat else [])+([item] if item else [])) if split else path)+tag if split: try: - tbl[inc].add(path,data) + tbl[inc] = tbl[inc].add(path,data) except KeyError: tbl[inc] = Table(data.reshape(self.N_materialpoints,-1),{path:data.shape[1:]}) else: try: - tbl.add(path,data) + tbl = tbl.add(path,data) except AttributeError: tbl = Table(data.reshape(self.N_materialpoints,-1),{path:data.shape[1:]}) @@ -415,7 +415,7 @@ class Result: are considered as they contain user-relevant data. Single strings will be treated as list with one entry. - Wild card matching is allowed, but the number of arguments need to fit. + Wild card matching is allowed, but the number of arguments needs to fit. Parameters ---------- @@ -1134,8 +1134,7 @@ class Result: """ chunk_size = 1024**2//8 - num_threads = damask.environment.options['DAMASK_NUM_THREADS'] - pool = mp.Pool(int(num_threads) if num_threads is not None else None) + pool = mp.Pool(int(os.environ.get('OMP_NUM_THREADS',1))) lock = mp.Manager().Lock() groups = self.groups_with_datasets(datasets.values()) @@ -1190,8 +1189,8 @@ class Result: """ Write XDMF file to directly visualize data in DADF5 file. - This works only for scalar, 3-vector and 3x3-tensor data. - Selection is not taken into account. + The view is not taken into account, i.e. the content of the + whole file will be included. """ if self.N_constituents != 1 or len(self.phases) != 1 or not self.structured: raise TypeError('XDMF output requires homogeneous grid') @@ -1288,7 +1287,7 @@ class Result: np.prod(shape))} data_items[-1].text=f'{os.path.split(self.fname)[1]}:{name}' - with open(self.fname.with_suffix('.xdmf').name,'w') as f: + with open(self.fname.with_suffix('.xdmf').name,'w',newline='\n') as f: f.write(xml.dom.minidom.parseString(ET.tostring(xdmf).decode()).toprettyxml()) @@ -1320,10 +1319,10 @@ class Result: N_digits = int(np.floor(np.log10(max(1,int(self.increments[-1][3:])))))+1 - for inc in util.show_progress(self.iterate('increments'),len(self.selection['increments'])): + for inc in util.show_progress(self.iterate('increments'),len(self.visible['increments'])): - picked_backup_ho = self.selection['homogenizations'].copy() - self.pick('homogenizations',False) + viewed_backup_ho = self.visible['homogenizations'].copy() + self.view('homogenizations',False) for label in (labels if isinstance(labels,list) else [labels]): for o in self.iterate('out_type_ph'): for c in range(self.N_constituents): @@ -1343,10 +1342,10 @@ class Result: ph_name = re.compile(r'(?<=(phase\/))(.*?)(?=(mechanics))') # identify phase name dset_name = prefix+re.sub(ph_name,r'',paths[0].split('/',1)[1]) # remove phase name v.add(array,dset_name+f' / {self._get_attribute(paths[0],"Unit")}') - self.pick('homogenizations',picked_backup_ho) + self.view('homogenizations',viewed_backup_ho) - picked_backup_ph = self.selection['phases'].copy() - self.pick('phases',False) + viewed_backup_ph = self.visible['phases'].copy() + self.view('phases',False) for label in (labels if isinstance(labels,list) else [labels]): for _ in self.iterate('out_type_ho'): paths = self.get_dataset_location(label) @@ -1354,7 +1353,7 @@ class Result: continue array = self.read_dataset(paths) v.add(array,paths[0].split('/',1)[1]+f' / {self._get_attribute(paths[0],"Unit")}') - self.pick('phases',picked_backup_ph) + self.view('phases',viewed_backup_ph) u = self.read_dataset(self.get_dataset_location('u_n' if mode.lower() == 'cell' else 'u_p')) v.add(u,'u') diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index 78029b59a..34a5f81b7 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -35,6 +35,11 @@ class Rotation: - b = Q @ a - b = np.dot(Q.as_matrix(),a) + Compound rotations R1 (first) and R2 (second): + + - R = R2 * R1 + - R = Rotation.from_matrix(np.dot(R2.as_matrix(),R1.as_matrix()) + References ---------- D. Rowenhorst et al., Modelling and Simulation in Materials Science and Engineering 23:083501, 2015 @@ -65,22 +70,13 @@ class Rotation: def __repr__(self): - """Represent rotation as unit quaternion, rotation matrix, and Bunge-Euler angles.""" - if self == Rotation(): - return 'Rotation()' - else: - return f'Quaternions {self.shape}:\n'+str(self.quaternion) \ - if self.quaternion.shape != (4,) else \ - '\n'.join([ - 'Quaternion: (real={:.3f}, imag=<{:+.3f}, {:+.3f}, {:+.3f}>)'.format(*(self.quaternion)), - 'Matrix:\n{}'.format(np.round(self.as_matrix(),8)), - 'Bunge Eulers / deg: ({:3.2f}, {:3.2f}, {:3.2f})'.format(*self.as_Euler_angles(degrees=True)), - ]) + """Represent rotation as unit quaternion(s).""" + return f'Quaternion{" " if self.quaternion.shape == (4,) else "s of shape "+str(self.quaternion.shape)+chr(10)}'\ + + str(self.quaternion) - # ToDo: Check difference __copy__ vs __deepcopy__ def __copy__(self,**kwargs): - """Copy.""" + """Create deep copy.""" return self.__class__(rotation=kwargs['rotation'] if 'rotation' in kwargs else self.quaternion) copy = __copy__ @@ -97,6 +93,26 @@ class Rotation: """ Equal to other. + Equality is determined taking limited floating point precision into account. + See numpy.allclose for details. + + Parameters + ---------- + other : Rotation + Rotation to check for equality. + + """ + s = self.quaternion + o = other.quaternion + if self.shape == () == other.shape: + return np.allclose(s,o) or (np.isclose(s[0],0.0) and np.allclose(s,-1.0*o)) + else: + return np.all(np.isclose(s,o),-1) + np.all(np.isclose(s,-1.0*o),-1) * np.isclose(s[...,0],0.0) + + def __ne__(self,other): + """ + Not equal to other. + Equality is determined taking limited floating point precision into account. See numpy.allclose for details. @@ -106,13 +122,21 @@ class Rotation: Rotation to check for equality. """ - return np.prod(self.shape,dtype=int) == np.prod(other.shape,dtype=int) \ - and np.allclose(self.quaternion,other.quaternion) + return np.logical_not(self==other) + + + def __array__(self): + """Initializer for numpy.""" + return self.quaternion + @property + def size(self): + return self.quaternion[...,0].size + @property def shape(self): - return self.quaternion.shape[:-1] + return self.quaternion[...,0].shape def __len__(self): @@ -127,41 +151,46 @@ class Rotation: return dup - def __pow__(self,pwr): + def __pow__(self,exp): """ - Raise quaternion to power. - - Equivalent to performing the rotation 'pwr' times. + Perform the rotation 'exp' times. Parameters ---------- - pwr : float - Power to raise quaternion to. + exp : float + Exponent. """ phi = np.arccos(self.quaternion[...,0:1]) p = self.quaternion[...,1:]/np.linalg.norm(self.quaternion[...,1:],axis=-1,keepdims=True) - return self.copy(rotation=Rotation(np.block([np.cos(pwr*phi),np.sin(pwr*phi)*p]))._standardize()) + return self.copy(rotation=Rotation(np.block([np.cos(exp*phi),np.sin(exp*phi)*p]))._standardize()) - - def __mul__(self,other): - """Standard multiplication is not implemented.""" - raise NotImplementedError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"') - - - def __matmul__(self,other): + def __ipow__(self,exp): """ - Rotation of vector, second or fourth order tensor, or rotation object. + Perform the rotation 'exp' times (in-place). Parameters ---------- - other : numpy.ndarray or Rotation - Vector, second or fourth order tensor, or rotation object that is rotated. + exp : float + Exponent. + + """ + return self**exp + + + def __mul__(self,other): + """ + Compose this rotation with other. + + Parameters + ---------- + other : Rotation of shape(self.shape) + Rotation for composition. Returns ------- - other_rot : numpy.ndarray or Rotation - Rotated vector, second or fourth order tensor, or rotation object. + composition : Rotation + Compound rotation self*other, i.e. first other then self rotation. """ if isinstance(other,Rotation): @@ -172,8 +201,71 @@ class Rotation: q = (q_m*q_o - np.einsum('...i,...i',p_m,p_o).reshape(self.shape+(1,))) p = q_m*p_o + q_o*p_m + _P * np.cross(p_m,p_o) return Rotation(np.block([q,p]))._standardize() + else: + raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"') - elif isinstance(other,np.ndarray): + def __imul__(self,other): + """ + Compose this rotation with other (in-place). + + Parameters + ---------- + other : Rotation of shape(self.shape) + Rotation for composition. + + """ + return self*other + + + def __truediv__(self,other): + """ + Compose this rotation with inverse of other. + + Parameters + ---------- + other : damask.Rotation of shape (self.shape) + Rotation to inverse composition. + + Returns + ------- + composition : Rotation + Compound rotation self*(~other), i.e. first inverse of other then self rotation. + + """ + if isinstance(other,Rotation): + return self*~other + else: + raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"') + + def __itruediv__(self,other): + """ + Compose this rotation with inverse of other (in-place). + + Parameters + ---------- + other : Rotation of shape (self.shape) + Rotation to inverse composition. + + """ + return self/other + + + def __matmul__(self,other): + """ + Rotation of vector, second order tensor, or fourth order tensor. + + Parameters + ---------- + other : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) + Vector or tensor on which to apply the rotation. + + Returns + ------- + rotated : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) + Rotated vector or tensor, i.e. transformed to frame defined by rotation. + + """ + if isinstance(other,np.ndarray): if self.shape + (3,) == other.shape: q_m = self.quaternion[...,0] p_m = self.quaternion[...,1:] @@ -193,9 +285,13 @@ class Rotation: return np.einsum('...im,...jn,...ko,...lp,...mnop',R,R,R,R,other) else: raise ValueError('Can only rotate vectors, 2nd order tensors, and 4th order tensors') + elif isinstance(other,Rotation): + raise TypeError('Use "R1*R2", i.e. multiplication, to compose rotations "R1" and "R2"') else: raise TypeError(f'Cannot rotate {type(other)}') + apply = __matmul__ + def _standardize(self): """Standardize quaternion (ensure positive real hemisphere).""" @@ -296,7 +392,7 @@ class Rotation: Rotation to which the misorientation is computed. """ - return other@~self + return other*~self ################################################################################################ @@ -379,15 +475,17 @@ class Rotation: Parameters ---------- - vector : bool, optional - Return as actual Rodrigues-Frank vector, i.e. axis - and angle argument are not separated. + compact : bool, optional + Return as actual Rodrigues-Frank vector, + i.e. axis and angle argument are not separated. Returns ------- - rho : numpy.ndarray of shape (...,4) unless vector == True: - numpy.ndarray of shape (...,3) - Rodrigues-Frank vector: [n_1, n_2, n_3, tan(ω/2)], ǀnǀ = 1 and ω ∈ [0,π]. + rho : numpy.ndarray of shape (...,4) containing + [n_1, n_2, n_3, tan(ω/2)], ǀnǀ = 1 and ω ∈ [0,π] + unless compact == True: + numpy.ndarray of shape (...,3) containing + tan(ω/2) [n_1, n_2, n_3], ω ∈ [0,π]. """ ro = Rotation._qu2ro(self.quaternion) @@ -415,8 +513,8 @@ class Rotation: Returns ------- - c : numpy.ndarray of shape (...,3) - Cubochoric vector: (c_1, c_2, c_3), max(c_i) < 1/2*π^(2/3). + x : numpy.ndarray of shape (...,3) + Cubochoric vector: (x_1, x_2, x_3), max(x_i) < 1/2*π^(2/3). """ return Rotation._qu2cu(self.quaternion) @@ -427,8 +525,7 @@ class Rotation: @staticmethod def from_quaternion(q, accept_homomorph = False, - P = -1, - **kwargs): + P = -1): """ Initialize from quaternion. @@ -463,8 +560,7 @@ class Rotation: @staticmethod def from_Euler_angles(phi, - degrees = False, - **kwargs): + degrees = False): """ Initialize from Bunge-Euler angles. @@ -491,8 +587,7 @@ class Rotation: def from_axis_angle(axis_angle, degrees = False, normalize = False, - P = -1, - **kwargs): + P = -1): """ Initialize from Axis angle pair. @@ -529,8 +624,7 @@ class Rotation: @staticmethod def from_basis(basis, orthonormal = True, - reciprocal = False, - **kwargs): + reciprocal = False): """ Initialize from lattice basis vectors. @@ -564,7 +658,7 @@ class Rotation: return Rotation(Rotation._om2qu(om)) @staticmethod - def from_matrix(R,**kwargs): + def from_matrix(R): """ Initialize from rotation matrix. @@ -608,8 +702,7 @@ class Rotation: @staticmethod def from_Rodrigues_vector(rho, normalize = False, - P = -1, - **kwargs): + P = -1): """ Initialize from Rodrigues-Frank vector (angle separated from axis). @@ -640,8 +733,7 @@ class Rotation: @staticmethod def from_homochoric(h, - P = -1, - **kwargs): + P = -1): """ Initialize from homochoric vector. @@ -667,21 +759,20 @@ class Rotation: return Rotation(Rotation._ho2qu(ho)) @staticmethod - def from_cubochoric(c, - P = -1, - **kwargs): + def from_cubochoric(x, + P = -1): """ Initialize from cubochoric vector. Parameters ---------- - c : numpy.ndarray of shape (...,3) - Cubochoric vector: (c_1, c_2, c_3), max(c_i) < 1/2*π^(2/3). + x : numpy.ndarray of shape (...,3) + Cubochoric vector: (x_1, x_2, x_3), max(x_i) < 1/2*π^(2/3). P : int ∈ {-1,1}, optional Convention used. Defaults to -1. """ - cu = np.array(c,dtype=float) + cu = np.array(x,dtype=float) if cu.shape[:-2:-1] != (3,): raise ValueError('Invalid shape.') if abs(P) != 1: @@ -697,8 +788,7 @@ class Rotation: @staticmethod def from_random(shape = None, - rng_seed = None, - **kwargs): + rng_seed = None): """ Draw random rotation. @@ -791,8 +881,7 @@ class Rotation: sigma, N = 500, degrees = True, - rng_seed = None, - **kwargs): + rng_seed = None): """ Calculate set of rotations with Gaussian distribution around center. @@ -819,7 +908,7 @@ class Rotation: np.sqrt(1-u**2)*np.sin(Theta), u, omega]) - return Rotation.from_axis_angle(p) @ center + return Rotation.from_axis_angle(p) * center @staticmethod @@ -828,8 +917,7 @@ class Rotation: sigma = 0.0, N = 500, degrees = True, - rng_seed = None, - **kwargs): + rng_seed = None): """ Calculate set of rotations with Gaussian distribution around direction. @@ -870,8 +958,8 @@ class Rotation: f[::2,:3] *= -1 # flip half the rotation axes to negative sense return R_align.broadcast_to(N) \ - @ Rotation.from_axis_angle(p,normalize=True) \ - @ Rotation.from_axis_angle(f) + * Rotation.from_axis_angle(p,normalize=True) \ + * Rotation.from_axis_angle(f) #################################################################################################### @@ -1060,7 +1148,6 @@ class Rotation: @staticmethod def _om2ax(om): """Rotation matrix to axis angle pair.""" - #return Rotation._qu2ax(Rotation._om2qu(om)) # HOTFIX diag_delta = -_P*np.block([om[...,1,2:3]-om[...,2,1:2], om[...,2,0:1]-om[...,0,2:3], om[...,0,1:2]-om[...,1,0:1] diff --git a/python/damask/_table.py b/python/damask/_table.py index e6e6c4eeb..ee64ba017 100644 --- a/python/damask/_table.py +++ b/python/damask/_table.py @@ -26,7 +26,7 @@ class Table: comments_ = [comments] if isinstance(comments,str) else comments self.comments = [] if comments_ is None else [c for c in comments_] self.data = pd.DataFrame(data=data) - self.shapes = { k:(v,) if isinstance(v,(np.int,int)) else v for k,v in shapes.items() } + self.shapes = { k:(v,) if isinstance(v,(np.int64,np.int32,int)) else v for k,v in shapes.items() } self._label_uniform() def __repr__(self): @@ -42,12 +42,10 @@ class Table: return len(self.data) def __copy__(self): - """Copy Table.""" + """Create deep copy.""" return copy.deepcopy(self) - def copy(self): - """Copy Table.""" - return self.__copy__() + copy = __copy__ def _label_discrete(self): @@ -191,6 +189,11 @@ class Table: label : str Column label. + Returns + ------- + data : numpy.ndarray + Array of column data. + """ if re.match(r'[0-9]*?_',label): idx,key = label.split('_',1) @@ -214,6 +217,11 @@ class Table: info : str, optional Human-readable information about the new data. + Returns + ------- + table : Table + Updated table. + """ dup = self.copy() dup._add_comment(label,data.shape[1:],info) @@ -240,6 +248,11 @@ class Table: info : str, optional Human-readable information about the modified data. + Returns + ------- + table : Table + Updated table. + """ dup = self.copy() dup._add_comment(label,data.shape[1:],info) @@ -263,6 +276,11 @@ class Table: label : str Column label. + Returns + ------- + table : Table + Updated table. + """ dup = self.copy() dup.data.drop(columns=label,inplace=True) @@ -281,6 +299,11 @@ class Table: label_new : str or iterable of str New column label(s). + Returns + ------- + table : Table + Updated table. + """ dup = self.copy() columns = dict(zip([old] if isinstance(old,str) else old, @@ -302,6 +325,11 @@ class Table: ascending : bool or list, optional Set sort order. + Returns + ------- + table : Table + Updated table. + """ dup = self.copy() dup._label_discrete() @@ -322,6 +350,11 @@ class Table: other : Table Table to append. + Returns + ------- + table : Table + Concatenated table. + """ if self.shapes != other.shapes or not self.data.columns.equals(other.data.columns): raise KeyError('Labels or shapes or order do not match') @@ -342,6 +375,11 @@ class Table: other : Table Table to join. + Returns + ------- + table : Table + Joined table. + """ if set(self.shapes) & set(other.shapes) or self.data.shape[0] != other.data.shape[0]: raise KeyError('Dublicated keys or row count mismatch') @@ -382,7 +420,7 @@ class Table: [f'# {comment}' for comment in self.comments] try: - fhandle = open(fname,'w') + fhandle = open(fname,'w',newline='\n') except TypeError: fhandle = fname diff --git a/python/damask/_test.py b/python/damask/_test.py index 000b76e0e..f8fb24cca 100644 --- a/python/damask/_test.py +++ b/python/damask/_test.py @@ -5,6 +5,7 @@ import logging import logging.config from collections.abc import Iterable from optparse import OptionParser +from pathlib import Path import numpy as np @@ -180,7 +181,7 @@ class Test: def fileInRoot(self,dir,file): """Path to a file in the root directory of DAMASK.""" - return str(damask.environment.root_dir/dir/file) + return str(Path(os.environ['DAMASK_ROOT'])/dir/file) def fileInReference(self,file): @@ -282,40 +283,6 @@ class Test: return out,error - - def compare_Array(self,File1,File2): - - import numpy as np - logging.info('\n '.join(['comparing',File1,File2])) - table = damask.Table.load(File1) - len1 = len(table.comments)+2 - table = damask.Table.load(File2) - len2 = len(table.comments)+2 - - refArray = np.nan_to_num(np.genfromtxt(File1,missing_values='n/a',skip_header = len1,autostrip=True)) - curArray = np.nan_to_num(np.genfromtxt(File2,missing_values='n/a',skip_header = len2,autostrip=True)) - - if len(curArray) == len(refArray): - refArrayNonZero = refArray[refArray.nonzero()] - curArray = curArray[refArray.nonzero()] - max_err = np. max(abs(refArrayNonZero[curArray.nonzero()]/curArray[curArray.nonzero()]-1.)) - max_loc = np.argmax(abs(refArrayNonZero[curArray.nonzero()]/curArray[curArray.nonzero()]-1.)) - refArrayNonZero = refArrayNonZero[curArray.nonzero()] - curArray = curArray[curArray.nonzero()] - print(f' ********\n * maximum relative error {max_err} between {refArrayNonZero[max_loc]} and {curArray[max_loc]}\n ********') - return max_err - else: - raise Exception(f'mismatch in array sizes ({len(refArray)} and {len(curArray)}) to compare') - - - def compare_ArrayRefCur(self,ref,cur=''): - - if cur == '': cur = ref - refName = self.fileInReference(ref) - curName = self.fileInCurrent(cur) - return self.compare_Array(refName,curName) - - def compare_Table(self,headings0,file0, headings1,file1, normHeadings='',normType=None, @@ -468,101 +435,6 @@ class Test: return (mean < meanTol) & (std < stdTol) - def compare_Tables(self, - files = [None,None], # list of file names - columns = [None], # list of list of column labels (per file) - rtol = 1e-5, - atol = 1e-8, - debug = False): - """Compare multiple tables with np.allclose.""" - if not (isinstance(files, Iterable) and not isinstance(files, str)): # check whether list of files is requested - files = [str(files)] - - if len(files) < 2: return True # single table is always close to itself... - - tables = [damask.Table.load(filename) for filename in files] - - columns += [columns[0]]*(len(files)-len(columns)) # extend to same length as files - columns = columns[:len(files)] # truncate to same length as files - - for i,column in enumerate(columns): - if column is None: columns[i] = list(tables[i].shapes.keys()) # if no column is given, use all - - logging.info('comparing ASCIItables') - for i in range(len(columns)): - columns[i] = columns[0] if not columns[i] else \ - ([columns[i]] if not (isinstance(columns[i], Iterable) and not isinstance(columns[i], str)) else \ - columns[i] - ) - logging.info(files[i]+': '+','.join(columns[i])) - - dimensions = [np.prod(tables[0].shapes[c]) for c in columns[0]] # width of each requested column - maximum = np.zeros_like(columns[0],dtype=float) # one magnitude per column entry - data = [] # list of feature table extracted from each file (ASCII table) - - for i,(table,labels) in enumerate(zip(tables,columns)): - if np.any(dimensions != [np.prod(table.shapes[c]) for c in labels]): # check data object consistency - logging.critical(f'Table {files[i]} differs in data layout.') - return False - data.append(np.hstack(list(table.get(label) for label in labels)).astype(np.float)) # store - - for j,label in enumerate(labels): # iterate over object labels - maximum[j] = np.maximum( - maximum[j], - np.amax(np.linalg.norm(table.get(label), - axis=1)) - ) # find maximum Euclidean norm across rows - - maximum = np.where(maximum > 0.0, maximum, 1.0) # avoid div by zero for zero columns - maximum = np.repeat(maximum,dimensions) # spread maximum over columns of each object - - for i in range(len(data)): - data[i] /= maximum # normalize each table - logging.info(f'shape of data {i}: {data[i].shape}') - - if debug: - violators = np.absolute(data[0]-data[1]) > atol + rtol*np.absolute(data[1]) - logging.info(f'shape of violators: {violators.shape}') - for j,culprits in enumerate(violators): - goodguys = np.logical_not(culprits) - if culprits.any(): - logging.info(f'{j} has {np.sum(culprits)}') - logging.info(f'deviation: {np.absolute(data[0][j]-data[1][j])[culprits]}') - logging.info(f'data : {np.absolute(data[1][j])[culprits]}') - logging.info(f'deviation: {np.absolute(data[0][j]-data[1][j])[goodguys]}') - logging.info(f'data : {np.absolute(data[1][j])[goodguys]}') - - allclose = True # start optimistic - for i in range(1,len(data)): - allclose &= np.allclose(data[i-1],data[i],rtol,atol) # accumulate "pessimism" - - return allclose - - - def compare_TableRefCur(self,headingsRef,ref,headingsCur='',cur='', - normHeadings='',normType=None, - absoluteTolerance=False,perLine=False,skipLines=[]): - - return self.compare_Table(headingsRef, - self.fileInReference(ref), - headingsRef if headingsCur == '' else headingsCur, - self.fileInCurrent(ref if cur == '' else cur), - normHeadings,normType, - absoluteTolerance,perLine,skipLines) - - - def compare_TableCurCur(self,headingsCur0,Cur0,Cur1, - headingsCur1='', - normHeadings='',normType=None, - absoluteTolerance=False,perLine=False,skipLines=[]): - - return self.compare_Table(headingsCur0, - self.fileInCurrent(Cur0), - headingsCur0 if headingsCur1 == '' else headingsCur1, - self.fileInCurrent(Cur1), - normHeadings,normType,absoluteTolerance,perLine,skipLines) - - def report_Success(self,culprit): ret = culprit diff --git a/python/damask/_vtk.py b/python/damask/_vtk.py index 224412f7c..b9f237297 100644 --- a/python/damask/_vtk.py +++ b/python/damask/_vtk.py @@ -10,7 +10,6 @@ from vtk.util.numpy_support import numpy_to_vtkIdTypeArray as np_to_vtkIdTypeArr from vtk.util.numpy_support import vtk_to_numpy as vtk_to_np from . import util -from . import environment from . import Table @@ -247,8 +246,8 @@ class VTK: raise ValueError('No label defined for numpy.ndarray') N_data = data.shape[0] - d = np_to_vtk((data.astype(np.float32) if data.dtype in [np.float64, np.float128] - else data).reshape(N_data,-1),deep=True) # avoid large files + d = np_to_vtk((data.astype(np.single) if data.dtype in [np.double, np.longdouble] else + data).reshape(N_data,-1),deep=True) # avoid large files d.SetName(label) if N_data == N_points: @@ -348,6 +347,21 @@ class VTK: See http://compilatrix.com/article/vtk-1 for further ideas. """ + try: + import wx + _ = wx.App(False) # noqa + width, height = wx.GetDisplaySize() + except ImportError: + try: + import tkinter + tk = tkinter.Tk() + width = tk.winfo_screenwidth() + height = tk.winfo_screenheight() + tk.destroy() + except Exception as e: + width = 1024 + height = 768 + mapper = vtk.vtkDataSetMapper() mapper.SetInputData(self.vtk_data) actor = vtk.vtkActor() @@ -361,7 +375,7 @@ class VTK: ren.AddActor(actor) ren.SetBackground(0.2,0.2,0.2) - window.SetSize(environment.screen_size[0],environment.screen_size[1]) + window.SetSize(width,height) iren = vtk.vtkRenderWindowInteractor() iren.SetRenderWindow(window) diff --git a/python/damask/solver/_marc.py b/python/damask/solver/_marc.py index 5ddcf8898..f6c81da9f 100644 --- a/python/damask/solver/_marc.py +++ b/python/damask/solver/_marc.py @@ -2,14 +2,13 @@ import subprocess import shlex import re import io +import os from pathlib import Path -from .. import environment - class Marc: """Wrapper to run DAMASK with MSCMarc.""" - def __init__(self,version=environment.options['MSC_VERSION']): + def __init__(self,version=os.environ['MSC_VERSION']): """ Create a Marc solver object. @@ -25,9 +24,7 @@ class Marc: @property def library_path(self): - path_MSC = environment.options['MSC_ROOT'] - path_lib = Path(f'{path_MSC}/mentat{self.version}/shlib/linux64') - + path_lib = Path(f'{os.environ["MSC_ROOT"]}/mentat{self.version}/shlib/linux64') if not path_lib.is_dir(): raise FileNotFoundError(f'library path "{path_lib}" not found') @@ -37,9 +34,7 @@ class Marc: @property def tools_path(self): - path_MSC = environment.options['MSC_ROOT'] - path_tools = Path(f'{path_MSC}/marc{self.version}/tools') - + path_tools = Path(f'{os.environ["MSC_ROOT"]}/marc{self.version}/tools') if not path_tools.is_dir(): raise FileNotFoundError(f'tools path "{path_tools}" not found') @@ -54,7 +49,7 @@ class Marc: optimization = '', ): - usersub = environment.root_dir/'src/DAMASK_marc' + usersub = Path(os.environ['DAMASK_ROOT'])/'src/DAMASK_marc' usersub = usersub.parent/(usersub.name + ('.f90' if compile else '.marc')) if not usersub.is_file(): raise FileNotFoundError(f'subroutine ({"source" if compile else "binary"}) "{usersub}" not found') @@ -71,7 +66,7 @@ class Marc: if logfile is not None: try: - f = open(logfile,'w+') + f = open(logfile,'w+',newline='\n') except TypeError: f = logfile else: diff --git a/python/damask/util.py b/python/damask/util.py index fb122bd11..3722fe33f 100644 --- a/python/damask/util.py +++ b/python/damask/util.py @@ -133,6 +133,8 @@ def execute(cmd, stdout = stdout.decode('utf-8').replace('\x08','') stderr = stderr.decode('utf-8').replace('\x08','') if process.returncode != 0: + print(stdout) + print(stderr) raise RuntimeError(f"'{cmd}' failed with returncode {process.returncode}") return stdout, stderr @@ -183,7 +185,7 @@ def scale_to_coprime(v): # Python 3.9 provides math.lcm, see https://stackoverflow.com/questions/51716916. return a * b // np.gcd(a, b) - m = (np.array(v) * reduce(lcm, map(lambda x: int(get_square_denominator(x)),v)) ** 0.5).astype(np.int) + m = (np.array(v) * reduce(lcm, map(lambda x: int(get_square_denominator(x)),v)) ** 0.5).astype(int) m = m//reduce(np.gcd,m) with np.errstate(invalid='ignore'): @@ -193,7 +195,7 @@ def scale_to_coprime(v): return m -def project_stereographic(vector,normalize=False): +def project_stereographic(vector,direction='z',normalize=True,keepdims=False): """ Apply stereographic projection to vector. @@ -201,18 +203,37 @@ def project_stereographic(vector,normalize=False): ---------- vector : numpy.ndarray of shape (...,3) Vector coordinates to be projected. + direction : str + Projection direction 'x', 'y', or 'z'. + Defaults to 'z'. normalize : bool - Ensure unit length for vector. Defaults to False. + Ensure unit length of input vector. Defaults to True. + keepdims : bool + Maintain three-dimensional output coordinates. + Default two-dimensional output uses right-handed frame spanned by + the next and next-next axis relative to the projection direction, + e.g. x-y when projecting along z and z-x when projecting along y. Returns ------- - coordinates : numpy.ndarray of shape (...,2) + coordinates : numpy.ndarray of shape (...,2 | 3) Projected coordinates. + Examples + -------- + >>> project_stereographic(np.ones(3)) + [0.3660254, 0.3660254] + >>> project_stereographic(np.ones(3),direction='x',normalize=False,keepdims=True) + [0, 0.5, 0.5] + >>> project_stereographic([0,1,1],direction='y',normalize=True,keepdims=False) + [0.41421356, 0] + """ - v_ = vector/np.linalg.norm(vector,axis=-1,keepdims=True) if normalize else vector - return np.block([v_[...,:2]/(1+np.abs(v_[...,2:3])), - np.zeros_like(v_[...,2:3])]) + shift = 'zyx'.index(direction) + v_ = np.roll(vector/np.linalg.norm(vector,axis=-1,keepdims=True) if normalize else vector, + shift,axis=-1) + return np.roll(np.block([v_[...,:2]/(1+np.abs(v_[...,2:3])),np.zeros_like(v_[...,2:3])]), + -shift if keepdims else 0,axis=-1)[...,:3 if keepdims else 2] def execution_stamp(class_name,function_name=None): @@ -418,7 +439,7 @@ class _ProgressBar: bar = '█' * filled_length + '░' * (self.bar_length - filled_length) delta_time = datetime.datetime.now() - self.start_time remaining_time = (self.total - (iteration+1)) * delta_time / (iteration+1) - remaining_time -= datetime.timedelta(microseconds=remaining_time.microseconds) # remove μs + remaining_time -= datetime.timedelta(microseconds=remaining_time.microseconds) # remove μs sys.stderr.write(f'\r{self.prefix} {bar} {fraction:>4.0%} ETA {remaining_time}') sys.stderr.flush() diff --git a/python/setup.py b/python/setup.py index 19fbdcd13..0642c0b7d 100644 --- a/python/setup.py +++ b/python/setup.py @@ -6,28 +6,29 @@ with open(Path(__file__).parent/'damask/VERSION') as f: version = re.sub(r'(-([^-]*)).*$',r'.\2',re.sub(r'^v(\d+\.\d+(\.\d+)?)',r'\1',f.readline().strip())) setuptools.setup( - name="damask", + name='damask', version=version, - author="The DAMASK team", - author_email="damask@mpie.de", - description="DAMASK library", - long_description="Python library for pre and post processing of DAMASK simulations", - url="https://damask.mpie.de", + author='The DAMASK team', + author_email='damask@mpie.de', + description='DAMASK library', + long_description='Python library for pre and post processing of DAMASK simulations', + url='https://damask.mpie.de', packages=setuptools.find_packages(), include_package_data=True, + python_requires = '>=3.6', install_requires = [ - "pandas", # requires numpy - "scipy", - "h5py", # requires numpy - "vtk", - "matplotlib", # requires numpy, pillow - "pyaml" + 'pandas>=0.24', # requires numpy + 'scipy>=1.2', + 'h5py>=2.9', # requires numpy + 'vtk>=8.1', + 'matplotlib>=3.0', # requires numpy, pillow + 'pyaml>=3.12' ], classifiers = [ - "Intended Audience :: Science/Research", - "Topic :: Scientific/Engineering", - "Programming Language :: Python :: 3", - "License :: OSI Approved :: GNU General Public License v3 or later (GPLv3+)", - "Operating System :: OS Independent", + 'Intended Audience :: Science/Research', + 'Topic :: Scientific/Engineering', + 'Programming Language :: Python :: 3', + 'License :: OSI Approved :: GNU General Public License v3 or later (GPLv3+)', + 'Operating System :: OS Independent', ], ) diff --git a/python/tests/reference/ConfigMaterial/material.yaml b/python/tests/reference/ConfigMaterial/material.yaml index fbba6a631..48ebd98e3 100644 --- a/python/tests/reference/ConfigMaterial/material.yaml +++ b/python/tests/reference/ConfigMaterial/material.yaml @@ -1,32 +1,32 @@ homogenization: SX: N_constituents: 1 - mechanics: {type: none} + mechanics: {type: pass} Taylor: N_constituents: 2 mechanics: {type: isostrain} material: - constituents: - - fraction: 1.0 + - v: 1.0 O: [1.0, 0.0, 0.0, 0.0] phase: Aluminum homogenization: SX - constituents: - - fraction: 1.0 + - v: 1.0 O: [0.7936696712125002, -0.28765777461664166, -0.3436487135089419, 0.4113964260949434] phase: Aluminum homogenization: SX - constituents: - - fraction: 1.0 + - v: 1.0 O: [0.3986143167493579, -0.7014883552495493, 0.2154871765709027, 0.5500781677772945] phase: Aluminum homogenization: SX - constituents: - - fraction: 0.5 + - v: 0.5 O: [0.28645844315788244, -0.022571491243423537, -0.467933059311115, -0.8357456192708106] phase: Aluminum - - fraction: 0.5 + - v: 0.5 O: [0.3986143167493579, -0.7014883552495493, 0.2154871765709027, 0.5500781677772945] phase: Steel homogenization: Taylor diff --git a/python/tests/test_Config.py b/python/tests/test_Config.py index 67c419b3e..9324c28c5 100644 --- a/python/tests/test_Config.py +++ b/python/tests/test_Config.py @@ -22,6 +22,19 @@ class TestConfig: with open(tmp_path/'config.yaml') as f: assert Config.load(f) == config + def test_add_remove(self): + dummy = {'hello':'world','foo':'bar'} + config = Config() + config |= dummy + assert config == Config() | dummy + config = config.delete(dummy) + assert config == Config() + assert (config | dummy ).delete( 'hello' ) == config | {'foo':'bar'} + assert (config | dummy ).delete([ 'hello', 'foo' ]) == config + assert (config | Config(dummy)).delete({ 'hello':1,'foo':2 }) == config + assert (config | Config(dummy)).delete(Config({'hello':1 })) == config | {'foo':'bar'} + + def test_repr(self,tmp_path): config = Config() config['A'] = 1 diff --git a/python/tests/test_ConfigMaterial.py b/python/tests/test_ConfigMaterial.py index 45dc3b97f..5eb9a6c85 100644 --- a/python/tests/test_ConfigMaterial.py +++ b/python/tests/test_ConfigMaterial.py @@ -5,6 +5,7 @@ import numpy as np from damask import ConfigMaterial from damask import Table +from damask import Rotation @pytest.fixture def ref_path(ref_path_base): @@ -42,7 +43,7 @@ class TestConfigMaterial: def test_invalid_fraction(self,ref_path): material_config = ConfigMaterial.load(ref_path/'material.yaml') - material_config['material'][0]['constituents'][0]['fraction']=.9 + material_config['material'][0]['constituents'][0]['v']=.9 assert not material_config.is_valid @pytest.mark.parametrize('item',['homogenization','phase','material']) @@ -85,42 +86,25 @@ class TestConfigMaterial: def test_from_table(self): N = np.random.randint(3,10) - a = np.vstack((np.hstack((np.arange(N),np.arange(N)[::-1])),np.ones(N*2),np.zeros(N*2),np.ones(N*2))).T - t = Table(a,{'varying':2,'constant':2}) - c = ConfigMaterial.from_table(t,constituents={'a':'varying','b':'1_constant'},c='2_constant') + a = np.vstack((np.hstack((np.arange(N),np.arange(N)[::-1])),np.ones(N*2),np.zeros(N*2),np.ones(N*2),np.ones(N*2))).T + t = Table(a,{'varying':1,'constant':4}) + c = ConfigMaterial.from_table(t,**{'phase':'varying','O':'constant','homogenization':'4_constant'}) assert len(c['material']) == N for i,m in enumerate(c['material']): - c = m['constituents'][0] - assert m['c'] == 1 and c['b'] == 0 and (c['a'] == [i,1]).all() + assert m['homogenization'] == 1 and (m['constituents'][0]['O'] == [1,0,1,1]).all() - def test_constituents(self): - c = ConfigMaterial._constituents(c=1,v=[2,3]) - assert c[0][0]['c'] == c[1][0]['c'] == 1 - assert c[0][0]['v'] == c[1][0]['v'] -1 ==2 - - @pytest.mark.parametrize('constituents',[{'W':1,'X':[2,3]},{'Y':4},{'Z':[5,6]}]) - @pytest.mark.parametrize('a',[[7.,8.],9.]) - @pytest.mark.parametrize('b',['bd',['efg','hi']]) - def test_material_add(self,tmp_path,constituents,a,b): - len_c = len(ConfigMaterial()._constituents(1,**constituents)) - len_a = len(a) if isinstance(a,list) else 1 - len_b = len(b) if isinstance(b,list) else 1 - m = ConfigMaterial().material_add(constituents,a=a,b=b) - m.save() - assert len(m['material']) == np.max([len_a,len_b,len_c]) - - @pytest.mark.parametrize('constituents',[{'W':1,'X':np.array([2,3])},{'Y':4},{'Z':np.array([5,6])}]) - @pytest.mark.parametrize('a',[np.array([7,8]),9]) - def test_material_add_np(self,tmp_path,constituents,a): - len_c = len(ConfigMaterial()._constituents(1,**constituents)) - len_a = len(a) if isinstance(a,np.ndarray) else 1 - m = ConfigMaterial().material_add(constituents,ld=a) - m.save() - assert len(m['material']) == np.max([len_a,len_c]) - - @pytest.mark.parametrize('constituents',[{'X':np.array([2,3,4,5])},{'Y':4}]) - @pytest.mark.parametrize('a',[np.array([1,2,3]),[4,5,6]]) - @pytest.mark.parametrize('b',[np.array([6.,7.]),[8.,9.]]) - def test_material_add_invalid(self,constituents,a,b): - with pytest.raises(ValueError): - ConfigMaterial().material_add(constituents,a=a,u=b) + @pytest.mark.parametrize('N,n,kw',[ + (1,1,{'phase':'Gold', + 'O':[1,0,0,0], + 'homogenization':'SX'}), + (3,1,{'phase':'Gold', + 'O':Rotation.from_random(3), + 'homogenization':'SX'}), + (2,3,{'phase':np.broadcast_to(['a','b','c'],(2,3)), + 'O':Rotation.from_random((2,3)), + 'homogenization':['SX','PX']}), + ]) + def test_material_add(self,kw,N,n): + m = ConfigMaterial().material_add(**kw) + assert len(m['material']) == N + assert len(m['material'][0]['constituents']) == n diff --git a/python/tests/test_Grid.py b/python/tests/test_Grid.py index 48831f917..a239165db 100644 --- a/python/tests/test_Grid.py +++ b/python/tests/test_Grid.py @@ -347,7 +347,7 @@ class TestGrid: @pytest.mark.parametrize('approach',['Laguerre','Voronoi']) def test_tessellate_bicrystal(self,approach): cells = np.random.randint(5,10,3)*2 - size = cells.astype(np.float) + size = cells.astype(float) seeds = np.vstack((size*np.array([0.5,0.25,0.5]),size*np.array([0.5,0.75,0.5]))) material = np.zeros(cells) material[:,cells[1]//2:,:] = 1 diff --git a/python/tests/test_Orientation.py b/python/tests/test_Orientation.py index 5ab0361a8..40d4d0116 100644 --- a/python/tests/test_Orientation.py +++ b/python/tests/test_Orientation.py @@ -7,6 +7,7 @@ from damask import Orientation from damask import Table from damask import lattice from damask import util +from damask import grid_filters @pytest.fixture @@ -25,13 +26,16 @@ class TestOrientation: @pytest.mark.parametrize('shape',[None,5,(4,6)]) def test_equal(self,lattice,shape): R = Rotation.from_random(shape) - assert Orientation(R,lattice) == Orientation(R,lattice) + assert Orientation(R,lattice) == Orientation(R,lattice) if shape is None else \ + (Orientation(R,lattice) == Orientation(R,lattice)).all() + @pytest.mark.parametrize('lattice',Orientation.crystal_families) @pytest.mark.parametrize('shape',[None,5,(4,6)]) def test_unequal(self,lattice,shape): R = Rotation.from_random(shape) - assert not(Orientation(R,lattice) != Orientation(R,lattice)) + assert not ( Orientation(R,lattice) != Orientation(R,lattice) if shape is None else \ + (Orientation(R,lattice) != Orientation(R,lattice)).any()) @pytest.mark.parametrize('a,b',[ (dict(rotation=[1,0,0,0]), @@ -115,7 +119,7 @@ class TestOrientation: == np.eye(3)) def test_from_cubochoric(self): - assert np.all(Orientation.from_cubochoric(c=np.zeros(3),lattice='triclinic').as_matrix() + assert np.all(Orientation.from_cubochoric(x=np.zeros(3),lattice='triclinic').as_matrix() == np.eye(3)) def test_from_spherical_component(self): @@ -138,7 +142,7 @@ class TestOrientation: dict(lattice='hP',a=1.0 ), dict(lattice='cI',a=1.0, ), ]) - def test_from_direction(self,kwargs): + def test_from_directions(self,kwargs): for a,b in np.random.random((10,2,3)): c = np.cross(b,a) if np.all(np.isclose(c,0)): continue @@ -148,6 +152,21 @@ class TestOrientation: assert np.isclose(np.dot(x/np.linalg.norm(x),np.array([1,0,0])),1) \ and np.isclose(np.dot(z/np.linalg.norm(z),np.array([0,0,1])),1) + @pytest.mark.parametrize('function',[Orientation.from_random, + Orientation.from_quaternion, + Orientation.from_Euler_angles, + Orientation.from_axis_angle, + Orientation.from_basis, + Orientation.from_matrix, + Orientation.from_Rodrigues_vector, + Orientation.from_homochoric, + Orientation.from_cubochoric, + Orientation.from_spherical_component, + Orientation.from_fiber_component, + Orientation.from_directions]) + def test_invalid_from(self,function): + with pytest.raises(TypeError): + function(c=.1,degrees=True,invalid=66) def test_negative_angle(self): with pytest.raises(ValueError): @@ -218,6 +237,16 @@ class TestOrientation: for r, theO in zip(o.reduced.flatten(),o.flatten()): assert r == theO.reduced + @pytest.mark.parametrize('lattice',Orientation.crystal_families) + def test_reduced_corner_cases(self,lattice): + # test whether there is always a sym-eq rotation that falls into the FZ + N = np.random.randint(10,40) + size = np.ones(3)*np.pi**(2./3.) + grid = grid_filters.coordinates0_node([N+1,N+1,N+1],size,-size*.5) + evenly_distributed = Orientation.from_cubochoric(x=grid[:-2,:-2,:-2],lattice=lattice) + assert evenly_distributed.shape == evenly_distributed.reduced.shape + + @pytest.mark.parametrize('lattice',Orientation.crystal_families) @pytest.mark.parametrize('shape',[(1),(2,3),(4,3,2)]) @pytest.mark.parametrize('vector',np.array([[1,0,0],[1,2,3],[-1,1,-1]])) @@ -403,7 +432,7 @@ class TestOrientation: def test_relationship_vectorize(self,set_of_quaternions,lattice,model): r = Orientation(rotation=set_of_quaternions[:200].reshape((50,4,4)),lattice=lattice).related(model) for i in range(200): - assert r.reshape((-1,200))[:,i] == Orientation(set_of_quaternions[i],lattice).related(model) + assert (r.reshape((-1,200))[:,i] == Orientation(set_of_quaternions[i],lattice).related(model)).all() @pytest.mark.parametrize('model',['Bain','KS','GT','GT_prime','NW','Pitsch']) @pytest.mark.parametrize('lattice',['cF','cI']) diff --git a/python/tests/test_Result.py b/python/tests/test_Result.py index b8447b8b0..9973e7e7c 100644 --- a/python/tests/test_Result.py +++ b/python/tests/test_Result.py @@ -21,7 +21,7 @@ def default(tmp_path,ref_path): fname = '12grains6x7x8_tensionY.hdf5' shutil.copy(ref_path/fname,tmp_path) f = Result(tmp_path/fname) - f.pick('times',20.0) + f.view('times',20.0) return f @pytest.fixture @@ -43,56 +43,56 @@ class TestResult: print(default) - def test_pick_all(self,default): - default.pick('increments',True) + def test_view_all(self,default): + default.view('increments',True) a = default.get_dataset_location('F') - default.pick('increments','*') + default.view('increments','*') b = default.get_dataset_location('F') - default.pick('increments',default.incs_in_range(0,np.iinfo(int).max)) + default.view('increments',default.incs_in_range(0,np.iinfo(int).max)) c = default.get_dataset_location('F') - default.pick('times',True) + default.view('times',True) d = default.get_dataset_location('F') - default.pick('times','*') + default.view('times','*') e = default.get_dataset_location('F') - default.pick('times',default.times_in_range(0.0,np.inf)) + default.view('times',default.times_in_range(0.0,np.inf)) f = default.get_dataset_location('F') assert a == b == c == d == e ==f @pytest.mark.parametrize('what',['increments','times','phases']) # ToDo: discuss homogenizations - def test_pick_none(self,default,what): - default.pick(what,False) + def test_view_none(self,default,what): + default.view(what,False) a = default.get_dataset_location('F') - default.pick(what,[]) + default.view(what,[]) b = default.get_dataset_location('F') assert a == b == [] @pytest.mark.parametrize('what',['increments','times','phases']) # ToDo: discuss homogenizations - def test_pick_more(self,default,what): - default.pick(what,False) - default.pick_more(what,'*') + def test_view_more(self,default,what): + default.view(what,False) + default.view_more(what,'*') a = default.get_dataset_location('F') - default.pick(what,True) + default.view(what,True) b = default.get_dataset_location('F') assert a == b @pytest.mark.parametrize('what',['increments','times','phases']) # ToDo: discuss homogenizations - def test_pick_less(self,default,what): - default.pick(what,True) - default.pick_less(what,'*') + def test_view_less(self,default,what): + default.view(what,True) + default.view_less(what,'*') a = default.get_dataset_location('F') - default.pick(what,False) + default.view(what,False) b = default.get_dataset_location('F') assert a == b == [] - def test_pick_invalid(self,default): + def test_view_invalid(self,default): with pytest.raises(AttributeError): - default.pick('invalid',True) + default.view('invalid',True) def test_add_absolute(self,default): default.add_absolute('F_e') @@ -307,7 +307,7 @@ class TestResult: @pytest.mark.parametrize('overwrite',['off','on']) def test_add_overwrite(self,default,overwrite): - default.pick('times',default.times_in_range(0,np.inf)[-1]) + default.view('times',default.times_in_range(0,np.inf)[-1]) default.add_stress_Cauchy() loc = default.get_dataset_location('sigma') diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index 36e3a3ac9..b28a849c5 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -526,7 +526,7 @@ class TestRotation: o = backward(forward(m)) u = np.array([np.pi*2,np.pi,np.pi*2]) ok = np.allclose(m,o,atol=atol) - ok = ok or np.allclose(np.where(np.isclose(m,u),m-u,m),np.where(np.isclose(o,u),o-u,o),atol=atol) + ok |= np.allclose(np.where(np.isclose(m,u),m-u,m),np.where(np.isclose(o,u),o-u,o),atol=atol) if np.isclose(m[1],0.0,atol=atol) or np.isclose(m[1],np.pi,atol=atol): sum_phi = np.unwrap([m[0]+m[2],o[0]+o[2]]) ok |= np.isclose(sum_phi[0],sum_phi[1],atol=atol) @@ -550,19 +550,22 @@ class TestRotation: assert ok and np.isclose(np.linalg.norm(o[:3]),1.0) and o[3]<=np.pi+1.e-9, f'{m},{o},{rot.as_quaternion()}' @pytest.mark.parametrize('forward,backward',[(Rotation._ro2qu,Rotation._qu2ro), - #(Rotation._ro2om,Rotation._om2ro), - #(Rotation._ro2eu,Rotation._eu2ro), + (Rotation._ro2om,Rotation._om2ro), + (Rotation._ro2eu,Rotation._eu2ro), (Rotation._ro2ax,Rotation._ax2ro), (Rotation._ro2ho,Rotation._ho2ro), (Rotation._ro2cu,Rotation._cu2ro)]) def test_Rodrigues_internal(self,set_of_rotations,forward,backward): """Ensure invariance of conversion from Rodrigues-Frank vector and back.""" - cutoff = np.tan(np.pi*.5*(1.-1e-4)) + cutoff = np.tan(np.pi*.5*(1.-1e-5)) for rot in set_of_rotations: m = rot.as_Rodrigues_vector() o = backward(forward(m)) ok = np.allclose(np.clip(m,None,cutoff),np.clip(o,None,cutoff),atol=atol) - ok = ok or np.isclose(m[3],0.0,atol=atol) + ok |= np.isclose(m[3],0.0,atol=atol) + if m[3] > cutoff: + ok |= np.allclose(m[:3],-1*o[:3]) + assert ok and np.isclose(np.linalg.norm(o[:3]),1.0), f'{m},{o},{rot.as_quaternion()}' @pytest.mark.parametrize('forward,backward',[(Rotation._ho2qu,Rotation._qu2ho), @@ -592,7 +595,7 @@ class TestRotation: o = backward(forward(m)) ok = np.allclose(m,o,atol=atol) if np.count_nonzero(np.isclose(np.abs(o),np.pi**(2./3.)*.5)): - ok = ok or np.allclose(m*-1.,o,atol=atol) + ok |= np.allclose(m*-1.,o,atol=atol) assert ok and np.max(np.abs(o)) < np.pi**(2./3.) * 0.5 + 1.e-9, f'{m},{o},{rot.as_quaternion()}' @pytest.mark.parametrize('vectorized, single',[(Rotation._qu2om,qu2om), @@ -686,6 +689,10 @@ class TestRotation: with pytest.raises(TypeError): Rotation(np.ones(3)) + def test_to_numpy(self): + r = Rotation.from_random(np.random.randint(0,10,4)) + assert np.all(r.as_quaternion() == np.array(r)) + @pytest.mark.parametrize('degrees',[True,False]) def test_Eulers(self,set_of_rotations,degrees): for rot in set_of_rotations: @@ -719,7 +726,7 @@ class TestRotation: o = Rotation.from_axis_angle(rot.as_axis_angle()).as_axis_angle() ok = np.allclose(m,o,atol=atol) if np.isclose(m[3],np.pi,atol=atol): - ok = ok or np.allclose(m*np.array([-1.,-1.,-1.,1.]),o,atol=atol) + ok |= np.allclose(m*np.array([-1.,-1.,-1.,1.]),o,atol=atol) assert ok and np.isclose(np.linalg.norm(o[:3]),1.0) \ and o[3]<=np.pi+1.e-9, f'{m},{o},{rot.as_quaternion()}' @@ -740,7 +747,7 @@ class TestRotation: m = rot.as_Rodrigues_vector() o = Rotation.from_homochoric(rot.as_homochoric()*P*-1,P).as_Rodrigues_vector() ok = np.allclose(np.clip(m,None,cutoff),np.clip(o,None,cutoff),atol=atol) - ok = ok or np.isclose(m[3],0.0,atol=atol) + ok |= np.isclose(m[3],0.0,atol=atol) assert ok and np.isclose(np.linalg.norm(o[:3]),1.0), f'{m},{o},{rot.as_quaternion()}' @pytest.mark.parametrize('P',[1,-1]) @@ -780,14 +787,32 @@ class TestRotation: else: assert r.shape == shape - def test_equal(self): - assert Rotation.from_random(rng_seed=1) == Rotation.from_random(rng_seed=1) + @pytest.mark.parametrize('shape',[None,5,(4,6)]) + def test_equal(self,shape): + R = Rotation.from_random(shape,rng_seed=1) + assert R == R if shape is None else (R == R).all() + + @pytest.mark.parametrize('shape',[None,5,(4,6)]) + def test_unequal(self,shape): + R = Rotation.from_random(shape,rng_seed=1) + assert not (R != R if shape is None else (R != R).any()) + + + def test_equal_ambiguous(self): + qu = np.random.rand(10,4) + qu[:,0] = 0. + qu/=np.linalg.norm(qu,axis=1,keepdims=True) + assert (Rotation(qu) == Rotation(-qu)).all() def test_inversion(self): r = Rotation.from_random() assert r == ~~r - @pytest.mark.parametrize('shape',[None,1,(1,),(4,2),(1,1,1)]) + @pytest.mark.parametrize('shape',[1,(1,),(4,2),(1,1,1),tuple(np.random.randint(0,10,4))]) + def test_size(self,shape): + assert Rotation.from_random(shape).size == np.prod(shape) + + @pytest.mark.parametrize('shape',[None,1,(1,),(4,2),(1,1,1),tuple(np.random.randint(0,10,4))]) def test_shape(self,shape): r = Rotation.from_random(shape=shape) assert r.shape == (shape if isinstance(shape,tuple) else (shape,) if shape else ()) @@ -798,7 +823,7 @@ class TestRotation: p = Rotation.from_random(shape=shape) s = r.append(p) print(f'append 2x {shape} --> {s.shape}') - assert s[0,...] == r[0,...] and s[-1,...] == p[-1,...] + assert np.logical_and(s[0,...] == r[0,...], s[-1,...] == p[-1,...]).all() @pytest.mark.parametrize('shape',[None,1,(1,),(4,2),(3,3,2)]) def test_append_list(self,shape): @@ -806,7 +831,7 @@ class TestRotation: p = Rotation.from_random(shape=shape) s = r.append([r,p]) print(f'append 3x {shape} --> {s.shape}') - assert s[0,...] == r[0,...] and s[-1,...] == p[-1,...] + assert np.logical_and(s[0,...] == r[0,...], s[-1,...] == p[-1,...]).all() @pytest.mark.parametrize('quat,standardized',[ ([-1,0,0,0],[1,0,0,0]), @@ -828,7 +853,7 @@ class TestRotation: @pytest.mark.parametrize('order',['C','F']) def test_flatten_reshape(self,shape,order): r = Rotation.from_random(shape=shape) - assert r == r.flatten(order).reshape(shape,order) + assert (r == r.flatten(order).reshape(shape,order)).all() @pytest.mark.parametrize('function',[Rotation.from_quaternion, Rotation.from_Euler_angles, @@ -939,7 +964,7 @@ class TestRotation: def test_rotate_inverse(self): R = Rotation.from_random() - assert np.allclose(np.eye(3),(~R@R).as_matrix()) + assert np.allclose(np.eye(3),(~R*R).as_matrix()) @pytest.mark.parametrize('data',[np.random.rand(3), np.random.rand(3,3), @@ -973,6 +998,42 @@ class TestRotation: R_2 = Rotation.from_Euler_angles([360,0,0],degrees=True) assert np.allclose(R_1.misorientation(R_2).as_matrix(),np.eye(3)) + def test_composition(self): + a,b = (Rotation.from_random(),Rotation.from_random()) + c = a * b + a *= b + assert c == a + + def test_composition_invalid(self): + with pytest.raises(TypeError): + Rotation()*np.ones(3) + + def test_composition_inverse(self): + a,b = (Rotation.from_random(),Rotation.from_random()) + c = a / b + a /= b + assert c == a + + def test_composition_inverse_invalid(self): + with pytest.raises(TypeError): + Rotation()/np.ones(3) + + def test_power(self): + a = Rotation.from_random() + r = (np.random.rand()-.5)*4 + b = a**r + a **= r + assert a == b + + def test_invariant(self): + R = Rotation.from_random() + assert R/R == R*R**(-1) == Rotation() + + @pytest.mark.parametrize('item',[np.ones(3),np.ones((3,3)), np.ones((3,3,3,3))]) + def test_apply(self,item): + r = Rotation.from_random() + assert (r.apply(item) == r@item).all() + @pytest.mark.parametrize('angle',[10,20,30,40,50,60,70,80,90,100,120]) def test_average(self,angle): R = Rotation.from_axis_angle([[0,0,1,10],[0,0,1,angle]],degrees=True) diff --git a/python/tests/test_util.py b/python/tests/test_util.py index eb1084b09..397926682 100644 --- a/python/tests/test_util.py +++ b/python/tests/test_util.py @@ -49,17 +49,18 @@ class TestUtil: dist_sampled = np.histogram(centers[selected],bins)[0]/N_samples*np.sum(dist) assert np.sqrt(((dist - dist_sampled) ** 2).mean()) < .025 and selected.shape[0]==N_samples - @pytest.mark.parametrize('point,normalize,answer', + @pytest.mark.parametrize('point,direction,normalize,keepdims,answer', [ - ([1,0,0],False,[1,0,0]), - ([1,0,0],True, [1,0,0]), - ([0,1,1],False,[0,0.5,0]), - ([0,1,1],True, [0,0.41421356,0]), - ([1,1,1],False,[0.5,0.5,0]), - ([1,1,1],True, [0.3660254, 0.3660254, 0]), + ([1,0,0],'z',False,True, [1,0,0]), + ([1,0,0],'z',True, False,[1,0]), + ([0,1,1],'z',False,True, [0,0.5,0]), + ([0,1,1],'y',True, False,[0.41421356,0]), + ([1,1,0],'x',False,False,[0.5,0]), + ([1,1,1],'y',True, True, [0.3660254, 0,0.3660254]), ]) - def test_project_stereographic(self,point,normalize,answer): - assert np.allclose(util.project_stereographic(np.array(point),normalize=normalize),answer) + def test_project_stereographic(self,point,direction,normalize,keepdims,answer): + assert np.allclose(util.project_stereographic(np.array(point),direction=direction, + normalize=normalize,keepdims=keepdims),answer) @pytest.mark.parametrize('fro,to,mode,answer', [ diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index 240688a8c..01b4c034d 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -19,7 +19,7 @@ module CPFEM use HDF5_utilities use results use lattice - use constitutive + use phase implicit none private @@ -72,7 +72,6 @@ contains !-------------------------------------------------------------------------------------------------- subroutine CPFEM_initAll - call parallelization_init call DAMASK_interface_init call prec_init call IO_init @@ -86,7 +85,7 @@ subroutine CPFEM_initAll call discretization_marc_init call lattice_init call material_init(.false.) - call constitutive_init + call phase_init call homogenization_init call crystallite_init call CPFEM_init @@ -179,11 +178,11 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS if (iand(mode, CPFEM_AGERESULTS) /= 0_pInt) call CPFEM_forward - chosenThermal1: select case (thermal_type(material_homogenizationAt(elCP))) - case (THERMAL_conduction_ID) chosenThermal1 - temperature(material_homogenizationAt(elCP))%p(material_homogenizationMemberAt(ip,elCP)) = & - temperature_inp - end select chosenThermal1 + !chosenThermal1: select case (thermal_type(material_homogenizationAt(elCP))) + ! case (THERMAL_conduction_ID) chosenThermal1 + ! temperature(material_homogenizationAt(elCP))%p(material_homogenizationMemberAt(ip,elCP)) = & + ! temperature_inp + !end select chosenThermal1 homogenization_F0(1:3,1:3,ma) = ffn homogenization_F(1:3,1:3,ma) = ffn1 @@ -258,7 +257,7 @@ end subroutine CPFEM_general subroutine CPFEM_forward call homogenization_forward - call constitutive_forward + call phase_forward end subroutine CPFEM_forward @@ -273,7 +272,7 @@ subroutine CPFEM_results(inc,time) call results_openJobFile call results_addIncrement(inc,time) - call constitutive_results + call phase_results call homogenization_results call discretization_results call results_finalizeIncrement diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 5a500875d..bf044bef9 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -19,7 +19,7 @@ module CPFEM2 use discretization use HDF5_utilities use homogenization - use constitutive + use phase #if defined(Mesh) use FEM_quadrature use discretization_mesh @@ -60,7 +60,7 @@ subroutine CPFEM_initAll call discretization_grid_init(restart=interface_restartInc>0) #endif call material_init(restart=interface_restartInc>0) - call constitutive_init + call phase_init call homogenization_init call crystallite_init call CPFEM_init @@ -74,9 +74,22 @@ end subroutine CPFEM_initAll !-------------------------------------------------------------------------------------------------- subroutine CPFEM_init + integer(HID_T) :: fileHandle + + print'(/,a)', ' <<<+- CPFEM init -+>>>'; flush(IO_STDOUT) - if (interface_restartInc > 0) call crystallite_restartRead + + if (interface_restartInc > 0) then + print'(/,a,i0,a)', ' reading restart information of increment from file'; flush(IO_STDOUT) + + fileHandle = HDF5_openFile(getSolverJobName()//'_restart.hdf5','r') + + call homogenization_restartRead(fileHandle) + call phase_restartRead(fileHandle) + + call HDF5_closeFile(fileHandle) + endif end subroutine CPFEM_init @@ -86,7 +99,17 @@ end subroutine CPFEM_init !-------------------------------------------------------------------------------------------------- subroutine CPFEM_restartWrite - call crystallite_restartWrite + integer(HID_T) :: fileHandle + + + print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT) + + fileHandle = HDF5_openFile(getSolverJobName()//'_restart.hdf5','a') + + call homogenization_restartWrite(fileHandle) + call phase_restartWrite(fileHandle) + + call HDF5_closeFile(fileHandle) end subroutine CPFEM_restartWrite @@ -97,7 +120,7 @@ end subroutine CPFEM_restartWrite subroutine CPFEM_forward call homogenization_forward - call constitutive_forward + call phase_forward end subroutine CPFEM_forward @@ -112,7 +135,7 @@ subroutine CPFEM_results(inc,time) call results_openJobFile call results_addIncrement(inc,time) - call constitutive_results + call phase_results call homogenization_results call discretization_results call results_finalizeIncrement diff --git a/src/C_routines.c b/src/C_routines.c index 4b07c0ee0..3d62a87c2 100644 --- a/src/C_routines.c +++ b/src/C_routines.c @@ -43,7 +43,7 @@ void gethostname_c(char hostname[], int *stat){ void getusername_c(char username[], int *stat){ - struct passwd *pw = getpwuid(geteuid()); + struct passwd *pw = getpwuid(getuid()); if(pw && strlen(pw->pw_name) <= STRLEN){ strncpy(username,pw->pw_name,STRLEN+1); *stat = 0; diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index c43e354a2..ab64dcf01 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -199,7 +199,7 @@ subroutine DAMASK_interface_init if (interface_restartInc > 0) & print'(a,i6.6)', ' Restart from increment: ', interface_restartInc - !call signalterm_c(c_funloc(catchSIGTERM)) + call signalterm_c(c_funloc(catchSIGTERM)) call signalusr1_c(c_funloc(catchSIGUSR1)) call signalusr2_c(c_funloc(catchSIGUSR2)) call interface_setSIGTERM(.false.) @@ -386,24 +386,14 @@ end function makeRelativePath subroutine catchSIGTERM(signal) bind(C) integer(C_INT), value :: signal + + + print'(a,i0)', ' received signal ',signal call interface_setSIGTERM(.true.) - print'(a,i0,a)', ' received signal ',signal, ', set SIGTERM=TRUE' - end subroutine catchSIGTERM -!-------------------------------------------------------------------------------------------------- -!> @brief Set global variable interface_SIGTERM. -!-------------------------------------------------------------------------------------------------- -subroutine interface_setSIGTERM(state) - - logical, intent(in) :: state - interface_SIGTERM = state - -end subroutine interface_setSIGTERM - - !-------------------------------------------------------------------------------------------------- !> @brief Set global variable interface_SIGUSR1 to .true. !> @details This function can be registered to catch signals send to the executable. @@ -411,24 +401,14 @@ end subroutine interface_setSIGTERM subroutine catchSIGUSR1(signal) bind(C) integer(C_INT), value :: signal + + + print'(a,i0)', ' received signal ',signal call interface_setSIGUSR1(.true.) - print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR1=TRUE' - end subroutine catchSIGUSR1 -!-------------------------------------------------------------------------------------------------- -!> @brief Set global variable interface_SIGUSR. -!-------------------------------------------------------------------------------------------------- -subroutine interface_setSIGUSR1(state) - - logical, intent(in) :: state - interface_SIGUSR1 = state - -end subroutine interface_setSIGUSR1 - - !-------------------------------------------------------------------------------------------------- !> @brief Set global variable interface_SIGUSR2 to .true. !> @details This function can be registered to catch signals send to the executable. @@ -436,20 +416,52 @@ end subroutine interface_setSIGUSR1 subroutine catchSIGUSR2(signal) bind(C) integer(C_INT), value :: signal + + + print'(a,i0,a)', ' received signal ',signal call interface_setSIGUSR2(.true.) - print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR2=TRUE' - end subroutine catchSIGUSR2 +!-------------------------------------------------------------------------------------------------- +!> @brief Set global variable interface_SIGTERM. +!-------------------------------------------------------------------------------------------------- +subroutine interface_setSIGTERM(state) + + logical, intent(in) :: state + + + interface_SIGTERM = state + print*, 'set SIGTERM to',state + +end subroutine interface_setSIGTERM + + +!-------------------------------------------------------------------------------------------------- +!> @brief Set global variable interface_SIGUSR. +!-------------------------------------------------------------------------------------------------- +subroutine interface_setSIGUSR1(state) + + logical, intent(in) :: state + + + interface_SIGUSR1 = state + print*, 'set SIGUSR1 to',state + +end subroutine interface_setSIGUSR1 + + !-------------------------------------------------------------------------------------------------- !> @brief Set global variable interface_SIGUSR2. !-------------------------------------------------------------------------------------------------- subroutine interface_setSIGUSR2(state) logical, intent(in) :: state + + interface_SIGUSR2 = state + print*, 'set SIGUSR2 to',state end subroutine interface_setSIGUSR2 diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 0ad68445c..8537992e8 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -7,20 +7,6 @@ !> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief Interfaces DAMASK with MSC.Marc -!> @details Usage: -!> @details - choose material as hypela2 -!> @details - set statevariable 2 to index of homogenization -!> @details - set statevariable 3 to index of microstructure -!> @details - use nonsymmetric option for solver (e.g. direct profile or multifrontal sparse, the latter seems to be faster!) -!> @details - in case of ddm (domain decomposition) a SYMMETRIC solver has to be used, i.e uncheck "non-symmetric" -!> @details Marc subroutines used: -!> @details - hypela2 -!> @details - uedinc -!> @details - flux -!> @details - quit -!> @details Marc common blocks included: -!> @details - concom: lovl, inc -!> @details - creeps: timinc !-------------------------------------------------------------------------------------------------- #define QUOTE(x) #x #define PASTE(x,y) x ## y @@ -65,14 +51,8 @@ subroutine DAMASK_interface_init print'(/,a)', ' Version: '//DAMASKVERSION - ! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md -#if __INTEL_COMPILER >= 1800 - print'(/,a)', ' Compiled with: '//compiler_version() - print'(a)', ' Compiler options: '//compiler_options() -#else - print'(/,a,i4.4,a,i8.8)', ' Compiled with Intel fortran version :', __INTEL_COMPILER,& - ', build date :', __INTEL_COMPILER_BUILD_DATE -#endif + print'(/,a)', ' Compiled with: '//compiler_version() + print'(a)', ' Compiler options: '//compiler_options() print'(/,a)', ' Compiled on: '//__DATE__//' at '//__TIME__ @@ -239,7 +219,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & real(pReal), dimension(6) :: stress real(pReal), dimension(6,6) :: ddsdde integer :: computationMode, i, cp_en, node, CPnodeID - integer(4) :: defaultNumThreadsInt !< default value set by Marc + integer(pI32) :: defaultNumThreadsInt !< default value set by Marc integer(pInt), save :: & theInc = -1_pInt, & !< needs description @@ -250,13 +230,13 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & logical, save :: & lastIncConverged = .false., & !< needs description outdatedByNewInc = .false., & !< needs description - CPFEM_init_done = .false., & !< remember whether init has been done already + CPFEM_init_done = .false., & !< remember whether init has been done already debug_basic = .true. class(tNode), pointer :: & debug_Marc ! pointer to Marc debug options if(debug_basic) then - print'(a,/,i8,i8,i2)', ' MSC.MARC information on shape of element(2), IP:', m, nn + print'(a,/,i8,i8,i2)', ' MSC.Marc information on shape of element(2), IP:', m, nn print'(a,2(i1))', ' Jacobian: ', ngens,ngens print'(a,i1)', ' Direct stress: ', ndi print'(a,i1)', ' Shear stress: ', nshear @@ -271,7 +251,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & endif defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc - call omp_set_num_threads(1) ! no openMP + call omp_set_num_threads(1_pI32) ! no openMP if (.not. CPFEM_init_done) then CPFEM_init_done = .true. @@ -351,7 +331,7 @@ end subroutine hypela2 !-------------------------------------------------------------------------------------------------- subroutine flux(f,ts,n,time) use prec - use thermal_conduction + use homogenization use discretization_marc implicit none @@ -364,7 +344,8 @@ subroutine flux(f,ts,n,time) real(pReal), dimension(2), intent(out) :: & f - call thermal_conduction_getSourceAndItsTangent(f(1), f(2), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1))) + f(2) = 0.0_pReal + call thermal_conduction_getSource(f(1), n(3),mesh_FEM2DAMASK_elem(n(1))) end subroutine flux @@ -378,14 +359,28 @@ subroutine flux(f,ts,n,time) subroutine uedinc(inc,incsub) use prec use CPFEM + use discretization_marc implicit none integer, intent(in) :: inc, incsub + integer :: n, nqncomp, nqdatatype integer, save :: inc_written + real(pReal), allocatable, dimension(:,:) :: d_n #include QUOTE(PASTE(./marc/include/creeps,Marc4DAMASK)) ! creeps is needed for timinc (time increment) + if (inc > inc_written) then + allocate(d_n(3,count(mesh_FEM2DAMASK_node /= -1))) + do n = lbound(mesh_FEM2DAMASK_node,1), ubound(mesh_FEM2DAMASK_node,1) + if (mesh_FEM2DAMASK_node(n) /= -1) then + call nodvar(1,n,d_n(1:3,mesh_FEM2DAMASK_node(n)),nqncomp,nqdatatype) + if(nqncomp == 2) d_n(3,mesh_FEM2DAMASK_node(n)) = 0.0_pReal + endif + enddo + + call discretization_marc_UpdateNodeAndIpCoords(d_n) call CPFEM_results(inc,cptim) + inc_written = inc endif diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 88b8d960d..ce00c4913 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -71,6 +71,12 @@ module HDF5_utilities module procedure HDF5_addAttribute_real_array end interface HDF5_addAttribute +#ifdef PETSc + logical, parameter, private :: parallel_default = .true. +#else + logical, parameter, private :: parallel_default = .false. +#endif + contains @@ -105,16 +111,16 @@ end subroutine HDF5_utilities_init !-------------------------------------------------------------------------------------------------- !> @brief open and initializes HDF5 output file !-------------------------------------------------------------------------------------------------- -integer(HID_T) function HDF5_openFile(fileName,mode,parallel) +integer(HID_T) function HDF5_openFile(fileName,mode) character(len=*), intent(in) :: fileName character, intent(in), optional :: mode - logical, intent(in), optional :: parallel character :: m integer(HID_T) :: plist_id integer :: hdferr + if (present(mode)) then m = mode else @@ -125,10 +131,8 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel) if(hdferr < 0) error stop 'HDF5 error' #ifdef PETSc - if (present(parallel)) then; if (parallel) then - call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) - if(hdferr < 0) error stop 'HDF5 error' - endif; endif + call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) + if(hdferr < 0) error stop 'HDF5 error' #endif if (m == 'w') then @@ -547,7 +551,7 @@ subroutine HDF5_read_real1(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& @@ -587,7 +591,7 @@ subroutine HDF5_read_real2(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& @@ -627,7 +631,7 @@ subroutine HDF5_read_real3(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& @@ -667,7 +671,7 @@ subroutine HDF5_read_real4(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& @@ -707,7 +711,7 @@ subroutine HDF5_read_real5(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& @@ -747,7 +751,7 @@ subroutine HDF5_read_real6(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& @@ -787,7 +791,7 @@ subroutine HDF5_read_real7(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& @@ -829,7 +833,7 @@ subroutine HDF5_read_int1(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& @@ -869,7 +873,7 @@ subroutine HDF5_read_int2(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& @@ -909,7 +913,7 @@ subroutine HDF5_read_int3(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& @@ -949,7 +953,7 @@ subroutine HDF5_read_int4(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& @@ -989,7 +993,7 @@ subroutine HDF5_read_int5(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& @@ -1029,7 +1033,7 @@ subroutine HDF5_read_int6(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& @@ -1069,7 +1073,7 @@ subroutine HDF5_read_int7(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,parallel) else call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, & - myStart, totalShape, loc_id,myShape,datasetName,.false.) + myStart, totalShape, loc_id,myShape,datasetName,parallel_default) endif call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& @@ -1086,9 +1090,9 @@ end subroutine HDF5_read_int7 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real1(loc_id,dataset,datasetName,parallel) - real(pReal), intent(inout), dimension(:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + real(pReal), intent(in), dimension(:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1109,7 +1113,7 @@ subroutine HDF5_write_real1(loc_id,dataset,datasetName,parallel) myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) endif if (product(totalShape) /= 0) then @@ -1127,9 +1131,9 @@ end subroutine HDF5_write_real1 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real2(loc_id,dataset,datasetName,parallel) - real(pReal), intent(inout), dimension(:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + real(pReal), intent(in), dimension(:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1150,7 +1154,7 @@ subroutine HDF5_write_real2(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) endif if (product(totalShape) /= 0) then @@ -1168,9 +1172,9 @@ end subroutine HDF5_write_real2 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real3(loc_id,dataset,datasetName,parallel) - real(pReal), intent(inout), dimension(:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + real(pReal), intent(in), dimension(:,:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1191,7 +1195,7 @@ subroutine HDF5_write_real3(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) endif if (product(totalShape) /= 0) then @@ -1209,9 +1213,9 @@ end subroutine HDF5_write_real3 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real4(loc_id,dataset,datasetName,parallel) - real(pReal), intent(inout), dimension(:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + real(pReal), intent(in), dimension(:,:,:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1232,7 +1236,7 @@ subroutine HDF5_write_real4(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) endif if (product(totalShape) /= 0) then @@ -1251,9 +1255,9 @@ end subroutine HDF5_write_real4 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real5(loc_id,dataset,datasetName,parallel) - real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + real(pReal), intent(in), dimension(:,:,:,:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1274,7 +1278,7 @@ subroutine HDF5_write_real5(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) endif if (product(totalShape) /= 0) then @@ -1292,9 +1296,9 @@ end subroutine HDF5_write_real5 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real6(loc_id,dataset,datasetName,parallel) - real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + real(pReal), intent(in), dimension(:,:,:,:,:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1315,7 +1319,7 @@ subroutine HDF5_write_real6(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) endif if (product(totalShape) /= 0) then @@ -1333,9 +1337,9 @@ end subroutine HDF5_write_real6 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real7(loc_id,dataset,datasetName,parallel) - real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + real(pReal), intent(in), dimension(:,:,:,:,:,:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1356,7 +1360,7 @@ subroutine HDF5_write_real7(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default) endif if (product(totalShape) /= 0) then @@ -1375,9 +1379,9 @@ end subroutine HDF5_write_real7 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int1(loc_id,dataset,datasetName,parallel) - integer, intent(inout), dimension(:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + integer, intent(in), dimension(:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1398,7 +1402,7 @@ subroutine HDF5_write_int1(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) endif if (product(totalShape) /= 0) then @@ -1416,9 +1420,9 @@ end subroutine HDF5_write_int1 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int2(loc_id,dataset,datasetName,parallel) - integer, intent(inout), dimension(:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + integer, intent(in), dimension(:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1439,7 +1443,7 @@ subroutine HDF5_write_int2(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) endif if (product(totalShape) /= 0) then @@ -1457,9 +1461,9 @@ end subroutine HDF5_write_int2 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int3(loc_id,dataset,datasetName,parallel) - integer, intent(inout), dimension(:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + integer, intent(in), dimension(:,:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1480,7 +1484,7 @@ subroutine HDF5_write_int3(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) endif if (product(totalShape) /= 0) then @@ -1498,9 +1502,9 @@ end subroutine HDF5_write_int3 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int4(loc_id,dataset,datasetName,parallel) - integer, intent(inout), dimension(:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + integer, intent(in), dimension(:,:,:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1521,7 +1525,7 @@ subroutine HDF5_write_int4(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) endif if (product(totalShape) /= 0) then @@ -1539,9 +1543,9 @@ end subroutine HDF5_write_int4 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int5(loc_id,dataset,datasetName,parallel) - integer, intent(inout), dimension(:,:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + integer, intent(in), dimension(:,:,:,:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1562,7 +1566,7 @@ subroutine HDF5_write_int5(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) endif if (product(totalShape) /= 0) then @@ -1580,9 +1584,9 @@ end subroutine HDF5_write_int5 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int6(loc_id,dataset,datasetName,parallel) - integer, intent(inout), dimension(:,:,:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + integer, intent(in), dimension(:,:,:,:,:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1603,7 +1607,7 @@ subroutine HDF5_write_int6(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) endif if (product(totalShape) /= 0) then @@ -1621,9 +1625,9 @@ end subroutine HDF5_write_int6 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int7(loc_id,dataset,datasetName,parallel) - integer, intent(inout), dimension(:,:,:,:,:,:,:) :: dataset !< data written to file - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file + integer, intent(in), dimension(:,:,:,:,:,:,:) :: dataset !< data written to file + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes @@ -1644,7 +1648,7 @@ subroutine HDF5_write_int7(loc_id,dataset,datasetName,parallel) myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default) endif if (product(totalShape) /= 0) then diff --git a/src/IO.f90 b/src/IO.f90 index fd87907aa..36b774191 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -65,8 +65,8 @@ end subroutine IO_init function IO_readlines(fileName) result(fileContent) character(len=*), intent(in) :: fileName - character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines + character(len=pStringLen) :: line character(len=:), allocatable :: rawData integer :: & @@ -75,6 +75,7 @@ function IO_readlines(fileName) result(fileContent) l logical :: warned + rawData = IO_read(fileName) !-------------------------------------------------------------------------------------------------- @@ -112,16 +113,21 @@ end function IO_readlines !-------------------------------------------------------------------------------------------------- !> @brief Read whole file. -!> @details ensures that the string ends with a new line (expected UNIX behavior) +!> @details ensures that the string ends with a new line (expected UNIX behavior) and rejects +! windows (CRLF) line endings !-------------------------------------------------------------------------------------------------- function IO_read(fileName) result(fileContent) character(len=*), intent(in) :: fileName character(len=:), allocatable :: fileContent + integer :: & fileLength, & fileUnit, & - myStat + myStat, & + firstEOL + character, parameter :: CR = achar(13) + inquire(file = fileName, size=fileLength) open(newunit=fileUnit, file=fileName, access='stream',& @@ -137,8 +143,12 @@ function IO_read(fileName) result(fileContent) if(myStat /= 0) call IO_error(102,ext_msg=trim(fileName)) close(fileUnit) + if(fileContent(fileLength:fileLength) /= IO_EOL) fileContent = fileContent//IO_EOL ! ensure EOL@EOF + firstEOL = index(fileContent,IO_EOL) + if(scan(fileContent(firstEOL:firstEOL),CR) /= 0) call IO_error(115) + end function IO_read @@ -151,6 +161,7 @@ logical pure function IO_isBlank(string) integer :: posNonBlank + posNonBlank = verify(string,IO_WHITESPACE) IO_isBlank = posNonBlank == 0 .or. posNonBlank == scan(string,IO_COMMENT) @@ -170,6 +181,7 @@ pure function IO_stringPos(string) integer :: left, right + allocate(IO_stringPos(1), source=0) right = 0 @@ -249,6 +261,7 @@ pure function IO_lc(string) integer :: i,n + do i=1,len(string) n = index(UPPER,string(i:i)) if(n/=0) then @@ -271,6 +284,7 @@ function IO_rmComment(line) character(len=:), allocatable :: IO_rmComment integer :: split + split = index(line,IO_COMMENT) if (split == 0) then @@ -292,6 +306,7 @@ integer function IO_stringAsInt(string) integer :: readStatus character(len=*), parameter :: VALIDCHARS = '0123456789+- ' + valid: if (verify(string,VALIDCHARS) == 0) then read(string,*,iostat=readStatus) IO_stringAsInt if (readStatus /= 0) call IO_error(111,ext_msg=string) @@ -313,6 +328,7 @@ real(pReal) function IO_stringAsFloat(string) integer :: readStatus character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- ' + valid: if (verify(string,VALIDCHARS) == 0) then read(string,*,iostat=readStatus) IO_stringAsFloat if (readStatus /= 0) call IO_error(112,ext_msg=string) @@ -331,6 +347,7 @@ logical function IO_stringAsBool(string) character(len=*), intent(in) :: string !< string for conversion to int value + if (trim(adjustl(string)) == 'True' .or. trim(adjustl(string)) == 'true') then IO_stringAsBool = .true. elseif (trim(adjustl(string)) == 'False' .or. trim(adjustl(string)) == 'false') then @@ -356,6 +373,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) character(len=:), allocatable :: msg character(len=pStringLen) :: formatString + select case (error_ID) !-------------------------------------------------------------------------------------------------- @@ -382,6 +400,9 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'invalid character for logical:' case (114) msg = 'cannot decode base64 string:' + case (115) + msg = 'found CR. Windows file endings (CRLF) are not supported.' + !-------------------------------------------------------------------------------------------------- ! lattice error messages diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index b71261d9c..036d40755 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -72,7 +72,7 @@ module YAML_types getKey => tNode_getKey_byIndex procedure :: & contains => tNode_contains - + generic :: & get => tNode_get_byIndex, & tNode_get_byKey @@ -157,7 +157,7 @@ module YAML_types emptyDict type(tList), target, public :: & emptyList - + abstract interface recursive function asFormattedString(self,indent) @@ -179,7 +179,7 @@ module YAML_types public :: & YAML_types_init, & - output_asStrings, & !ToDo: Hack for GNU. Remove later + output_asStrings, & !ToDo: Hack for GNU. Remove later assignment(=) contains @@ -207,11 +207,11 @@ subroutine selfTest select type(s1) class is(tScalar) s1 = '1' - if(s1%asInt() /= 1) error stop 'tScalar_asInt' - if(dNeq(s1%asFloat(),1.0_pReal)) error stop 'tScalar_asFloat' + if (s1%asInt() /= 1) error stop 'tScalar_asInt' + if (dNeq(s1%asFloat(),1.0_pReal)) error stop 'tScalar_asFloat' s1 = 'true' - if(.not. s1%asBool()) error stop 'tScalar_asBool' - if(s1%asString() /= 'true') error stop 'tScalar_asString' + if (.not. s1%asBool()) error stop 'tScalar_asBool' + if (s1%asString() /= 'true') error stop 'tScalar_asString' end select block @@ -232,18 +232,18 @@ subroutine selfTest call l1%append(s1) call l1%append(s2) n => l1 - if(any(l1%asInts() /= [2,3])) error stop 'tList_asInts' - if(any(dNeq(l1%asFloats(),[2.0_pReal,3.0_pReal]))) error stop 'tList_asFloats' - if(n%get_asInt(1) /= 2) error stop 'byIndex_asInt' - if(dNeq(n%get_asFloat(2),3.0_pReal)) error stop 'byIndex_asFloat' + if (any(l1%asInts() /= [2,3])) error stop 'tList_asInts' + if (any(dNeq(l1%asFloats(),[2.0_pReal,3.0_pReal]))) error stop 'tList_asFloats' + if (n%get_asInt(1) /= 2) error stop 'byIndex_asInt' + if (dNeq(n%get_asFloat(2),3.0_pReal)) error stop 'byIndex_asFloat' endselect allocate(tList::l2) select type(l2) class is(tList) call l2%append(l1) - if(any(l2%get_asInts(1) /= [2,3])) error stop 'byIndex_asInts' - if(any(dNeq(l2%get_asFloats(1),[2.0_pReal,3.0_pReal]))) error stop 'byIndex_asFloats' + if (any(l2%get_asInts(1) /= [2,3])) error stop 'byIndex_asInts' + if (any(dNeq(l2%get_asFloats(1),[2.0_pReal,3.0_pReal]))) error stop 'byIndex_asFloats' n => l2 end select deallocate(n) @@ -265,10 +265,10 @@ subroutine selfTest call l1%append(s2) n => l1 - if(any(l1%asBools() .neqv. [.true., .false.])) error stop 'tList_asBools' - if(any(l1%asStrings() /= ['true ','False'])) error stop 'tList_asStrings' - if(n%get_asBool(2)) error stop 'byIndex_asBool' - if(n%get_asString(1) /= 'true') error stop 'byIndex_asString' + if (any(l1%asBools() .neqv. [.true., .false.])) error stop 'tList_asBools' + if (any(l1%asStrings() /= ['true ','False'])) error stop 'tList_asStrings' + if (n%get_asBool(2)) error stop 'byIndex_asBool' + if (n%get_asString(1) /= 'true') error stop 'byIndex_asString' end block end subroutine selfTest @@ -418,7 +418,7 @@ function tNode_get_byIndex(self,i) result(node) integer :: j self_ => self%asList() - if(i < 1 .or. i > self_%length) call IO_error(150,ext_msg='tNode_get_byIndex') + if (i < 1 .or. i > self_%length) call IO_error(150,ext_msg='tNode_get_byIndex') j = 1 item => self_%first @@ -599,7 +599,7 @@ function tNode_getKey_byIndex(self,i) result(key) dict => self%asDict() item => dict%first do j = 1, dict%length - if(j == i) then + if (j == i) then key = item%key exit else @@ -613,7 +613,7 @@ end function tNode_getKey_byIndex !------------------------------------------------------------------------------------------------- !> @brief Checks if a given key/item is present in the dict/list !------------------------------------------------------------------------------------------------- -function tNode_contains(self,k) result(exists) +function tNode_contains(self,k) result(exists) class(tNode), intent(in), target :: self character(len=*), intent(in) :: k @@ -624,18 +624,18 @@ function tNode_contains(self,k) result(exists) type(tDict), pointer :: dict exists = .false. - if(self%isDict()) then + if (self%isDict()) then dict => self%asDict() do j=1, dict%length - if(dict%getKey(j) == k) then + if (dict%getKey(j) == k) then exists = .true. return endif enddo - elseif(self%isList()) then + elseif (self%isList()) then list => self%asList() - do j =1, list%length - if(list%get_asString(j) == k) then + do j=1, list%length + if (list%get_asString(j) == k) then exists = .true. return endif @@ -663,8 +663,8 @@ function tNode_get_byKey(self,k,defaultVal) result(node) logical :: found found = present(defaultVal) - if(found) node => defaultVal - + if (found) node => defaultVal + self_ => self%asDict() j = 1 @@ -677,11 +677,11 @@ function tNode_get_byKey(self,k,defaultVal) result(node) item => item%next j = j + 1 enddo - + if (.not. found) then call IO_error(143,ext_msg=k) else - if(associated(item)) node => item%node + if (associated(item)) node => item%node endif end function tNode_get_byKey @@ -700,11 +700,11 @@ function tNode_get_byKey_asFloat(self,k,defaultVal) result(nodeAsFloat) class(tNode), pointer :: node type(tScalar), pointer :: scalar - if(self%contains(k)) then + if (self%contains(k)) then node => self%get(k) scalar => node%asScalar() nodeAsFloat = scalar%asFloat() - elseif(present(defaultVal)) then + elseif (present(defaultVal)) then nodeAsFloat = defaultVal else call IO_error(143,ext_msg=k) @@ -726,11 +726,11 @@ function tNode_get_byKey_asInt(self,k,defaultVal) result(nodeAsInt) class(tNode), pointer :: node type(tScalar), pointer :: scalar - if(self%contains(k)) then + if (self%contains(k)) then node => self%get(k) scalar => node%asScalar() nodeAsInt = scalar%asInt() - elseif(present(defaultVal)) then + elseif (present(defaultVal)) then nodeAsInt = defaultVal else call IO_error(143,ext_msg=k) @@ -752,11 +752,11 @@ function tNode_get_byKey_asBool(self,k,defaultVal) result(nodeAsBool) class(tNode), pointer :: node type(tScalar), pointer :: scalar - if(self%contains(k)) then + if (self%contains(k)) then node => self%get(k) scalar => node%asScalar() nodeAsBool = scalar%asBool() - elseif(present(defaultVal)) then + elseif (present(defaultVal)) then nodeAsBool = defaultVal else call IO_error(143,ext_msg=k) @@ -778,11 +778,11 @@ function tNode_get_byKey_asString(self,k,defaultVal) result(nodeAsString) class(tNode), pointer :: node type(tScalar), pointer :: scalar - if(self%contains(k)) then + if (self%contains(k)) then node => self%get(k) scalar => node%asScalar() nodeAsString = scalar%asString() - elseif(present(defaultVal)) then + elseif (present(defaultVal)) then nodeAsString = defaultVal else call IO_error(143,ext_msg=k) @@ -806,18 +806,18 @@ function tNode_get_byKey_asFloats(self,k,defaultVal,requiredSize) result(nodeAsF class(tNode), pointer :: node type(tList), pointer :: list - if(self%contains(k)) then + if (self%contains(k)) then node => self%get(k) list => node%asList() nodeAsFloats = list%asFloats() - elseif(present(defaultVal)) then + elseif (present(defaultVal)) then nodeAsFloats = defaultVal else call IO_error(143,ext_msg=k) endif - if(present(requiredSize)) then - if(requiredSize /= size(nodeAsFloats)) call IO_error(146,ext_msg=k) + if (present(requiredSize)) then + if (requiredSize /= size(nodeAsFloats)) call IO_error(146,ext_msg=k) endif end function tNode_get_byKey_asFloats @@ -837,18 +837,18 @@ function tNode_get_byKey_asInts(self,k,defaultVal,requiredSize) result(nodeAsInt class(tNode), pointer :: node type(tList), pointer :: list - if(self%contains(k)) then + if (self%contains(k)) then node => self%get(k) list => node%asList() nodeAsInts = list%asInts() - elseif(present(defaultVal)) then + elseif (present(defaultVal)) then nodeAsInts = defaultVal else call IO_error(143,ext_msg=k) endif - if(present(requiredSize)) then - if(requiredSize /= size(nodeAsInts)) call IO_error(146,ext_msg=k) + if (present(requiredSize)) then + if (requiredSize /= size(nodeAsInts)) call IO_error(146,ext_msg=k) endif end function tNode_get_byKey_asInts @@ -867,11 +867,11 @@ function tNode_get_byKey_asBools(self,k,defaultVal) result(nodeAsBools) class(tNode), pointer :: node type(tList), pointer :: list - if(self%contains(k)) then + if (self%contains(k)) then node => self%get(k) list => node%asList() nodeAsBools = list%asBools() - elseif(present(defaultVal)) then + elseif (present(defaultVal)) then nodeAsBools = defaultVal else call IO_error(143,ext_msg=k) @@ -893,11 +893,11 @@ function tNode_get_byKey_asStrings(self,k,defaultVal) result(nodeAsStrings) class(tNode), pointer :: node type(tList), pointer :: list - if(self%contains(k)) then + if (self%contains(k)) then node => self%get(k) list => node%asList() nodeAsStrings = list%asStrings() - elseif(present(defaultVal)) then + elseif (present(defaultVal)) then nodeAsStrings = defaultVal else call IO_error(143,ext_msg=k) @@ -925,7 +925,7 @@ function output_asStrings(self) result(output) !ToDo: SR: Rem end function output_asStrings - + !-------------------------------------------------------------------------------------------------- !> @brief Returns the index of a key in a dictionary @@ -944,7 +944,7 @@ function tNode_get_byKey_asIndex(self,key) result(keyIndex) item => dict%first keyIndex = -1 do i = 1, dict%length - if(key == item%key) then + if (key == item%key) then keyIndex = i exit else @@ -952,9 +952,9 @@ function tNode_get_byKey_asIndex(self,key) result(keyIndex) endif enddo - if(keyIndex == -1) call IO_error(140,ext_msg=key) + if (keyIndex == -1) call IO_error(140,ext_msg=key) + - end function tNode_get_byKey_asIndex @@ -985,7 +985,7 @@ recursive function tList_asFormattedString(self,indent) result(str) integer :: i, indent_ str = '' - if(present(indent)) then + if (present(indent)) then indent_ = indent else indent_ = 0 @@ -993,7 +993,7 @@ recursive function tList_asFormattedString(self,indent) result(str) item => self%first do i = 1, self%length - if(i /= 1) str = str//repeat(' ',indent_) + if (i /= 1) str = str//repeat(' ',indent_) str = str//'- '//item%node%asFormattedString(indent_+2) item => item%next end do @@ -1014,7 +1014,7 @@ recursive function tDict_asFormattedString(self,indent) result(str) integer :: i, indent_ str = '' - if(present(indent)) then + if (present(indent)) then indent_ = indent else indent_ = 0 @@ -1022,7 +1022,7 @@ recursive function tDict_asFormattedString(self,indent) result(str) item => self%first do i = 1, self%length - if(i /= 1) str = str//repeat(' ',indent_) + if (i /= 1) str = str//repeat(' ',indent_) select type(node_1 =>item%node) class is(tScalar) str = str//trim(item%key)//': '//item%node%asFormattedString(indent_+len_trim(item%key)+2) @@ -1270,7 +1270,7 @@ recursive subroutine tItem_finalize(self) type(tItem),intent(inout) :: self deallocate(self%node) - if(associated(self%next)) deallocate(self%next) + if (associated(self%next)) deallocate(self%next) end subroutine tItem_finalize diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 674ec4c43..97e7520f9 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -7,7 +7,6 @@ #include "IO.f90" #include "YAML_types.f90" #include "YAML_parse.f90" -#include "future.f90" #include "config.f90" #include "LAPACK_interface.f90" #include "math.f90" @@ -17,38 +16,36 @@ #include "results.f90" #include "geometry_plastic_nonlocal.f90" #include "discretization.f90" -#ifdef Marc4DAMASK #include "marc/discretization_marc.f90" -#endif #include "material.f90" #include "lattice.f90" -#include "constitutive.f90" -#include "constitutive_mech.f90" -#include "constitutive_plastic_none.f90" -#include "constitutive_plastic_isotropic.f90" -#include "constitutive_plastic_phenopowerlaw.f90" -#include "constitutive_plastic_kinehardening.f90" -#include "constitutive_plastic_dislotwin.f90" -#include "constitutive_plastic_disloTungsten.f90" -#include "constitutive_plastic_nonlocal.f90" -#include "constitutive_thermal.f90" -#include "source_thermal_dissipation.f90" -#include "source_thermal_externalheat.f90" -#include "kinematics_thermal_expansion.f90" -#include "constitutive_damage.f90" -#include "source_damage_isoBrittle.f90" -#include "source_damage_isoDuctile.f90" -#include "source_damage_anisoBrittle.f90" -#include "source_damage_anisoDuctile.f90" -#include "kinematics_cleavage_opening.f90" -#include "kinematics_slipplane_opening.f90" -#include "thermal_isothermal.f90" -#include "thermal_conduction.f90" -#include "damage_none.f90" -#include "damage_nonlocal.f90" +#include "phase.f90" +#include "phase_mechanical.f90" +#include "phase_mechanical_plastic.f90" +#include "phase_mechanical_plastic_none.f90" +#include "phase_mechanical_plastic_isotropic.f90" +#include "phase_mechanical_plastic_phenopowerlaw.f90" +#include "phase_mechanical_plastic_kinehardening.f90" +#include "phase_mechanical_plastic_dislotwin.f90" +#include "phase_mechanical_plastic_dislotungsten.f90" +#include "phase_mechanical_plastic_nonlocal.f90" +#include "phase_mechanical_eigen.f90" +#include "phase_mechanical_eigen_cleavageopening.f90" +#include "phase_mechanical_eigen_slipplaneopening.f90" +#include "phase_mechanical_eigen_thermalexpansion.f90" +#include "phase_thermal.f90" +#include "phase_thermal_dissipation.f90" +#include "phase_thermal_externalheat.f90" +#include "phase_damage.f90" +#include "phase_damage_isobrittle.f90" +#include "phase_damage_isoductile.f90" +#include "phase_damage_anisobrittle.f90" +#include "phase_damage_anisoductile.f90" #include "homogenization.f90" -#include "homogenization_mech.f90" -#include "homogenization_mech_none.f90" -#include "homogenization_mech_isostrain.f90" -#include "homogenization_mech_RGC.f90" +#include "homogenization_mechanical.f90" +#include "homogenization_mechanical_pass.f90" +#include "homogenization_mechanical_isostrain.f90" +#include "homogenization_mechanical_RGC.f90" +#include "homogenization_thermal.f90" +#include "homogenization_damage.f90" #include "CPFEM.f90" diff --git a/src/config.f90 b/src/config.f90 index b10edf013..02b16f2a2 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -5,16 +5,10 @@ !! precedence over material.yaml. !-------------------------------------------------------------------------------------------------- module config - use prec - use DAMASK_interface use IO use YAML_parse use YAML_types -#ifdef PETSc -#include - use petscsys -#endif implicit none private @@ -50,17 +44,12 @@ end subroutine config_init subroutine parse_material logical :: fileExists - character(len=:), allocatable :: fname - fname = getSolverJobName()//'.yaml' - inquire(file=fname,exist=fileExists) - if(.not. fileExists) then - fname = 'material.yaml' - inquire(file=fname,exist=fileExists) - if(.not. fileExists) call IO_error(100,ext_msg=fname) - endif - print*, 'reading '//fname; flush(IO_STDOUT) - config_material => YAML_parse_file(fname) + + inquire(file='material.yaml',exist=fileExists) + if(.not. fileExists) call IO_error(100,ext_msg='material.yaml') + print*, 'reading material.yaml'; flush(IO_STDOUT) + config_material => YAML_parse_file('material.yaml') end subroutine parse_material @@ -72,6 +61,7 @@ subroutine parse_numerics logical :: fexist + config_numerics => emptyDict inquire(file='numerics.yaml', exist=fexist) if (fexist) then @@ -89,6 +79,7 @@ subroutine parse_debug logical :: fexist + config_debug => emptyDict inquire(file='debug.yaml', exist=fexist) fileExists: if (fexist) then diff --git a/src/constitutive.f90 b/src/constitutive.f90 deleted file mode 100644 index 696611549..000000000 --- a/src/constitutive.f90 +++ /dev/null @@ -1,1434 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief elasticity, plasticity, damage & thermal internal microstructure state -!-------------------------------------------------------------------------------------------------- -module constitutive - use prec - use math - use rotations - use IO - use config - use material - use results - use lattice - use discretization - use parallelization - use HDF5_utilities - use DAMASK_interface - use results - - implicit none - private - - enum, bind(c); enumerator :: & - PLASTICITY_UNDEFINED_ID, & - PLASTICITY_NONE_ID, & - PLASTICITY_ISOTROPIC_ID, & - PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_KINEHARDENING_ID, & - PLASTICITY_DISLOTWIN_ID, & - PLASTICITY_DISLOTUNGSTEN_ID, & - PLASTICITY_NONLOCAL_ID, & - SOURCE_UNDEFINED_ID ,& - SOURCE_THERMAL_DISSIPATION_ID, & - SOURCE_THERMAL_EXTERNALHEAT_ID, & - SOURCE_DAMAGE_ISOBRITTLE_ID, & - SOURCE_DAMAGE_ISODUCTILE_ID, & - SOURCE_DAMAGE_ANISOBRITTLE_ID, & - SOURCE_DAMAGE_ANISODUCTILE_ID, & - KINEMATICS_UNDEFINED_ID ,& - KINEMATICS_CLEAVAGE_OPENING_ID, & - KINEMATICS_SLIPPLANE_OPENING_ID, & - KINEMATICS_THERMAL_EXPANSION_ID - end enum - real(pReal), dimension(:,:,:), allocatable :: & - crystallite_subdt !< substepped time increment of each grain - type(rotation), dimension(:,:,:), allocatable :: & - crystallite_orientation !< current orientation - real(pReal), dimension(:,:,:,:,:), allocatable :: & - crystallite_F0, & !< def grad at start of FE inc - crystallite_Fe, & !< current "elastic" def grad (end of converged time step) - crystallite_subFp0,& !< plastic def grad at start of crystallite inc - crystallite_subFi0,& !< intermediate def grad at start of crystallite inc - crystallite_Lp0, & !< plastic velocitiy grad at start of FE inc - crystallite_partitionedLp0, & !< plastic velocity grad at start of homog inc - crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc - crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc - real(pReal), dimension(:,:,:,:,:), allocatable, public :: & - crystallite_P, & !< 1st Piola-Kirchhoff stress per grain - crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step) - crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) - crystallite_partitionedF0, & !< def grad at start of homog inc - crystallite_F !< def grad to be reached at end of homog inc - - type :: tTensorContainer - real(pReal), dimension(:,:,:), allocatable :: data - end type - - type(tTensorContainer), dimension(:), allocatable :: & - constitutive_mech_Fi, & - constitutive_mech_Fi0, & - constitutive_mech_partitionedFi0, & - constitutive_mech_Li, & - constitutive_mech_Li0, & - constitutive_mech_partitionedLi0, & - constitutive_mech_Fp, & - constitutive_mech_Fp0, & - constitutive_mech_partitionedFp0 - - - type :: tNumerics - integer :: & - iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp - nState, & !< state loop limit - nStress !< stress loop limit - real(pReal) :: & - subStepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback - subStepSizeCryst, & !< size of first substep when cutback - subStepSizeLp, & !< size of first substep when cutback in Lp calculation - subStepSizeLi, & !< size of first substep when cutback in Li calculation - stepIncreaseCryst, & !< increase of next substep size when previous substep converged - rtol_crystalliteState, & !< relative tolerance in state loop - rtol_crystalliteStress, & !< relative tolerance in stress loop - atol_crystalliteStress !< absolute tolerance in stress loop - end type tNumerics - - type(tNumerics) :: num ! numerics parameters. Better name? - - type :: tDebugOptions - logical :: & - basic, & - extensive, & - selective - integer :: & - element, & - ip, & - grain - end type tDebugOptions - - type(tDebugOptions) :: debugCrystallite - - - - integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public :: & - phase_plasticity !< plasticity of each phase - - integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & - phase_source, & !< active sources mechanisms of each phase - phase_kinematics !< active kinematic mechanisms of each phase - - integer, dimension(:), allocatable, public :: & !< ToDo: should be protected (bug in Intel compiler) - phase_Nsources, & !< number of source mechanisms active in each phase - phase_Nkinematics, & !< number of kinematic mechanisms active in each phase - phase_NstiffnessDegradations, & !< number of stiffness degradation mechanisms active in each phase - phase_plasticityInstance, & !< instance of particular plasticity of each phase - phase_elasticityInstance !< instance of particular elasticity of each phase - - logical, dimension(:), allocatable, public :: & ! ToDo: should be protected (bug in Intel Compiler) - phase_localPlasticity !< flags phases with local constitutive law - - type(tPlasticState), allocatable, dimension(:), public :: & - plasticState - type(tSourceState), allocatable, dimension(:), public :: & - sourceState - - - integer, public, protected :: & - constitutive_plasticity_maxSizeDotState, & - constitutive_source_maxSizeDotState - - interface - -! == cleaned:begin ================================================================================= - module subroutine mech_init - end subroutine mech_init - - module subroutine damage_init - end subroutine damage_init - - module subroutine thermal_init - end subroutine thermal_init - - - module subroutine mech_results(group,ph) - character(len=*), intent(in) :: group - integer, intent(in) :: ph - end subroutine mech_results - - module subroutine damage_results(group,ph) - character(len=*), intent(in) :: group - integer, intent(in) :: ph - end subroutine damage_results - - - module subroutine mech_restart_read(fileHandle) - integer(HID_T), intent(in) :: fileHandle - end subroutine mech_restart_read - - module subroutine mech_initializeRestorationPoints(ph,me) - integer, intent(in) :: ph, me - end subroutine mech_initializeRestorationPoints - - module subroutine constitutive_mech_windForward(ph,me) - integer, intent(in) :: ph, me - end subroutine constitutive_mech_windForward - - module subroutine constitutive_mech_forward - end subroutine constitutive_mech_forward - - module subroutine mech_restore(ip,el,includeL) - integer, intent(in) :: & - ip, & - el - logical, intent(in) :: & - includeL - end subroutine mech_restore - -! == cleaned:end =================================================================================== - - module function crystallite_stress(dt,co,ip,el) result(converged_) - real(pReal), intent(in) :: dt - integer, intent(in) :: co, ip, el - logical :: converged_ - end function crystallite_stress - - module function constitutive_homogenizedC(co,ip,el) result(C) - integer, intent(in) :: co, ip, el - real(pReal), dimension(6,6) :: C - end function constitutive_homogenizedC - - module subroutine source_damage_anisoBrittle_dotState(S, co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S - end subroutine source_damage_anisoBrittle_dotState - - module subroutine source_damage_anisoDuctile_dotState(co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - end subroutine source_damage_anisoDuctile_dotState - - module subroutine source_damage_isoDuctile_dotState(co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - end subroutine source_damage_isoDuctile_dotState - - module subroutine source_thermal_externalheat_dotState(phase, of) - integer, intent(in) :: & - phase, & - of - end subroutine source_thermal_externalheat_dotState - - module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi, phi, ip, el) - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - phi !< damage parameter - real(pReal), intent(inout) :: & - phiDot, & - dPhiDot_dPhi - end subroutine constitutive_damage_getRateAndItsTangents - - module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, S, Lp, ip, el) - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - T - real(pReal), intent(in), dimension(:,:,:,:,:) :: & - S, & !< current 2nd Piola Kitchoff stress vector - Lp !< plastic velocity gradient - real(pReal), intent(inout) :: & - TDot, & - dTDot_dT - end subroutine constitutive_thermal_getRateAndItsTangents - - - - module subroutine plastic_nonlocal_updateCompatibility(orientation,instance,i,e) - integer, intent(in) :: & - instance, & - i, & - e - type(rotation), dimension(1,discretization_nIPs,discretization_Nelems), intent(in) :: & - orientation !< crystal orientation - end subroutine plastic_nonlocal_updateCompatibility - - module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) - real(pReal), dimension(3,3), intent(out) :: & - Li !< inleastic velocity gradient - real(pReal), dimension(3,3,3,3), intent(out) :: & - dLi_dMi !< derivative of Li with respect to Mandel stress - real(pReal), dimension(3,3), intent(in) :: & - Mi !< Mandel stress - integer, intent(in) :: & - instance, & - of - end subroutine plastic_isotropic_LiAndItsTangent - - module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el) - integer, intent(in) :: & - co, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(in), dimension(3,3) :: & - S - real(pReal), intent(out), dimension(3,3) :: & - Ld !< damage velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) - end subroutine kinematics_cleavage_opening_LiAndItsTangent - - module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el) - integer, intent(in) :: & - co, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(in), dimension(3,3) :: & - S - real(pReal), intent(out), dimension(3,3) :: & - Ld !< damage velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) - end subroutine kinematics_slipplane_opening_LiAndItsTangent - - module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, co, ip, el) - integer, intent(in) :: & - co, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(out), dimension(3,3) :: & - Li !< thermal velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero) - end subroutine kinematics_thermal_expansion_LiAndItsTangent - - - module subroutine source_damage_isoBrittle_deltaState(C, Fe, co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - Fe - real(pReal), intent(in), dimension(6,6) :: & - C - end subroutine source_damage_isoBrittle_deltaState - - - module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & - S, Fi, co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola-Kirchhoff stress - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - Lp !< plastic velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLp_dS, & - dLp_dFi !< derivative of Lp with respect to Fi - end subroutine constitutive_plastic_LpAndItsTangents - - - module subroutine constitutive_plastic_dependentState(F, co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - F !< elastic deformation gradient - end subroutine constitutive_plastic_dependentState - - - - module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - Fe, & !< elastic deformation gradient - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - S !< 2nd Piola-Kirchhoff stress tensor - real(pReal), intent(out), dimension(3,3,3,3) :: & - dS_dFe, & !< derivative of 2nd P-K stress with respect to elastic deformation gradient - dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient - end subroutine constitutive_hooke_SandItsTangents - - end interface - - - - type(tDebugOptions) :: debugConstitutive - - public :: & - constitutive_init, & - constitutive_homogenizedC, & - constitutive_LiAndItsTangents, & - constitutive_damage_getRateAndItsTangents, & - constitutive_thermal_getRateAndItsTangents, & - constitutive_results, & - constitutive_allocateState, & - constitutive_forward, & - constitutive_restore, & - plastic_nonlocal_updateCompatibility, & - source_active, & - kinematics_active, & - converged, & - crystallite_init, & - crystallite_stress, & - crystallite_stressTangent, & - crystallite_orientations, & - crystallite_push33ToRef, & - crystallite_restartWrite, & - integrateSourceState, & - crystallite_restartRead, & - constitutive_initializeRestorationPoints, & - constitutive_windForward, & - PLASTICITY_UNDEFINED_ID, & - PLASTICITY_NONE_ID, & - PLASTICITY_ISOTROPIC_ID, & - PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_KINEHARDENING_ID, & - PLASTICITY_DISLOTWIN_ID, & - PLASTICITY_DISLOTUNGSTEN_ID, & - PLASTICITY_NONLOCAL_ID, & - SOURCE_UNDEFINED_ID ,& - SOURCE_THERMAL_DISSIPATION_ID, & - SOURCE_THERMAL_EXTERNALHEAT_ID, & - SOURCE_DAMAGE_ISOBRITTLE_ID, & - SOURCE_DAMAGE_ISODUCTILE_ID, & - SOURCE_DAMAGE_ANISOBRITTLE_ID, & - SOURCE_DAMAGE_ANISODUCTILE_ID, & - KINEMATICS_UNDEFINED_ID ,& - KINEMATICS_CLEAVAGE_OPENING_ID, & - KINEMATICS_SLIPPLANE_OPENING_ID, & - KINEMATICS_THERMAL_EXPANSION_ID - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief Initialze constitutive models for individual physics -!-------------------------------------------------------------------------------------------------- -subroutine constitutive_init - - integer :: & - ph, & !< counter in phase loop - so !< counter in source loop - class (tNode), pointer :: & - debug_constitutive, & - phases - - - debug_constitutive => config_debug%get('constitutive', defaultVal=emptyList) - debugConstitutive%basic = debug_constitutive%contains('basic') - debugConstitutive%extensive = debug_constitutive%contains('extensive') - debugConstitutive%selective = debug_constitutive%contains('selective') - debugConstitutive%element = config_debug%get_asInt('element',defaultVal = 1) - debugConstitutive%ip = config_debug%get_asInt('integrationpoint',defaultVal = 1) - debugConstitutive%grain = config_debug%get_asInt('grain',defaultVal = 1) - -!-------------------------------------------------------------------------------------------------- -! initialize constitutive laws - print'(/,a)', ' <<<+- constitutive init -+>>>'; flush(IO_STDOUT) - call mech_init - call damage_init - call thermal_init - - - phases => config_material%get('phase') - constitutive_source_maxSizeDotState = 0 - PhaseLoop2:do ph = 1,phases%length -!-------------------------------------------------------------------------------------------------- -! partition and initialize state - plasticState(ph)%partitionedState0 = plasticState(ph)%state0 - plasticState(ph)%state = plasticState(ph)%partitionedState0 - forall(so = 1:phase_Nsources(ph)) - sourceState(ph)%p(so)%partitionedState0 = sourceState(ph)%p(so)%state0 - sourceState(ph)%p(so)%state = sourceState(ph)%p(so)%partitionedState0 - end forall - - constitutive_source_maxSizeDotState = max(constitutive_source_maxSizeDotState, & - maxval(sourceState(ph)%p%sizeDotState)) - enddo PhaseLoop2 - constitutive_plasticity_maxSizeDotState = maxval(plasticState%sizeDotState) - -end subroutine constitutive_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief checks if a source mechanism is active or not -!-------------------------------------------------------------------------------------------------- -function source_active(source_label,src_length) result(active_source) - - character(len=*), intent(in) :: source_label !< name of source mechanism - integer, intent(in) :: src_length !< max. number of sources in system - logical, dimension(:,:), allocatable :: active_source - - class(tNode), pointer :: & - phases, & - phase, & - sources, & - src - integer :: p,s - - phases => config_material%get('phase') - allocate(active_source(src_length,phases%length), source = .false. ) - do p = 1, phases%length - phase => phases%get(p) - sources => phase%get('source',defaultVal=emptyList) - do s = 1, sources%length - src => sources%get(s) - if(src%get_asString('type') == source_label) active_source(s,p) = .true. - enddo - enddo - - -end function source_active - - -!-------------------------------------------------------------------------------------------------- -!> @brief checks if a kinematic mechanism is active or not -!-------------------------------------------------------------------------------------------------- -function kinematics_active(kinematics_label,kinematics_length) result(active_kinematics) - - character(len=*), intent(in) :: kinematics_label !< name of kinematic mechanism - integer, intent(in) :: kinematics_length !< max. number of kinematics in system - logical, dimension(:,:), allocatable :: active_kinematics - - class(tNode), pointer :: & - phases, & - phase, & - kinematics, & - kinematics_type - integer :: p,k - - phases => config_material%get('phase') - allocate(active_kinematics(kinematics_length,phases%length), source = .false. ) - do p = 1, phases%length - phase => phases%get(p) - kinematics => phase%get('kinematics',defaultVal=emptyList) - do k = 1, kinematics%length - kinematics_type => kinematics%get(k) - if(kinematics_type%get_asString('type') == kinematics_label) active_kinematics(k,p) = .true. - enddo - enddo - - -end function kinematics_active - - -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the velocity gradient -! ToDo: MD: S is Mi? -!-------------------------------------------------------------------------------------------------- -subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & - S, Fi, co, ip, el) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola-Kirchhoff stress - real(pReal), intent(in), dimension(3,3) :: & - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - Li !< intermediate velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLi_dS, & !< derivative of Li with respect to S - dLi_dFi - - real(pReal), dimension(3,3) :: & - my_Li, & !< intermediate velocity gradient - FiInv, & - temp_33 - real(pReal), dimension(3,3,3,3) :: & - my_dLi_dS - real(pReal) :: & - detFi - integer :: & - k, i, j, & - instance, of - - Li = 0.0_pReal - dLi_dS = 0.0_pReal - dLi_dFi = 0.0_pReal - - plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) - case (PLASTICITY_isotropic_ID) plasticityType - of = material_phasememberAt(co,ip,el) - instance = phase_plasticityInstance(material_phaseAt(co,el)) - call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) - case default plasticityType - my_Li = 0.0_pReal - my_dLi_dS = 0.0_pReal - end select plasticityType - - Li = Li + my_Li - dLi_dS = dLi_dS + my_dLi_dS - - KinematicsLoop: do k = 1, phase_Nkinematics(material_phaseAt(co,el)) - kinematicsType: select case (phase_kinematics(k,material_phaseAt(co,el))) - case (KINEMATICS_cleavage_opening_ID) kinematicsType - call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) - case (KINEMATICS_slipplane_opening_ID) kinematicsType - call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) - case (KINEMATICS_thermal_expansion_ID) kinematicsType - call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, co, ip, el) - case default kinematicsType - my_Li = 0.0_pReal - my_dLi_dS = 0.0_pReal - end select kinematicsType - Li = Li + my_Li - dLi_dS = dLi_dS + my_dLi_dS - enddo KinematicsLoop - - FiInv = math_inv33(Fi) - detFi = math_det33(Fi) - Li = matmul(matmul(Fi,Li),FiInv)*detFi !< push forward to intermediate configuration - temp_33 = matmul(FiInv,Li) - - do i = 1,3; do j = 1,3 - dLi_dS(1:3,1:3,i,j) = matmul(matmul(Fi,dLi_dS(1:3,1:3,i,j)),FiInv)*detFi - dLi_dFi(1:3,1:3,i,j) = dLi_dFi(1:3,1:3,i,j) + Li*FiInv(j,i) - dLi_dFi(1:3,i,1:3,j) = dLi_dFi(1:3,i,1:3,j) + math_I3*temp_33(j,i) + Li*FiInv(j,i) - enddo; enddo - -end subroutine constitutive_LiAndItsTangents - - -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -function constitutive_damage_collectDotState(S, co, ip, el,ph,of) result(broken) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - ph, & - of - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola Kirchhoff stress (vector notation) - integer :: & - so !< counter in source loop - logical :: broken - - - broken = .false. - - SourceLoop: do so = 1, phase_Nsources(ph) - - sourceType: select case (phase_source(so,ph)) - - case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState(S, co, ip, el) ! correct stress? - - case (SOURCE_damage_isoDuctile_ID) sourceType - call source_damage_isoDuctile_dotState(co, ip, el) - - case (SOURCE_damage_anisoDuctile_ID) sourceType - call source_damage_anisoDuctile_dotState(co, ip, el) - - end select sourceType - - broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(so)%dotState(:,of))) - - enddo SourceLoop - -end function constitutive_damage_collectDotState - - -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -function constitutive_thermal_collectDotState(ph,me) result(broken) - - integer, intent(in) :: ph, me - logical :: broken - - integer :: i - - - broken = .false. - - SourceLoop: do i = 1, phase_Nsources(ph) - - if (phase_source(i,ph) == SOURCE_thermal_externalheat_ID) & - call source_thermal_externalheat_dotState(ph,me) - - broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(i)%dotState(:,me))) - - enddo SourceLoop - -end function constitutive_thermal_collectDotState - - -!-------------------------------------------------------------------------------------------------- -!> @brief for constitutive models having an instantaneous change of state -!> will return false if delta state is not needed/supported by the constitutive model -!-------------------------------------------------------------------------------------------------- -function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - ph, & - of - real(pReal), intent(in), dimension(3,3) :: & - Fe !< elastic deformation gradient - integer :: & - so, & - myOffset, & - mySize - logical :: & - broken - - - broken = .false. - - sourceLoop: do so = 1, phase_Nsources(ph) - - sourceType: select case (phase_source(so,ph)) - - case (SOURCE_damage_isoBrittle_ID) sourceType - call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, & - co, ip, el) - broken = any(IEEE_is_NaN(sourceState(ph)%p(so)%deltaState(:,of))) - if(.not. broken) then - myOffset = sourceState(ph)%p(so)%offsetDeltaState - mySize = sourceState(ph)%p(so)%sizeDeltaState - sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = & - sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + sourceState(ph)%p(so)%deltaState(1:mySize,of) - endif - - end select sourceType - - enddo SourceLoop - -end function constitutive_damage_deltaState - - -!-------------------------------------------------------------------------------------------------- -!> @brief Allocate the components of the state structure for a given phase -!-------------------------------------------------------------------------------------------------- -subroutine constitutive_allocateState(state, & - Nconstituents,sizeState,sizeDotState,sizeDeltaState) - - class(tState), intent(out) :: & - state - integer, intent(in) :: & - Nconstituents, & - sizeState, & - sizeDotState, & - sizeDeltaState - - - state%sizeState = sizeState - state%sizeDotState = sizeDotState - state%sizeDeltaState = sizeDeltaState - state%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition - - allocate(state%atol (sizeState), source=0.0_pReal) - allocate(state%state0 (sizeState,Nconstituents), source=0.0_pReal) - allocate(state%partitionedState0(sizeState,Nconstituents), source=0.0_pReal) - allocate(state%subState0 (sizeState,Nconstituents), source=0.0_pReal) - allocate(state%state (sizeState,Nconstituents), source=0.0_pReal) - - allocate(state%dotState (sizeDotState,Nconstituents), source=0.0_pReal) - - allocate(state%deltaState (sizeDeltaState,Nconstituents), source=0.0_pReal) - - -end subroutine constitutive_allocateState - - -!-------------------------------------------------------------------------------------------------- -!> @brief Restore data after homog cutback. -!-------------------------------------------------------------------------------------------------- -subroutine constitutive_restore(ip,el,includeL) - - logical, intent(in) :: includeL - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - - integer :: & - co, & !< constituent number - so - - - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - do so = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(so)%state( :,material_phasememberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) - enddo - enddo - - call mech_restore(ip,el,includeL) - -end subroutine constitutive_restore - - -!-------------------------------------------------------------------------------------------------- -!> @brief Forward data after successful increment. -! ToDo: Any guessing for the current states possible? -!-------------------------------------------------------------------------------------------------- -subroutine constitutive_forward - - integer :: i, j - - crystallite_F0 = crystallite_F - crystallite_Lp0 = crystallite_Lp - crystallite_S0 = crystallite_S - - call constitutive_mech_forward() - - do i = 1, size(sourceState) - do j = 1,phase_Nsources(i) - sourceState(i)%p(j)%state0 = sourceState(i)%p(j)%state - enddo; enddo - -end subroutine constitutive_forward - - -!-------------------------------------------------------------------------------------------------- -!> @brief writes constitutive results to HDF5 output file -!-------------------------------------------------------------------------------------------------- -subroutine constitutive_results - - integer :: ph - character(len=:), allocatable :: group - - - call results_closeGroup(results_addGroup('/current/phase/')) - - do ph = 1, size(material_name_phase) - - group = '/current/phase/'//trim(material_name_phase(ph))//'/' - call results_closeGroup(results_addGroup(group)) - - call mech_results(group,ph) - call damage_results(group,ph) - - enddo - -end subroutine constitutive_results - - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates and initialize per grain variables -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_init - - integer :: & - Nconstituents, & - ph, & - me, & - co, & !< counter in integration point component loop - ip, & !< counter in integration point loop - el, & !< counter in element loop - cMax, & !< maximum number of integration point components - iMax, & !< maximum number of integration points - eMax !< maximum number of elements - - - class(tNode), pointer :: & - num_crystallite, & - debug_crystallite, & ! pointer to debug options for crystallite - phases, & - phase, & - mech - - - print'(/,a)', ' <<<+- crystallite init -+>>>' - - debug_crystallite => config_debug%get('crystallite', defaultVal=emptyList) - debugCrystallite%extensive = debug_crystallite%contains('extensive') - - cMax = homogenization_maxNconstituents - iMax = discretization_nIPs - eMax = discretization_Nelems - - allocate(crystallite_F(3,3,cMax,iMax,eMax),source=0.0_pReal) - - allocate(crystallite_S0, & - crystallite_F0,crystallite_Lp0, & - crystallite_partitionedS0, & - crystallite_partitionedF0,& - crystallite_partitionedLp0, & - crystallite_S,crystallite_P, & - crystallite_Fe,crystallite_Lp, & - crystallite_subFp0,crystallite_subFi0, & - source = crystallite_F) - - allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) - allocate(crystallite_orientation(cMax,iMax,eMax)) - - num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) - - num%subStepMinCryst = num_crystallite%get_asFloat ('subStepMin', defaultVal=1.0e-3_pReal) - num%subStepSizeCryst = num_crystallite%get_asFloat ('subStepSize', defaultVal=0.25_pReal) - num%stepIncreaseCryst = num_crystallite%get_asFloat ('stepIncrease', defaultVal=1.5_pReal) - num%subStepSizeLp = num_crystallite%get_asFloat ('subStepSizeLp', defaultVal=0.5_pReal) - num%subStepSizeLi = num_crystallite%get_asFloat ('subStepSizeLi', defaultVal=0.5_pReal) - num%rtol_crystalliteState = num_crystallite%get_asFloat ('rtol_State', defaultVal=1.0e-6_pReal) - num%rtol_crystalliteStress = num_crystallite%get_asFloat ('rtol_Stress', defaultVal=1.0e-6_pReal) - num%atol_crystalliteStress = num_crystallite%get_asFloat ('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) - - if(num%subStepMinCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinCryst') - if(num%subStepSizeCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeCryst') - if(num%stepIncreaseCryst <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseCryst') - - if(num%subStepSizeLp <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLp') - if(num%subStepSizeLi <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLi') - - if(num%rtol_crystalliteState <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteState') - if(num%rtol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteStress') - if(num%atol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='atol_crystalliteStress') - - if(num%iJacoLpresiduum < 1) call IO_error(301,ext_msg='iJacoLpresiduum') - - if(num%nState < 1) call IO_error(301,ext_msg='nState') - if(num%nStress< 1) call IO_error(301,ext_msg='nStress') - - - phases => config_material%get('phase') - - allocate(constitutive_mech_Fi(phases%length)) - allocate(constitutive_mech_Fi0(phases%length)) - allocate(constitutive_mech_partitionedFi0(phases%length)) - allocate(constitutive_mech_Fp(phases%length)) - allocate(constitutive_mech_Fp0(phases%length)) - allocate(constitutive_mech_partitionedFp0(phases%length)) - allocate(constitutive_mech_Li(phases%length)) - allocate(constitutive_mech_Li0(phases%length)) - allocate(constitutive_mech_partitionedLi0(phases%length)) - do ph = 1, phases%length - Nconstituents = count(material_phaseAt == ph) * discretization_nIPs - - allocate(constitutive_mech_Fi(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fi0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedFi0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fp(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fp0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedFp0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Li(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Li0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedLi0(ph)%data(3,3,Nconstituents)) - enddo - - print'(a42,1x,i10)', ' # of elements: ', eMax - print'(a42,1x,i10)', ' # of integration points/element: ', iMax - print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax - flush(IO_STDOUT) - - !$OMP PARALLEL DO PRIVATE(ph,me) - do el = 1, size(material_phaseMemberAt,3); do ip = 1, size(material_phaseMemberAt,2) - do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) - constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) & - / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) - constitutive_mech_Fi0(ph)%data(1:3,1:3,me) = math_I3 - - crystallite_F0(1:3,1:3,co,ip,el) = math_I3 - - crystallite_Fe(1:3,1:3,co,ip,el) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) - - constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) - constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) - - enddo - enddo; enddo - !$OMP END PARALLEL DO - - crystallite_partitionedF0 = crystallite_F0 - crystallite_F = crystallite_F0 - - - !$OMP PARALLEL DO PRIVATE(ph,me) - do el = 1, size(material_phaseMemberAt,3) - do ip = 1, size(material_phaseMemberAt,2) - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - call crystallite_orientations(co,ip,el) - call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,co,ip,el),co,ip,el) ! update dependent state variables to be consistent with basic states - enddo - enddo - enddo - !$OMP END PARALLEL DO - - -end subroutine crystallite_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief Backup data for homog cutback. -!-------------------------------------------------------------------------------------------------- -subroutine constitutive_initializeRestorationPoints(ip,el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - integer :: & - co, & !< constituent number - so,ph, me - - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp0(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el) = crystallite_F0(1:3,1:3,co,ip,el) - crystallite_partitionedS0(1:3,1:3,co,ip,el) = crystallite_S0(1:3,1:3,co,ip,el) - - call mech_initializeRestorationPoints(ph,me) - - do so = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(so)%state0( :,material_phasememberAt(co,ip,el)) - enddo - enddo - -end subroutine constitutive_initializeRestorationPoints - - -!-------------------------------------------------------------------------------------------------- -!> @brief Wind homog inc forward. -!-------------------------------------------------------------------------------------------------- -subroutine constitutive_windForward(ip,el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - - integer :: & - co, & !< constituent number - so, ph, me - - - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_F (1:3,1:3,co,ip,el) - crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp(1:3,1:3,co,ip,el) - crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) - - call constitutive_mech_windForward(ph,me) - do so = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state(:,me) - enddo - enddo - -end subroutine constitutive_windForward - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculate tangent (dPdF). -!-------------------------------------------------------------------------------------------------- -function crystallite_stressTangent(co,ip,el) result(dPdF) - - real(pReal), dimension(3,3,3,3) :: dPdF - integer, intent(in) :: & - co, & !< counter in constituent loop - ip, & !< counter in integration point loop - el !< counter in element loop - - integer :: & - o, & - p, ph, me - real(pReal), dimension(3,3) :: devNull, & - invSubFp0,invSubFi0,invFp,invFi, & - temp_33_1, temp_33_2, temp_33_3 - real(pReal), dimension(3,3,3,3) :: dSdFe, & - dSdF, & - dSdFi, & - dLidS, & ! tangent in lattice configuration - dLidFi, & - dLpdS, & - dLpdFi, & - dFidS, & - dFpinvdF, & - rhs_3333, & - lhs_3333, & - temp_3333 - real(pReal), dimension(9,9):: temp_99 - logical :: error - - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - - call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & - crystallite_Fe(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) - call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & - crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - co,ip,el) - - invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) - invFi = math_inv33(constitutive_mech_Fi(ph)%data(1:3,1:3,me)) - invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,co,ip,el)) - invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,co,ip,el)) - - if (sum(abs(dLidS)) < tol_math_check) then - dFidS = 0.0_pReal - else - lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal - do o=1,3; do p=1,3 - lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & - + crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) - lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & - + invFi*invFi(p,o) - rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & - - crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidS(1:3,1:3,o,p)) - enddo; enddo - call math_invert(temp_99,error,math_3333to99(lhs_3333)) - if (error) then - call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & - ext_msg='inversion error in analytic tangent calculation') - dFidS = 0.0_pReal - else - dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif - dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS - endif - - call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) - dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS - -!-------------------------------------------------------------------------------------------------- -! calculate dSdF - temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invSubFp0) - temp_33_3 = matmul(matmul(crystallite_F(1:3,1:3,co,ip,el),invFp), invSubFi0) - - do o=1,3; do p=1,3 - rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) - 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)) - enddo; enddo - lhs_3333 = crystallite_subdt(co,ip,el)*math_mul3333xx3333(dSdFe,temp_3333) & - + math_mul3333xx3333(dSdFi,dFidS) - - call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) - if (error) then - call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & - ext_msg='inversion error in analytic tangent calculation') - dSdF = rhs_3333 - else - dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif - -!-------------------------------------------------------------------------------------------------- -! calculate dFpinvdF - temp_3333 = math_mul3333xx3333(dLpdS,dSdF) - do o=1,3; do p=1,3 - dFpinvdF(1:3,1:3,p,o) = -crystallite_subdt(co,ip,el) & - * matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! assemble dPdF - temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) - temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) - temp_33_3 = matmul(temp_33_2,crystallite_S(1:3,1:3,co,ip,el)) - - dPdF = 0.0_pReal - do p=1,3 - dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1)) - enddo - do o=1,3; do p=1,3 - dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el), & - dFpinvdF(1:3,1:3,p,o)),temp_33_1) & - + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)), & - transpose(invFp)) & - + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) - enddo; enddo - -end function crystallite_stressTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates orientations -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_orientations(co,ip,el) - - integer, intent(in) :: & - co, & !< counter in integration point component loop - ip, & !< counter in integration point loop - el !< counter in element loop - - - call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) - - if (plasticState(material_phaseAt(1,el))%nonlocal) & - call plastic_nonlocal_updateCompatibility(crystallite_orientation, & - phase_plasticityInstance(material_phaseAt(1,el)),ip,el) - - -end subroutine crystallite_orientations - - -!-------------------------------------------------------------------------------------------------- -!> @brief Map 2nd order tensor to reference config -!-------------------------------------------------------------------------------------------------- -function crystallite_push33ToRef(co,ip,el, tensor33) - - real(pReal), dimension(3,3), intent(in) :: tensor33 - real(pReal), dimension(3,3) :: T - integer, intent(in):: & - el, & - ip, & - co - - real(pReal), dimension(3,3) :: crystallite_push33ToRef - - - T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(crystallite_F(1:3,1:3,co,ip,el)))) - crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) - -end function crystallite_push33ToRef - - -!-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, state with adaptive 1st order explicit Euler method -!> using Fixed Point Iteration to adapt the stepsize -!-------------------------------------------------------------------------------------------------- -function integrateSourceState(dt,co,ip,el) result(broken) - - real(pReal), intent(in) :: dt - integer, intent(in) :: & - el, & !< element index in element loop - ip, & !< integration point index in ip loop - co !< grain index in grain loop - - integer :: & - NiterationState, & !< number of iterations in state loop - ph, & - me, & - so - integer, dimension(maxval(phase_Nsources)) :: & - size_so - real(pReal) :: & - zeta - real(pReal), dimension(constitutive_source_maxSizeDotState) :: & - r ! state residuum - real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState - logical :: & - broken, converged_ - - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - - converged_ = .true. - broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,me) - if(broken) return - - do so = 1, phase_Nsources(ph) - size_so(so) = sourceState(ph)%p(so)%sizeDotState - sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - + sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt - source_dotState(1:size_so(so),2,so) = 0.0_pReal - enddo - - iteration: do NiterationState = 1, num%nState - - do so = 1, phase_Nsources(ph) - if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) - source_dotState(1:size_so(so),1,so) = sourceState(ph)%p(so)%dotState(:,me) - enddo - - broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,me) - if(broken) exit iteration - - do so = 1, phase_Nsources(ph) - zeta = damper(sourceState(ph)%p(so)%dotState(:,me), & - source_dotState(1:size_so(so),1,so),& - source_dotState(1:size_so(so),2,so)) - sourceState(ph)%p(so)%dotState(:,me) = sourceState(ph)%p(so)%dotState(:,me) * zeta & - + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) - r(1:size_so(so)) = sourceState(ph)%p(so)%state (1:size_so(so),me) & - - sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt - sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%state(1:size_so(so),me) & - - r(1:size_so(so)) - converged_ = converged_ .and. converged(r(1:size_so(so)), & - sourceState(ph)%p(so)%state(1:size_so(so),me), & - sourceState(ph)%p(so)%atol(1:size_so(so))) - enddo - - if(converged_) then - broken = constitutive_damage_deltaState(crystallite_Fe(1:3,1:3,co,ip,el),co,ip,el,ph,me) - exit iteration - endif - - enddo iteration - - broken = broken .or. .not. converged_ - - - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief calculate the damping for correction of state and dot state - !-------------------------------------------------------------------------------------------------- - real(pReal) pure function damper(current,previous,previous2) - - real(pReal), dimension(:), intent(in) ::& - current, previous, previous2 - - real(pReal) :: dot_prod12, dot_prod22 - - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(previous - previous2, previous - previous2) - if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then - damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - damper = 1.0_pReal - endif - - end function damper - -end function integrateSourceState - - -!-------------------------------------------------------------------------------------------------- -!> @brief determines whether a point is converged -!-------------------------------------------------------------------------------------------------- -logical pure function converged(residuum,state,atol) - - real(pReal), intent(in), dimension(:) ::& - residuum, state, atol - real(pReal) :: & - rTol - - rTol = num%rTol_crystalliteState - - converged = all(abs(residuum) <= max(atol, rtol*abs(state))) - -end function converged - - -!-------------------------------------------------------------------------------------------------- -!> @brief Write current restart information (Field and constitutive data) to file. -! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_restartWrite - - integer :: ph - integer(HID_T) :: fileHandle, groupHandle - character(len=pStringLen) :: fileName, datasetName - - print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT) - - write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName,'a') - - call HDF5_write(fileHandle,crystallite_F,'F') - call HDF5_write(fileHandle,crystallite_Lp, 'L_p') - call HDF5_write(fileHandle,crystallite_S, 'S') - - groupHandle = HDF5_addGroup(fileHandle,'phase') - do ph = 1,size(material_name_phase) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_write(groupHandle,plasticState(ph)%state,datasetName) - write(datasetName,'(i0,a)') ph,'_F_i' - call HDF5_write(groupHandle,constitutive_mech_Fi(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_L_i' - call HDF5_write(groupHandle,constitutive_mech_Li(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_F_p' - call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) - enddo - call HDF5_closeGroup(groupHandle) - - groupHandle = HDF5_addGroup(fileHandle,'homogenization') - do ph = 1, size(material_name_homogenization) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_write(groupHandle,homogState(ph)%state,datasetName) - enddo - call HDF5_closeGroup(groupHandle) - - call HDF5_closeFile(fileHandle) - -end subroutine crystallite_restartWrite - - -!-------------------------------------------------------------------------------------------------- -!> @brief Read data for restart -! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_restartRead - - integer :: ph - integer(HID_T) :: fileHandle, groupHandle - character(len=pStringLen) :: fileName, datasetName - - print'(/,a,i0,a)', ' reading restart information of increment from file' - - write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName) - - call HDF5_read(fileHandle,crystallite_F0, 'F') - call HDF5_read(fileHandle,crystallite_Lp0,'L_p') - call HDF5_read(fileHandle,crystallite_S0, 'S') - - groupHandle = HDF5_openGroup(fileHandle,'phase') - do ph = 1,size(material_name_phase) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_read(groupHandle,plasticState(ph)%state0,datasetName) - write(datasetName,'(i0,a)') ph,'_F_i' - call HDF5_read(groupHandle,constitutive_mech_Fi0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_L_i' - call HDF5_read(groupHandle,constitutive_mech_Li0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_F_p' - call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) - enddo - call HDF5_closeGroup(groupHandle) - - groupHandle = HDF5_openGroup(fileHandle,'homogenization') - do ph = 1,size(material_name_homogenization) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_read(groupHandle,homogState(ph)%state0,datasetName) - enddo - call HDF5_closeGroup(groupHandle) - - call HDF5_closeFile(fileHandle) - -end subroutine crystallite_restartRead - - -end module constitutive diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 deleted file mode 100644 index 3ce614666..000000000 --- a/src/constitutive_damage.f90 +++ /dev/null @@ -1,253 +0,0 @@ -!---------------------------------------------------------------------------------------------------- -!> @brief internal microstructure state for all damage sources and kinematics constitutive models -!---------------------------------------------------------------------------------------------------- -submodule(constitutive) constitutive_damage - - interface - - module function source_damage_anisoBrittle_init(source_length) result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - end function source_damage_anisoBrittle_init - - module function source_damage_anisoDuctile_init(source_length) result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - end function source_damage_anisoDuctile_init - - module function source_damage_isoBrittle_init(source_length) result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - end function source_damage_isoBrittle_init - - module function source_damage_isoDuctile_init(source_length) result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - end function source_damage_isoDuctile_init - - module function kinematics_cleavage_opening_init(kinematics_length) result(myKinematics) - integer, intent(in) :: kinematics_length - logical, dimension(:,:), allocatable :: myKinematics - end function kinematics_cleavage_opening_init - - module function kinematics_slipplane_opening_init(kinematics_length) result(myKinematics) - integer, intent(in) :: kinematics_length - logical, dimension(:,:), allocatable :: myKinematics - end function kinematics_slipplane_opening_init - - - module subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - integer, intent(in) :: & - phase, & !< phase ID of element - constituent !< position of element within its phase instance - real(pReal), intent(in) :: & - phi !< damage parameter - real(pReal), intent(out) :: & - localphiDot, & - dLocalphiDot_dPhi - end subroutine source_damage_anisoBrittle_getRateAndItsTangent - - module subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - integer, intent(in) :: & - phase, & !< phase ID of element - constituent !< position of element within its phase instance - real(pReal), intent(in) :: & - phi !< damage parameter - real(pReal), intent(out) :: & - localphiDot, & - dLocalphiDot_dPhi - end subroutine source_damage_anisoDuctile_getRateAndItsTangent - - module subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - integer, intent(in) :: & - phase, & !< phase ID of element - constituent !< position of element within its phase instance - real(pReal), intent(in) :: & - phi !< damage parameter - real(pReal), intent(out) :: & - localphiDot, & - dLocalphiDot_dPhi - end subroutine source_damage_isoBrittle_getRateAndItsTangent - - module subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - integer, intent(in) :: & - phase, & !< phase ID of element - constituent !< position of element within its phase instance - real(pReal), intent(in) :: & - phi !< damage parameter - real(pReal), intent(out) :: & - localphiDot, & - dLocalphiDot_dPhi - end subroutine source_damage_isoDuctile_getRateAndItsTangent - - module subroutine source_damage_anisoBrittle_results(phase,group) - integer, intent(in) :: phase - character(len=*), intent(in) :: group - end subroutine source_damage_anisoBrittle_results - - module subroutine source_damage_anisoDuctile_results(phase,group) - integer, intent(in) :: phase - character(len=*), intent(in) :: group - end subroutine source_damage_anisoDuctile_results - - module subroutine source_damage_isoBrittle_results(phase,group) - integer, intent(in) :: phase - character(len=*), intent(in) :: group - end subroutine source_damage_isoBrittle_results - - module subroutine source_damage_isoDuctile_results(phase,group) - integer, intent(in) :: phase - character(len=*), intent(in) :: group - end subroutine source_damage_isoDuctile_results - - end interface - -contains - -!---------------------------------------------------------------------------------------------- -!< @brief initialize damage sources and kinematics mechanism -!---------------------------------------------------------------------------------------------- -module subroutine damage_init - - integer :: & - ph !< counter in phase loop - class(tNode), pointer :: & - phases, & - phase, & - sources, & - kinematics - - phases => config_material%get('phase') - - allocate(sourceState (phases%length)) - allocate(phase_Nsources(phases%length),source = 0) ! same for kinematics - - do ph = 1,phases%length - phase => phases%get(ph) - sources => phase%get('source',defaultVal=emptyList) - phase_Nsources(ph) = sources%length - allocate(sourceState(ph)%p(phase_Nsources(ph))) - enddo - - allocate(phase_source(maxval(phase_Nsources),phases%length), source = SOURCE_undefined_ID) - -! initialize source mechanisms - if(maxval(phase_Nsources) /= 0) then - where(source_damage_isoBrittle_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoBrittle_ID - where(source_damage_isoDuctile_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoDuctile_ID - where(source_damage_anisoBrittle_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoBrittle_ID - where(source_damage_anisoDuctile_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoDuctile_ID - endif - -!-------------------------------------------------------------------------------------------------- -! initialize kinematic mechanisms - allocate(phase_Nkinematics(phases%length),source = 0) - do ph = 1,phases%length - phase => phases%get(ph) - kinematics => phase%get('kinematics',defaultVal=emptyList) - phase_Nkinematics(ph) = kinematics%length - enddo - - allocate(phase_kinematics(maxval(phase_Nkinematics),phases%length), source = KINEMATICS_undefined_ID) - - if(maxval(phase_Nkinematics) /= 0) then - where(kinematics_cleavage_opening_init(maxval(phase_Nkinematics))) phase_kinematics = KINEMATICS_cleavage_opening_ID - where(kinematics_slipplane_opening_init(maxval(phase_Nkinematics))) phase_kinematics = KINEMATICS_slipplane_opening_ID - endif - -end subroutine damage_init - - -!---------------------------------------------------------------------------------------------- -!< @brief returns local part of nonlocal damage driving force -!---------------------------------------------------------------------------------------------- -module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi, phi, ip, el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - phi !< damage parameter - real(pReal), intent(inout) :: & - phiDot, & - dPhiDot_dPhi - - real(pReal) :: & - localphiDot, & - dLocalphiDot_dPhi - integer :: & - phase, & - grain, & - source, & - constituent - - phiDot = 0.0_pReal - dPhiDot_dPhi = 0.0_pReal - - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - phase = material_phaseAt(grain,el) - constituent = material_phasememberAt(grain,ip,el) - do source = 1, phase_Nsources(phase) - select case(phase_source(source,phase)) - case (SOURCE_damage_isoBrittle_ID) - call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - - case (SOURCE_damage_isoDuctile_ID) - call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - - case (SOURCE_damage_anisoBrittle_ID) - call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - - case (SOURCE_damage_anisoDuctile_ID) - call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - - case default - localphiDot = 0.0_pReal - dLocalphiDot_dPhi = 0.0_pReal - - end select - phiDot = phiDot + localphiDot - dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi - enddo - enddo - -end subroutine constitutive_damage_getRateAndItsTangents - - -!---------------------------------------------------------------------------------------------- -!< @brief writes damage sources results to HDF5 output file -!---------------------------------------------------------------------------------------------- -module subroutine damage_results(group,ph) - - character(len=*), intent(in) :: group - integer, intent(in) :: ph - - integer :: so - - sourceLoop: do so = 1, phase_Nsources(ph) - - if (phase_source(so,ph) /= SOURCE_UNDEFINED_ID) & - call results_closeGroup(results_addGroup(group//'sources/')) ! should be 'damage' - - sourceType: select case (phase_source(so,ph)) - - case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_results(ph,group//'sources/') - - case (SOURCE_damage_anisoDuctile_ID) sourceType - call source_damage_anisoDuctile_results(ph,group//'sources/') - - case (SOURCE_damage_isoBrittle_ID) sourceType - call source_damage_isoBrittle_results(ph,group//'sources/') - - case (SOURCE_damage_isoDuctile_ID) sourceType - call source_damage_isoDuctile_results(ph,group//'sources/') - - end select sourceType - - enddo SourceLoop - -end subroutine damage_results - - -end submodule constitutive_damage diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 deleted file mode 100644 index a7d5d3259..000000000 --- a/src/constitutive_thermal.f90 +++ /dev/null @@ -1,125 +0,0 @@ -!---------------------------------------------------------------------------------------------------- -!> @brief internal microstructure state for all thermal sources and kinematics constitutive models -!---------------------------------------------------------------------------------------------------- -submodule(constitutive) constitutive_thermal - - interface - - module function source_thermal_dissipation_init(source_length) result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - end function source_thermal_dissipation_init - - module function source_thermal_externalheat_init(source_length) result(mySources) - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - end function source_thermal_externalheat_init - - module function kinematics_thermal_expansion_init(kinematics_length) result(myKinematics) - integer, intent(in) :: kinematics_length - logical, dimension(:,:), allocatable :: myKinematics - end function kinematics_thermal_expansion_init - - - module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT, Tstar, Lp, phase) - integer, intent(in) :: & - phase !< phase ID of element - real(pReal), intent(in), dimension(3,3) :: & - Tstar !< 2nd Piola Kirchhoff stress tensor for a given element - real(pReal), intent(in), dimension(3,3) :: & - Lp !< plastic velocuty gradient for a given element - real(pReal), intent(out) :: & - TDot, & - dTDot_dT - end subroutine source_thermal_dissipation_getRateAndItsTangent - - module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of) - integer, intent(in) :: & - phase, & - of - real(pReal), intent(out) :: & - TDot, & - dTDot_dT - end subroutine source_thermal_externalheat_getRateAndItsTangent - - end interface - -contains - -!---------------------------------------------------------------------------------------------- -!< @brief initializes thermal sources and kinematics mechanism -!---------------------------------------------------------------------------------------------- -module subroutine thermal_init - -! initialize source mechanisms - if(maxval(phase_Nsources) /= 0) then - where(source_thermal_dissipation_init (maxval(phase_Nsources))) phase_source = SOURCE_thermal_dissipation_ID - where(source_thermal_externalheat_init(maxval(phase_Nsources))) phase_source = SOURCE_thermal_externalheat_ID - endif - -!-------------------------------------------------------------------------------------------------- -!initialize kinematic mechanisms - if(maxval(phase_Nkinematics) /= 0) where(kinematics_thermal_expansion_init(maxval(phase_Nkinematics))) & - phase_kinematics = KINEMATICS_thermal_expansion_ID - -end subroutine thermal_init - - -!---------------------------------------------------------------------------------------------- -!< @brief calculates thermal dissipation rate -!---------------------------------------------------------------------------------------------- -module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, S, Lp, ip, el) - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - T - real(pReal), intent(in), dimension(:,:,:,:,:) :: & - S, & !< current 2nd Piola Kirchhoff stress - Lp !< plastic velocity gradient - real(pReal), intent(inout) :: & - TDot, & - dTDot_dT - - real(pReal) :: & - my_Tdot, & - my_dTdot_dT - integer :: & - phase, & - homog, & - instance, & - grain, & - source, & - constituent - - homog = material_homogenizationAt(el) - instance = thermal_typeInstance(homog) - - do grain = 1, homogenization_Nconstituents(homog) - phase = material_phaseAt(grain,el) - constituent = material_phasememberAt(grain,ip,el) - do source = 1, phase_Nsources(phase) - select case(phase_source(source,phase)) - case (SOURCE_thermal_dissipation_ID) - call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - S(1:3,1:3,grain,ip,el), & - Lp(1:3,1:3,grain,ip,el), & - phase) - - case (SOURCE_thermal_externalheat_ID) - call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - phase, constituent) - - case default - my_Tdot = 0.0_pReal - my_dTdot_dT = 0.0_pReal - end select - Tdot = Tdot + my_Tdot - dTdot_dT = dTdot_dT + my_dTdot_dT - enddo - enddo - -end subroutine constitutive_thermal_getRateAndItsTangents - - -end submodule constitutive_thermal diff --git a/src/damage_none.f90 b/src/damage_none.f90 deleted file mode 100644 index 3f1144833..000000000 --- a/src/damage_none.f90 +++ /dev/null @@ -1,39 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for constant damage field -!-------------------------------------------------------------------------------------------------- -module damage_none - use prec - use config - use material - - implicit none - public - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields, reads information from material configuration file -!-------------------------------------------------------------------------------------------------- -subroutine damage_none_init - - integer :: h,Nmaterialpoints - - print'(/,a)', ' <<<+- damage_none init -+>>>'; flush(6) - - do h = 1, size(material_name_homogenization) - if (damage_type(h) /= DAMAGE_NONE_ID) cycle - - Nmaterialpoints = count(material_homogenizationAt == h) - damageState(h)%sizeState = 0 - allocate(damageState(h)%state0 (0,Nmaterialpoints)) - allocate(damageState(h)%subState0(0,Nmaterialpoints)) - allocate(damageState(h)%state (0,Nmaterialpoints)) - - allocate (damage(h)%p(Nmaterialpoints), source=1.0_pReal) - - enddo - -end subroutine damage_none_init - -end module damage_none diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 deleted file mode 100644 index 3db63cab2..000000000 --- a/src/damage_nonlocal.f90 +++ /dev/null @@ -1,208 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for non-locally evolving damage field -!-------------------------------------------------------------------------------------------------- -module damage_nonlocal - use prec - use material - use config - use YAML_types - use lattice - use constitutive - use results - - implicit none - private - - type :: tParameters - character(len=pStringLen), allocatable, dimension(:) :: & - output - end type tParameters - - type, private :: tNumerics - real(pReal) :: & - charLength !< characteristic length scale for gradient problems - end type tNumerics - - type(tparameters), dimension(:), allocatable :: & - param - type(tNumerics), private :: & - num - - public :: & - damage_nonlocal_init, & - damage_nonlocal_getSourceAndItsTangent, & - damage_nonlocal_getDiffusion, & - damage_nonlocal_getMobility, & - damage_nonlocal_putNonLocalDamage, & - damage_nonlocal_results - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine damage_nonlocal_init - - integer :: Ninstances,Nmaterialpoints,h - class(tNode), pointer :: & - num_generic, & - material_homogenization, & - homog, & - homogDamage - - print'(/,a)', ' <<<+- damage_nonlocal init -+>>>'; flush(6) - -!------------------------------------------------------------------------------------ -! read numerics parameter - num_generic => config_numerics%get('generic',defaultVal= emptyDict) - num%charLength = num_generic%get_asFloat('charLength',defaultVal=1.0_pReal) - - Ninstances = count(damage_type == DAMAGE_nonlocal_ID) - allocate(param(Ninstances)) - - material_homogenization => config_material%get('homogenization') - do h = 1, material_homogenization%length - if (damage_type(h) /= DAMAGE_NONLOCAL_ID) cycle - homog => material_homogenization%get(h) - homogDamage => homog%get('damage') - associate(prm => param(damage_typeInstance(h))) - -#if defined (__GFORTRAN__) - prm%output = output_asStrings(homogDamage) -#else - prm%output = homogDamage%get_asStrings('output',defaultVal=emptyStringArray) -#endif - - Nmaterialpoints = count(material_homogenizationAt == h) - damageState(h)%sizeState = 1 - allocate(damageState(h)%state0 (1,Nmaterialpoints), source=1.0_pReal) - allocate(damageState(h)%subState0(1,Nmaterialpoints), source=1.0_pReal) - allocate(damageState(h)%state (1,Nmaterialpoints), source=1.0_pReal) - - damage(h)%p => damageState(h)%state(1,:) - - end associate - enddo - -end subroutine damage_nonlocal_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates homogenized damage driving forces -!-------------------------------------------------------------------------------------------------- -subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - phi - real(pReal) :: & - phiDot, dPhiDot_dPhi - - phiDot = 0.0_pReal - dPhiDot_dPhi = 0.0_pReal - - call constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi, phi, ip, el) - phiDot = phiDot/real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal) - dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal) - -end subroutine damage_nonlocal_getSourceAndItsTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized non local damage diffusion tensor in reference configuration -!-------------------------------------------------------------------------------------------------- -function damage_nonlocal_getDiffusion(ip,el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - damage_nonlocal_getDiffusion - integer :: & - homog, & - grain - - homog = material_homogenizationAt(el) - damage_nonlocal_getDiffusion = 0.0_pReal - do grain = 1, homogenization_Nconstituents(homog) - damage_nonlocal_getDiffusion = damage_nonlocal_getDiffusion + & - crystallite_push33ToRef(grain,ip,el,lattice_D(1:3,1:3,material_phaseAt(grain,el))) - enddo - - damage_nonlocal_getDiffusion = & - num%charLength**2*damage_nonlocal_getDiffusion/real(homogenization_Nconstituents(homog),pReal) - -end function damage_nonlocal_getDiffusion - - -!-------------------------------------------------------------------------------------------------- -!> @brief Returns homogenized nonlocal damage mobility -!-------------------------------------------------------------------------------------------------- -real(pReal) function damage_nonlocal_getMobility(ip,el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - integer :: & - co - - damage_nonlocal_getMobility = 0.0_pReal - - do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_M(material_phaseAt(co,el)) - enddo - - damage_nonlocal_getMobility = damage_nonlocal_getMobility/& - real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal) - -end function damage_nonlocal_getMobility - - -!-------------------------------------------------------------------------------------------------- -!> @brief updated nonlocal damage field with solution from damage phase field PDE -!-------------------------------------------------------------------------------------------------- -subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - phi - integer :: & - homog, & - offset - - homog = material_homogenizationAt(el) - offset = material_homogenizationMemberAt(ip,el) - damage(homog)%p(offset) = phi - -end subroutine damage_nonlocal_putNonLocalDamage - - -!-------------------------------------------------------------------------------------------------- -!> @brief writes results to HDF5 output file -!-------------------------------------------------------------------------------------------------- -subroutine damage_nonlocal_results(homog,group) - - integer, intent(in) :: homog - character(len=*), intent(in) :: group - - integer :: o - - associate(prm => param(damage_typeInstance(homog))) - outputsLoop: do o = 1,size(prm%output) - select case(prm%output(o)) - case ('phi') - call results_writeDataset(group,damage(homog)%p,prm%output(o),& - 'damage indicator','-') - end select - enddo outputsLoop - end associate - -end subroutine damage_nonlocal_results - -end module damage_nonlocal diff --git a/src/element.f90 b/src/element.f90 index 722a7fd96..5b7af36bd 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -686,7 +686,7 @@ module element 1, 5,11, 7, 8,12,15,14, & 5, 2, 6,11,12, 9,13,15, & 7,11, 6, 3,14,15,13,10, & - 8,12,15, 4, 4, 9,13,10 & + 8,12,15,14, 4, 9,13,10 & #if !defined(__GFORTRAN__) ],shape(CELL6)) #else diff --git a/src/future.f90 b/src/future.f90 deleted file mode 100644 index b7eb3fec9..000000000 --- a/src/future.f90 +++ /dev/null @@ -1,35 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief New fortran functions for compiler versions that do not support them -!-------------------------------------------------------------------------------------------------- -module future - use prec - - implicit none - public - -contains - -#if defined(__GFORTRAN__) && __GNUC__<9 || defined(__INTEL_COMPILER) && INTEL_COMPILER<1800 -!-------------------------------------------------------------------------------------------------- -!> @brief substitute for the findloc intrinsic (only for integer, dimension(:) at the moment) -!-------------------------------------------------------------------------------------------------- -function findloc(a,v) - - integer, intent(in), dimension(:) :: a - integer, intent(in) :: v - integer :: i,j - integer, allocatable, dimension(:) :: findloc - - allocate(findloc(count(a==v))) - j = 1 - do i = 1, size(a) - if (a(i)==v) then - findloc(j) = i - j = j + 1 - endif - enddo -end function findloc -#endif - -end module future diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 514443dbb..0aa462e7e 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -18,9 +18,9 @@ program DAMASK_grid use CPFEM2 use material use spectral_utilities - use grid_mech_spectral_basic - use grid_mech_spectral_polarisation - use grid_mech_FEM + use grid_mechanical_spectral_basic + use grid_mechanical_spectral_polarisation + use grid_mechanical_FEM use grid_damage_spectral use grid_thermal_spectral use results @@ -36,10 +36,11 @@ program DAMASK_grid integer :: N, & !< number of increments f_out, & !< frequency of result writes f_restart !< frequency of restart writes - logical :: drop_guessing !< do not follow trajectory of former loadcase - integer(kind(FIELD_UNDEFINED_ID)), allocatable :: ID(:) + logical :: estimate_rate !< follow trajectory of former loadcase end type tLoadCase + integer(kind(FIELD_UNDEFINED_ID)), allocatable :: ID(:) + !-------------------------------------------------------------------------------------------------- ! variables related to information from load case and geom file real(pReal), dimension(9) :: temp_valueVector !< temporarily from loadcase file when reading in tensors (initialize to 0.0) @@ -53,6 +54,7 @@ program DAMASK_grid integer, parameter :: & subStepFactor = 2 !< for each substep, divide the last time increment by 2.0 real(pReal) :: & + T_0 = 300.0_pReal, & time = 0.0_pReal, & !< elapsed time time0 = 0.0_pReal, & !< begin of interval timeinc = 1.0_pReal, & !< current time interval @@ -61,10 +63,12 @@ program DAMASK_grid logical :: & guess, & !< guess along former trajectory stagIterate, & - cutBack = .false. + cutBack = .false.,& + signal integer :: & i, j, m, field, & errorID = 0, & + ierr,& cutBackLevel = 0, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ stepFraction = 0, & !< fraction of current time interval l = 0, & !< current load case @@ -76,30 +80,33 @@ program DAMASK_grid maxCutBack, & !< max number of cut backs stagItMax !< max number of field level staggered iterations character(len=pStringLen) :: & - incInfo, & - loadcase_string + incInfo type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases type(tSolutionState), allocatable, dimension(:) :: solres - procedure(grid_mech_spectral_basic_init), pointer :: & - mech_init - procedure(grid_mech_spectral_basic_forward), pointer :: & - mech_forward - procedure(grid_mech_spectral_basic_solution), pointer :: & - mech_solution - procedure(grid_mech_spectral_basic_updateCoords), pointer :: & - mech_updateCoords - procedure(grid_mech_spectral_basic_restartWrite), pointer :: & - mech_restartWrite + procedure(grid_mechanical_spectral_basic_init), pointer :: & + mechanical_init + procedure(grid_mechanical_spectral_basic_forward), pointer :: & + mechanical_forward + procedure(grid_mechanical_spectral_basic_solution), pointer :: & + mechanical_solution + procedure(grid_mechanical_spectral_basic_updateCoords), pointer :: & + mechanical_updateCoords + procedure(grid_mechanical_spectral_basic_restartWrite), pointer :: & + mechanical_restartWrite external :: & quit class (tNode), pointer :: & num_grid, & - debug_grid, & ! pointer to grid debug options config_load, & load_steps, & load_step, & + solver, & + initial_conditions, & + ic_thermal, & + thermal, & + step_bc, & step_mech, & step_discretization, & step_deformation, & @@ -109,17 +116,11 @@ program DAMASK_grid ! init DAMASK (all modules) call CPFEM_initAll - print'(/,a)', ' <<<+- DAMASK_spectral init -+>>>'; flush(IO_STDOUT) + print'(/,a)', ' <<<+- DAMASK_grid init -+>>>'; flush(IO_STDOUT) print*, 'Shanthraj et al., Handbook of Mechanics of Materials, 2019' print*, 'https://doi.org/10.1007/978-981-10-6855-3_80' -!-------------------------------------------------------------------------------------------------- -! initialize field solver information - nActiveFields = 1 - if (any(thermal_type == THERMAL_conduction_ID )) nActiveFields = nActiveFields + 1 - if (any(damage_type == DAMAGE_nonlocal_ID )) nActiveFields = nActiveFields + 1 - allocate(solres(nActiveFields)) !------------------------------------------------------------------------------------------------- ! reading field paramters from numerics file and do sanity checks @@ -130,62 +131,69 @@ program DAMASK_grid if (stagItMax < 0) call IO_error(301,ext_msg='maxStaggeredIter') if (maxCutBack < 0) call IO_error(301,ext_msg='maxCutBack') + config_load => YAML_parse_file(trim(interface_loadFile)) + solver => config_load%get('solver') + !-------------------------------------------------------------------------------------------------- ! assign mechanics solver depending on selected type - debug_grid => config_debug%get('grid',defaultVal=emptyList) - select case (trim(num_grid%get_asString('solver', defaultVal = 'Basic'))) - case ('Basic') - mech_init => grid_mech_spectral_basic_init - mech_forward => grid_mech_spectral_basic_forward - mech_solution => grid_mech_spectral_basic_solution - mech_updateCoords => grid_mech_spectral_basic_updateCoords - mech_restartWrite => grid_mech_spectral_basic_restartWrite + nActiveFields = 1 + select case (solver%get_asString('mechanical')) + case ('spectral_basic') + mechanical_init => grid_mechanical_spectral_basic_init + mechanical_forward => grid_mechanical_spectral_basic_forward + mechanical_solution => grid_mechanical_spectral_basic_solution + mechanical_updateCoords => grid_mechanical_spectral_basic_updateCoords + mechanical_restartWrite => grid_mechanical_spectral_basic_restartWrite - case ('Polarisation') - mech_init => grid_mech_spectral_polarisation_init - mech_forward => grid_mech_spectral_polarisation_forward - mech_solution => grid_mech_spectral_polarisation_solution - mech_updateCoords => grid_mech_spectral_polarisation_updateCoords - mech_restartWrite => grid_mech_spectral_polarisation_restartWrite + case ('spectral_polarization') + mechanical_init => grid_mechanical_spectral_polarisation_init + mechanical_forward => grid_mechanical_spectral_polarisation_forward + mechanical_solution => grid_mechanical_spectral_polarisation_solution + mechanical_updateCoords => grid_mechanical_spectral_polarisation_updateCoords + mechanical_restartWrite => grid_mechanical_spectral_polarisation_restartWrite case ('FEM') - mech_init => grid_mech_FEM_init - mech_forward => grid_mech_FEM_forward - mech_solution => grid_mech_FEM_solution - mech_updateCoords => grid_mech_FEM_updateCoords - mech_restartWrite => grid_mech_FEM_restartWrite + mechanical_init => grid_mechanical_FEM_init + mechanical_forward => grid_mechanical_FEM_forward + mechanical_solution => grid_mechanical_FEM_solution + mechanical_updateCoords => grid_mechanical_FEM_updateCoords + mechanical_restartWrite => grid_mechanical_FEM_restartWrite case default - call IO_error(error_ID = 891, ext_msg = trim(num_grid%get_asString('solver'))) + call IO_error(error_ID = 891, ext_msg = trim(solver%get_asString('mechanical'))) end select +!-------------------------------------------------------------------------------------------------- +! initialize field solver information + if (solver%get_asString('thermal',defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1 + if (solver%get_asString('damage', defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1 + + allocate(solres(nActiveFields)) + allocate( ID(nActiveFields)) + + field = 1 + ID(field) = FIELD_MECH_ID ! mechanical active by default + thermalActive: if (solver%get_asString('thermal',defaultVal = 'n/a') == 'spectral') then + field = field + 1 + ID(field) = FIELD_THERMAL_ID + endif thermalActive + damageActive: if (solver%get_asString('damage',defaultVal = 'n/a') == 'spectral') then + field = field + 1 + ID(field) = FIELD_DAMAGE_ID + endif damageActive + !-------------------------------------------------------------------------------------------------- -! reading information from load case file and to sanity checks - config_load => YAML_parse_file(trim(interface_loadFile)) - - load_steps => config_load%get('step') + load_steps => config_load%get('loadstep') allocate(loadCases(load_steps%length)) ! array of load cases do l = 1, load_steps%length - allocate(loadCases(l)%ID(nActiveFields)) - field = 1 - loadCases(l)%ID(field) = FIELD_MECH_ID ! mechanical active by default - thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then - field = field + 1 - loadCases(l)%ID(field) = FIELD_THERMAL_ID - endif thermalActive - damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then - field = field + 1 - loadCases(l)%ID(field) = FIELD_DAMAGE_ID - endif damageActive - load_step => load_steps%get(l) - - step_mech => load_step%get('mechanics') + step_bc => load_step%get('boundary_conditions') + step_mech => step_bc%get('mechanical') loadCases(l)%stress%myType='' readMech: do m = 1, step_mech%length select case (step_mech%getKey(m)) @@ -217,21 +225,19 @@ program DAMASK_grid if (.not. allocated(loadCases(l)%deformation%myType)) call IO_error(error_ID=837,ext_msg = 'L/dot_F/F missing') step_discretization => load_step%get('discretization') - if(.not. step_discretization%contains('t')) call IO_error(error_ID=837,ext_msg = 't missing') - if(.not. step_discretization%contains('N')) call IO_error(error_ID=837,ext_msg = 'N missing') + if (.not. step_discretization%contains('t')) call IO_error(error_ID=837,ext_msg = 't missing') + if (.not. step_discretization%contains('N')) call IO_error(error_ID=837,ext_msg = 'N missing') loadCases(l)%t = step_discretization%get_asFloat('t') loadCases(l)%N = step_discretization%get_asInt ('N') loadCases(l)%r = step_discretization%get_asFloat('r', defaultVal= 1.0_pReal) - loadCases(l)%f_out = step_discretization%get_asInt ('f_out', defaultVal=1) - loadCases(l)%f_restart = step_discretization%get_asInt ('f_restart', defaultVal=huge(0)) - loadCases(l)%drop_guessing = (load_step%get_asBool('drop_guessing',defaultVal=.false.) .or. & - merge(.false.,.true.,l > 1)) + loadCases(l)%f_restart = load_step%get_asInt('f_restart', defaultVal=huge(0)) + loadCases(l)%f_out = load_step%get_asInt('f_out', defaultVal=1) + loadCases(l)%estimate_rate = (load_step%get_asBool('estimate_rate',defaultVal=.true.) .and. l>1) reportAndCheck: if (worldrank == 0) then - write (loadcase_string, '(i0)' ) l print'(/,a,i0)', ' load case: ', l - print*, ' drop_guessing:', loadCases(l)%drop_guessing + print*, ' estimate_rate:', loadCases(l)%estimate_rate if (loadCases(l)%deformation%myType == 'L') then do j = 1, 3 if (any(loadCases(l)%deformation%mask(j,1:3) .eqv. .true.) .and. & @@ -283,13 +289,13 @@ program DAMASK_grid else print'(a,f0.3)', ' r: ', loadCases(l)%r endif - print'(a,f0.3)', ' t: ', loadCases(l)%t - print'(a,i0)', ' N: ', loadCases(l)%N - print'(a,i0)', ' f_out: ', loadCases(l)%f_out + print'(a,f0.3)', ' t: ', loadCases(l)%t + print'(a,i0)', ' N: ', loadCases(l)%N + print'(a,i0)', ' f_out: ', loadCases(l)%f_out if (loadCases(l)%f_restart < huge(0)) & - print'(a,i0)', ' f_restart: ', loadCases(l)%f_restart + print'(a,i0)', ' f_restart: ', loadCases(l)%f_restart - if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message + if (errorID > 0) call IO_error(error_ID = errorID, el = l) endif reportAndCheck enddo @@ -298,12 +304,14 @@ program DAMASK_grid ! doing initialization depending on active solvers call spectral_Utilities_init do field = 1, nActiveFields - select case (loadCases(1)%ID(field)) + select case (ID(field)) case(FIELD_MECH_ID) - call mech_init + call mechanical_init case(FIELD_THERMAL_ID) - call grid_thermal_spectral_init + initial_conditions => config_load%get('initial_conditions',defaultVal=emptyDict) + thermal => initial_conditions%get('thermal',defaultVal=emptyDict) + call grid_thermal_spectral_init(thermal%get_asFloat('T',defaultVal = T_0)) case(FIELD_DAMAGE_ID) call grid_damage_spectral_init @@ -331,7 +339,7 @@ program DAMASK_grid loadCaseLooping: do l = 1, size(loadCases) time0 = time ! load case start time - guess = .not. loadCases(l)%drop_guessing ! change of load case? homogeneous guess for the first inc + 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 @@ -374,9 +382,9 @@ program DAMASK_grid !-------------------------------------------------------------------------------------------------- ! forward fields do field = 1, nActiveFields - select case(loadCases(l)%ID(field)) + select case(ID(field)) case(FIELD_MECH_ID) - call mech_forward (& + call mechanical_forward (& cutBack,guess,timeinc,timeIncOld,remainingLoadCaseTime, & deformation_BC = loadCases(l)%deformation, & stress_BC = loadCases(l)%stress, & @@ -394,9 +402,9 @@ program DAMASK_grid stagIterate = .true. do while (stagIterate) do field = 1, nActiveFields - select case(loadCases(l)%ID(field)) + select case(ID(field)) case(FIELD_MECH_ID) - solres(field) = mech_solution(incInfo) + solres(field) = mechanical_solution(incInfo) case(FIELD_THERMAL_ID) solres(field) = grid_thermal_spectral_solution(timeinc) case(FIELD_DAMAGE_ID) @@ -417,13 +425,13 @@ program DAMASK_grid if ( (all(solres(:)%converged .and. solres(:)%stagConverged)) & ! converged .and. .not. solres(1)%termIll) then ! and acceptable solution found - call mech_updateCoords + call mechanical_updateCoords timeIncOld = timeinc cutBack = .false. guess = .true. ! start guessing after first converged (sub)inc if (worldrank == 0) then write(statUnit,*) totalIncsCounter, time, cutBackLevel, & - solres%converged, solres%iterationsNeeded + solres(1)%converged, solres(1)%iterationsNeeded flush(statUnit) endif elseif (cutBackLevel < maxCutBack) then ! further cutbacking tolerated? @@ -449,18 +457,27 @@ program DAMASK_grid print'(/,a,i0,a)', ' increment ', totalIncsCounter, ' NOT converged' endif; flush(IO_STDOUT) - if (mod(inc,loadCases(l)%f_out) == 0) then + call MPI_Allreduce(interface_SIGUSR1,signal,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) + if (ierr /= 0) error stop 'MPI error' + if (mod(inc,loadCases(l)%f_out) == 0 .or. signal) then print'(1/,a)', ' ... writing results to file ......................................' flush(IO_STDOUT) call CPFEM_results(totalIncsCounter,time) endif - if (mod(inc,loadCases(l)%f_restart) == 0) then - call mech_restartWrite + if(signal) call interface_setSIGUSR1(.false.) + call MPI_Allreduce(interface_SIGUSR2,signal,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) + if (ierr /= 0) error stop 'MPI error' + if (mod(inc,loadCases(l)%f_restart) == 0 .or. signal) then + call mechanical_restartWrite call CPFEM_restartWrite endif + if(signal) call interface_setSIGUSR2(.false.) + call MPI_Allreduce(interface_SIGTERM,signal,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) + if (ierr /= 0) error stop 'MPI error' + if (signal) exit loadCaseLooping endif skipping - enddo incLooping + enddo incLooping enddo loadCaseLooping diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 48ad5b7e1..bb6fa9d8d 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -68,8 +68,11 @@ subroutine discretization_grid_init(restart) print'(/,a)', ' <<<+- discretization_grid init -+>>>'; flush(IO_STDOUT) - if(worldrank == 0) call readVTR(grid,geomSize,origin,materialAt_global) - + if(worldrank == 0) then + call readVTR(grid,geomSize,origin,materialAt_global) + else + allocate(materialAt_global(0)) ! needed for IntelMPI + endif call MPI_Bcast(grid,3,MPI_INTEGER,0,PETSC_COMM_WORLD, ierr) if (ierr /= 0) error stop 'MPI error' diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index 79437945b..8d3f913fa 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -15,10 +15,10 @@ module grid_damage_spectral use IO use spectral_utilities use discretization_grid - use damage_nonlocal use YAML_types + use homogenization use config - + implicit none private @@ -43,13 +43,13 @@ module grid_damage_spectral phi_current, & !< field of current damage phi_lastInc, & !< field of previous damage phi_stagInc !< field of staggered damage - + !-------------------------------------------------------------------------------------------------- -! reference diffusion tensor, mobility etc. +! reference diffusion tensor, mobility etc. integer :: totalIter = 0 !< total iteration in current increment real(pReal), dimension(3,3) :: K_ref real(pReal) :: mu_ref - + public :: & grid_damage_spectral_init, & grid_damage_spectral_solution, & @@ -62,8 +62,8 @@ contains ! ToDo: Restart not implemented !-------------------------------------------------------------------------------------------------- subroutine grid_damage_spectral_init - - PetscInt, dimension(0:worldsize-1) :: localK + + PetscInt, dimension(0:worldsize-1) :: localK DM :: damage_grid Vec :: uBound, lBound PetscErrorCode :: ierr @@ -72,22 +72,22 @@ subroutine grid_damage_spectral_init num_generic character(len=pStringLen) :: & snes_type - + print'(/,a)', ' <<<+- grid_spectral_damage init -+>>>' print*, 'Shanthraj et al., Handbook of Mechanics of Materials, 2019' print*, 'https://doi.org/10.1007/978-981-10-6855-3_80' - + !------------------------------------------------------------------------------------------------- ! read numerical parameters and do sanity checks num_grid => config_numerics%get('grid',defaultVal=emptyDict) num%itmax = num_grid%get_asInt ('itmax',defaultVal=250) num%eps_damage_atol = num_grid%get_asFloat ('eps_damage_atol',defaultVal=1.0e-2_pReal) num%eps_damage_rtol = num_grid%get_asFloat ('eps_damage_rtol',defaultVal=1.0e-6_pReal) - + num_generic => config_numerics%get('generic',defaultVal=emptyDict) num%residualStiffness = num_generic%get_asFloat('residualStiffness', defaultVal=1.0e-6_pReal) - + if (num%residualStiffness < 0.0_pReal) call IO_error(301,ext_msg='residualStiffness') if (num%itmax <= 1) call IO_error(301,ext_msg='itmax') if (num%eps_damage_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_damage_atol') @@ -104,7 +104,7 @@ subroutine grid_damage_spectral_init !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc call SNESCreate(PETSC_COMM_WORLD,damage_snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(damage_snes,'damage_',ierr);CHKERRQ(ierr) + call SNESSetOptionsPrefix(damage_snes,'damage_',ierr);CHKERRQ(ierr) localK = 0 localK(worldrank) = grid3 call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr) @@ -122,7 +122,7 @@ subroutine grid_damage_spectral_init call DMsetUp(damage_grid,ierr); CHKERRQ(ierr) call DMCreateGlobalVector(damage_grid,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,formResidual,PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector - CHKERRQ(ierr) + CHKERRQ(ierr) call SNESSetFromOptions(damage_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional CLI arguments call SNESGetType(damage_snes,snes_type,ierr); CHKERRQ(ierr) if (trim(snes_type) == 'vinewtonrsls' .or. & @@ -137,12 +137,12 @@ subroutine grid_damage_spectral_init endif !-------------------------------------------------------------------------------------------------- -! init fields +! init fields call DMDAGetCorners(damage_grid,xstart,ystart,zstart,xend,yend,zend,ierr) CHKERRQ(ierr) xend = xstart + xend - 1 yend = ystart + yend - 1 - zend = zstart + zend - 1 + zend = zstart + zend - 1 allocate(phi_current(grid(1),grid(2),grid3), source=1.0_pReal) allocate(phi_lastInc(grid(1),grid(2),grid3), source=1.0_pReal) allocate(phi_stagInc(grid(1),grid(2),grid3), source=1.0_pReal) @@ -157,26 +157,26 @@ end subroutine grid_damage_spectral_init !> @brief solution for the spectral damage scheme with internal iterations !-------------------------------------------------------------------------------------------------- function grid_damage_spectral_solution(timeinc) result(solution) - + real(pReal), intent(in) :: & timeinc !< increment in time for current solution - integer :: i, j, k, cell + integer :: i, j, k, ce type(tSolutionState) :: solution PetscInt :: devNull PetscReal :: phi_min, phi_max, stagNorm, solnNorm - + PetscErrorCode :: ierr SNESConvergedReason :: reason solution%converged =.false. - + !-------------------------------------------------------------------------------------------------- -! set module wide availabe data +! set module wide availabe data params%timeinc = timeinc - + call SNESSolve(damage_snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr) - + if (reason < 1) then solution%converged = .false. solution%iterationsNeeded = num%itmax @@ -192,20 +192,20 @@ function grid_damage_spectral_solution(timeinc) result(solution) solution%stagConverged = stagNorm < max(num%eps_damage_atol, num%eps_damage_rtol*solnNorm) !-------------------------------------------------------------------------------------------------- -! updating damage state - cell = 0 +! updating damage state + ce = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) - cell = cell + 1 - call damage_nonlocal_putNonLocalDamage(phi_current(i,j,k),1,cell) + ce = ce + 1 + call damage_nonlocal_putNonLocalDamage(phi_current(i,j,k),ce) enddo; enddo; enddo - + call VecMin(solution_vec,devNull,phi_min,ierr); CHKERRQ(ierr) call VecMax(solution_vec,devNull,phi_max,ierr); CHKERRQ(ierr) if (solution%converged) & print'(/,a)', ' ... nonlocal damage converged .....................................' print'(/,a,f8.6,2x,f8.6,2x,e11.4)', ' Minimum|Maximum|Delta Damage = ', phi_min, phi_max, stagNorm print'(/,a)', ' ===========================================================================' - flush(IO_STDOUT) + flush(IO_STDOUT) end function grid_damage_spectral_solution @@ -214,31 +214,31 @@ end function grid_damage_spectral_solution !> @brief spectral damage forwarding routine !-------------------------------------------------------------------------------------------------- subroutine grid_damage_spectral_forward(cutBack) - + logical, intent(in) :: cutBack - integer :: i, j, k, cell + integer :: i, j, k, ce DM :: dm_local PetscScalar, dimension(:,:,:), pointer :: x_scal PetscErrorCode :: ierr - if (cutBack) then + if (cutBack) then phi_current = phi_lastInc phi_stagInc = phi_lastInc !-------------------------------------------------------------------------------------------------- -! reverting damage field state - cell = 0 +! reverting damage field state + ce = 0 call SNESGetDM(damage_snes,dm_local,ierr); CHKERRQ(ierr) call DMDAVecGetArrayF90(dm_local,solution_vec,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with x_scal(xstart:xend,ystart:yend,zstart:zend) = phi_current call DMDAVecRestoreArrayF90(dm_local,solution_vec,x_scal,ierr); CHKERRQ(ierr) do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) - cell = cell + 1 - call damage_nonlocal_putNonLocalDamage(phi_current(i,j,k),1,cell) + ce = ce + 1 + call damage_nonlocal_putNonLocalDamage(phi_current(i,j,k),ce) enddo; enddo; enddo else phi_lastInc = phi_current call updateReference - endif + endif end subroutine grid_damage_spectral_forward @@ -247,7 +247,7 @@ end subroutine grid_damage_spectral_forward !> @brief forms the spectral damage residual vector !-------------------------------------------------------------------------------------------------- subroutine formResidual(in,x_scal,f_scal,dummy,ierr) - + DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & in PetscScalar, dimension( & @@ -258,31 +258,31 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr) f_scal PetscObject :: dummy PetscErrorCode :: ierr - integer :: i, j, k, cell + integer :: i, j, k, ce real(pReal) :: phiDot, dPhiDot_dPhi, mobility - phi_current = x_scal + phi_current = x_scal !-------------------------------------------------------------------------------------------------- ! evaluate polarization field scalarField_real = 0.0_pReal - scalarField_real(1:grid(1),1:grid(2),1:grid3) = phi_current + scalarField_real(1:grid(1),1:grid(2),1:grid3) = phi_current call utilities_FFTscalarForward call utilities_fourierScalarGradient !< calculate gradient of damage field call utilities_FFTvectorBackward - cell = 0 + ce = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) - cell = cell + 1 - vectorField_real(1:3,i,j,k) = matmul(damage_nonlocal_getDiffusion(1,cell) - K_ref, & + ce = ce + 1 + vectorField_real(1:3,i,j,k) = matmul(damage_nonlocal_getDiffusion(ce) - K_ref, & vectorField_real(1:3,i,j,k)) enddo; enddo; enddo call utilities_FFTvectorForward call utilities_fourierVectorDivergence !< calculate damage divergence in fourier field call utilities_FFTscalarBackward - cell = 0 + ce = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) - cell = cell + 1 - call damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi_current(i,j,k), 1, cell) - mobility = damage_nonlocal_getMobility(1,cell) + ce = ce + 1 + call damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi_current(i,j,k),ce) + mobility = damage_nonlocal_getMobility(ce) scalarField_real(i,j,k) = params%timeinc*(scalarField_real(i,j,k) + phiDot) & + mobility*(phi_lastInc(i,j,k) - phi_current(i,j,k)) & + mu_ref*phi_current(i,j,k) @@ -297,7 +297,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr) scalarField_real(1:grid(1),1:grid(2),1:grid3) = phi_lastInc where(scalarField_real(1:grid(1),1:grid(2),1:grid3) < num%residualStiffness) & scalarField_real(1:grid(1),1:grid(2),1:grid3) = num%residualStiffness - + !-------------------------------------------------------------------------------------------------- ! constructing residual f_scal = scalarField_real(1:grid(1),1:grid(2),1:grid3) - phi_current @@ -310,15 +310,15 @@ end subroutine formResidual !-------------------------------------------------------------------------------------------------- subroutine updateReference - integer :: i,j,k,cell,ierr - - cell = 0 + integer :: i,j,k,ce,ierr + + ce = 0 K_ref = 0.0_pReal mu_ref = 0.0_pReal do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) - cell = cell + 1 - K_ref = K_ref + damage_nonlocal_getDiffusion(1,cell) - mu_ref = mu_ref + damage_nonlocal_getMobility(1,cell) + ce = ce + 1 + K_ref = K_ref + damage_nonlocal_getDiffusion(ce) + mu_ref = mu_ref + damage_nonlocal_getMobility(ce) enddo; enddo; enddo K_ref = K_ref*wgt call MPI_Allreduce(MPI_IN_PLACE,K_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 003f568c6..609561c80 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -4,7 +4,7 @@ !> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH !> @brief Grid solver for mechanics: FEM !-------------------------------------------------------------------------------------------------- -module grid_mech_FEM +module grid_mechanical_FEM #include #include use PETScdmda @@ -45,8 +45,8 @@ module grid_mech_FEM !-------------------------------------------------------------------------------------------------- ! PETSc data - DM :: mech_grid - SNES :: mech_snes + DM :: mechanical_grid + SNES :: mechanical_snes Vec :: solution_current, solution_lastInc, solution_rate !-------------------------------------------------------------------------------------------------- @@ -79,18 +79,18 @@ module grid_mech_FEM totalIter = 0 !< total iteration in current increment public :: & - grid_mech_FEM_init, & - grid_mech_FEM_solution, & - grid_mech_FEM_forward, & - grid_mech_FEM_updateCoords, & - grid_mech_FEM_restartWrite + grid_mechanical_FEM_init, & + grid_mechanical_FEM_solution, & + grid_mechanical_FEM_forward, & + grid_mechanical_FEM_updateCoords, & + grid_mechanical_FEM_restartWrite contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_FEM_init +subroutine grid_mechanical_FEM_init real(pReal), parameter :: HGCoeff = 0.0e-2_pReal real(pReal), parameter, dimension(4,8) :: & @@ -108,13 +108,11 @@ subroutine grid_mech_FEM_init u_current,u_lastInc PetscInt, dimension(0:worldsize-1) :: localK integer(HID_T) :: fileHandle, groupHandle - character(len=pStringLen) :: & - fileName class(tNode), pointer :: & num_grid, & debug_grid - print'(/,a)', ' <<<+- grid_mech_FEM init -+>>>'; flush(IO_STDOUT) + print'(/,a)', ' <<<+- grid_mechanical_FEM init -+>>>'; flush(IO_STDOUT) !------------------------------------------------------------------------------------------------- ! debugging options @@ -141,8 +139,11 @@ subroutine grid_mech_FEM_init !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc - call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mech_snes_type newtonls -mech_ksp_type fgmres & - &-mech_ksp_max_it 25 -mech_pc_type ml -mech_mg_levels_ksp_type chebyshev',ierr) + call PetscOptionsInsertString(PETSC_NULL_OPTIONS, & + '-mechanical_snes_type newtonls -mechanical_ksp_type fgmres & + &-mechanical_ksp_max_it 25 -mechanical_pc_type ml & + &-mechanical_mg_levels_ksp_type chebyshev', & + ierr) CHKERRQ(ierr) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),ierr) CHKERRQ(ierr) @@ -155,8 +156,10 @@ subroutine grid_mech_FEM_init !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc - call SNESCreate(PETSC_COMM_WORLD,mech_snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(mech_snes,'mech_',ierr);CHKERRQ(ierr) + call SNESCreate(PETSC_COMM_WORLD,mechanical_snes,ierr) + CHKERRQ(ierr) + call SNESSetOptionsPrefix(mechanical_snes,'mechanical_',ierr) + CHKERRQ(ierr) localK = 0 localK(worldrank) = grid3 call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr) @@ -167,34 +170,44 @@ subroutine grid_mech_FEM_init 1, 1, worldsize, & 3, 1, & [grid(1)],[grid(2)],localK, & - mech_grid,ierr) + mechanical_grid,ierr) CHKERRQ(ierr) - call SNESSetDM(mech_snes,mech_grid,ierr); CHKERRQ(ierr) - call DMsetFromOptions(mech_grid,ierr); CHKERRQ(ierr) - call DMsetUp(mech_grid,ierr); CHKERRQ(ierr) - call DMDASetUniformCoordinates(mech_grid,0.0_pReal,geomSize(1),0.0_pReal,geomSize(2),0.0_pReal,geomSize(3),ierr) + call SNESSetDM(mechanical_snes,mechanical_grid,ierr) CHKERRQ(ierr) - call DMCreateGlobalVector(mech_grid,solution_current,ierr); CHKERRQ(ierr) - call DMCreateGlobalVector(mech_grid,solution_lastInc,ierr); CHKERRQ(ierr) - call DMCreateGlobalVector(mech_grid,solution_rate ,ierr); CHKERRQ(ierr) - call DMSNESSetFunctionLocal(mech_grid,formResidual,PETSC_NULL_SNES,ierr) + call DMsetFromOptions(mechanical_grid,ierr) CHKERRQ(ierr) - call DMSNESSetJacobianLocal(mech_grid,formJacobian,PETSC_NULL_SNES,ierr) + call DMsetUp(mechanical_grid,ierr) CHKERRQ(ierr) - call SNESSetConvergenceTest(mech_snes,converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged" + call DMDASetUniformCoordinates(mechanical_grid,0.0_pReal,geomSize(1),0.0_pReal,geomSize(2),0.0_pReal,geomSize(3),ierr) + CHKERRQ(ierr) + call DMCreateGlobalVector(mechanical_grid,solution_current,ierr) + CHKERRQ(ierr) + call DMCreateGlobalVector(mechanical_grid,solution_lastInc,ierr) + CHKERRQ(ierr) + call DMCreateGlobalVector(mechanical_grid,solution_rate ,ierr) + CHKERRQ(ierr) + call DMSNESSetFunctionLocal(mechanical_grid,formResidual,PETSC_NULL_SNES,ierr) + CHKERRQ(ierr) + call DMSNESSetJacobianLocal(mechanical_grid,formJacobian,PETSC_NULL_SNES,ierr) + CHKERRQ(ierr) + call SNESSetConvergenceTest(mechanical_snes,converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged" + CHKERRQ(ierr) + call SNESSetMaxLinearSolveFailures(mechanical_snes, huge(1), ierr) ! ignore linear solve failures + CHKERRQ(ierr) + call SNESSetFromOptions(mechanical_snes,ierr) ! pull it all together with additional cli arguments CHKERRQ(ierr) - call SNESSetMaxLinearSolveFailures(mech_snes, huge(1), ierr); CHKERRQ(ierr) ! ignore linear solve failures - call SNESSetFromOptions(mech_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments !-------------------------------------------------------------------------------------------------- ! init fields call VecSet(solution_current,0.0_pReal,ierr);CHKERRQ(ierr) call VecSet(solution_lastInc,0.0_pReal,ierr);CHKERRQ(ierr) call VecSet(solution_rate ,0.0_pReal,ierr);CHKERRQ(ierr) - call DMDAVecGetArrayF90(mech_grid,solution_current,u_current,ierr); CHKERRQ(ierr) - call DMDAVecGetArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr); CHKERRQ(ierr) + call DMDAVecGetArrayF90(mechanical_grid,solution_current,u_current,ierr) + CHKERRQ(ierr) + call DMDAVecGetArrayF90(mechanical_grid,solution_lastInc,u_lastInc,ierr) + CHKERRQ(ierr) - call DMDAGetCorners(mech_grid,xstart,ystart,zstart,xend,yend,zend,ierr) ! local grid extent + call DMDAGetCorners(mechanical_grid,xstart,ystart,zstart,xend,yend,zend,ierr) ! local grid extent CHKERRQ(ierr) xend = xstart+xend-1 yend = ystart+yend-1 @@ -219,8 +232,7 @@ subroutine grid_mech_FEM_init restartRead: if (interface_restartInc > 0) then print'(/,a,i0,a)', ' reading restart data of increment ', interface_restartInc, ' from file' - write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName) + fileHandle = HDF5_openFile(getSolverJobName()//'_restart.hdf5','r') groupHandle = HDF5_openGroup(fileHandle,'solver') call HDF5_read(groupHandle,P_aim, 'P_aim') @@ -242,9 +254,9 @@ subroutine grid_mech_FEM_init call utilities_constitutiveResponse(P_current,P_av,C_volAvg,devNull, & ! stress field, stress avg, global average of stiffness and (min+max)/2 F, & ! target F 0.0_pReal) ! time increment - call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr) + call DMDAVecRestoreArrayF90(mechanical_grid,solution_current,u_current,ierr) CHKERRQ(ierr) - call DMDAVecRestoreArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr) + call DMDAVecRestoreArrayF90(mechanical_grid,solution_lastInc,u_lastInc,ierr) CHKERRQ(ierr) restartRead2: if (interface_restartInc > 0) then @@ -257,13 +269,13 @@ subroutine grid_mech_FEM_init endif restartRead2 -end subroutine grid_mech_FEM_init +end subroutine grid_mechanical_FEM_init !-------------------------------------------------------------------------------------------------- !> @brief solution for the FEM scheme with internal iterations !-------------------------------------------------------------------------------------------------- -function grid_mech_FEM_solution(incInfoIn) result(solution) +function grid_mechanical_FEM_solution(incInfoIn) result(solution) !-------------------------------------------------------------------------------------------------- ! input data for solution @@ -284,11 +296,13 @@ function grid_mech_FEM_solution(incInfoIn) result(solution) !-------------------------------------------------------------------------------------------------- ! solve BVP - call SNESsolve(mech_snes,PETSC_NULL_VEC,solution_current,ierr); CHKERRQ(ierr) + call SNESsolve(mechanical_snes,PETSC_NULL_VEC,solution_current,ierr) + CHKERRQ(ierr) !-------------------------------------------------------------------------------------------------- ! check convergence - call SNESGetConvergedReason(mech_snes,reason,ierr); CHKERRQ(ierr) + call SNESGetConvergedReason(mechanical_snes,reason,ierr) + CHKERRQ(ierr) solution%converged = reason > 0 solution%iterationsNeeded = totalIter @@ -296,14 +310,14 @@ function grid_mech_FEM_solution(incInfoIn) result(solution) terminallyIll = .false. P_aim = merge(P_aim,P_av,params%stress_mask) -end function grid_mech_FEM_solution +end function grid_mechanical_FEM_solution !-------------------------------------------------------------------------------------------------- !> @brief forwarding routine !> @details find new boundary conditions and best F estimate for end of current timestep !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& +subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& deformation_BC,stress_BC,rotation_BC) logical, intent(in) :: & @@ -323,8 +337,10 @@ subroutine grid_mech_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& u_current,u_lastInc - call DMDAVecGetArrayF90(mech_grid,solution_current,u_current,ierr); CHKERRQ(ierr) - call DMDAVecGetArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr); CHKERRQ(ierr) + call DMDAVecGetArrayF90(mechanical_grid,solution_current,u_current,ierr) + CHKERRQ(ierr) + call DMDAVecGetArrayF90(mechanical_grid,solution_lastInc,u_lastInc,ierr) + CHKERRQ(ierr) if (cutBack) then C_volAvg = C_volAvgLastInc @@ -371,8 +387,10 @@ subroutine grid_mech_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& call VecAXPY(solution_current,Delta_t,solution_rate,ierr); CHKERRQ(ierr) - call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr); CHKERRQ(ierr) - call DMDAVecRestoreArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr); CHKERRQ(ierr) + call DMDAVecRestoreArrayF90(mechanical_grid,solution_current,u_current,ierr) + CHKERRQ(ierr) + call DMDAVecRestoreArrayF90(mechanical_grid,solution_lastInc,u_lastInc,ierr) + CHKERRQ(ierr) !-------------------------------------------------------------------------------------------------- ! set module wide available data @@ -380,36 +398,37 @@ subroutine grid_mech_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& params%rotation_BC = rotation_BC params%timeinc = Delta_t -end subroutine grid_mech_FEM_forward +end subroutine grid_mechanical_FEM_forward !-------------------------------------------------------------------------------------------------- !> @brief Update coordinates !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_FEM_updateCoords +subroutine grid_mechanical_FEM_updateCoords call utilities_updateCoords(F) -end subroutine grid_mech_FEM_updateCoords +end subroutine grid_mechanical_FEM_updateCoords !-------------------------------------------------------------------------------------------------- !> @brief Write current solver and constitutive data for restart to file !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_FEM_restartWrite +subroutine grid_mechanical_FEM_restartWrite PetscErrorCode :: ierr integer(HID_T) :: fileHandle, groupHandle PetscScalar, dimension(:,:,:,:), pointer :: u_current,u_lastInc - character(len=pStringLen) :: fileName - call DMDAVecGetArrayF90(mech_grid,solution_current,u_current,ierr); CHKERRQ(ierr) - call DMDAVecGetArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr); CHKERRQ(ierr) + + call DMDAVecGetArrayF90(mechanical_grid,solution_current,u_current,ierr) + CHKERRQ(ierr) + call DMDAVecGetArrayF90(mechanical_grid,solution_lastInc,u_lastInc,ierr) + CHKERRQ(ierr) print*, 'writing solver data required for restart to file'; flush(IO_STDOUT) - write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName,'w') + fileHandle = HDF5_openFile(getSolverJobName()//'_restart.hdf5','w') groupHandle = HDF5_addGroup(fileHandle,'solver') call HDF5_write(groupHandle,P_aim, 'P_aim') @@ -427,10 +446,12 @@ subroutine grid_mech_FEM_restartWrite call HDF5_closeGroup(groupHandle) call HDF5_closeFile(fileHandle) - call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr);CHKERRQ(ierr) - call DMDAVecRestoreArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr);CHKERRQ(ierr) + call DMDAVecRestoreArrayF90(mechanical_grid,solution_current,u_current,ierr) + CHKERRQ(ierr) + call DMDAVecRestoreArrayF90(mechanical_grid,solution_lastInc,u_lastInc,ierr) + CHKERRQ(ierr) -end subroutine grid_mech_FEM_restartWrite +end subroutine grid_mechanical_FEM_restartWrite !-------------------------------------------------------------------------------------------------- @@ -498,8 +519,10 @@ subroutine formResidual(da_local,x_local, & PetscErrorCode :: ierr real(pReal), dimension(3,3,3,3) :: devNull - call SNESGetNumberFunctionEvals(mech_snes,nfuncs,ierr); CHKERRQ(ierr) - call SNESGetIterationNumber(mech_snes,PETScIter,ierr); CHKERRQ(ierr) + call SNESGetNumberFunctionEvals(mechanical_snes,nfuncs,ierr) + CHKERRQ(ierr) + call SNESGetIterationNumber(mechanical_snes,PETScIter,ierr) + CHKERRQ(ierr) if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1 ! new increment @@ -679,4 +702,4 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr) end subroutine formJacobian -end module grid_mech_FEM +end module grid_mechanical_FEM diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index 9bc36165f..faf58c85e 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -4,7 +4,7 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @brief Grid solver for mechanics: Spectral basic !-------------------------------------------------------------------------------------------------- -module grid_mech_spectral_basic +module grid_mechanical_spectral_basic #include #include use PETScdmda @@ -79,18 +79,18 @@ module grid_mech_spectral_basic totalIter = 0 !< total iteration in current increment public :: & - grid_mech_spectral_basic_init, & - grid_mech_spectral_basic_solution, & - grid_mech_spectral_basic_forward, & - grid_mech_spectral_basic_updateCoords, & - grid_mech_spectral_basic_restartWrite + grid_mechanical_spectral_basic_init, & + grid_mechanical_spectral_basic_solution, & + grid_mechanical_spectral_basic_forward, & + grid_mechanical_spectral_basic_updateCoords, & + grid_mechanical_spectral_basic_restartWrite contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_spectral_basic_init +subroutine grid_mechanical_spectral_basic_init real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P PetscErrorCode :: ierr @@ -99,13 +99,11 @@ subroutine grid_mech_spectral_basic_init PetscInt, dimension(0:worldsize-1) :: localK integer(HID_T) :: fileHandle, groupHandle integer :: fileUnit - character(len=pStringLen) :: & - fileName class (tNode), pointer :: & num_grid, & debug_grid - print'(/,a)', ' <<<+- grid_mech_spectral_basic init -+>>>'; flush(IO_STDOUT) + print'(/,a)', ' <<<+- grid_mechanical_spectral_basic init -+>>>'; flush(IO_STDOUT) print*, 'Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013' print*, 'https://doi.org/10.1016/j.ijplas.2012.09.012'//IO_EOL @@ -139,7 +137,7 @@ subroutine grid_mech_spectral_basic_init !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc - call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mech_snes_type ngmres',ierr) + call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',ierr) CHKERRQ(ierr) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),ierr) CHKERRQ(ierr) @@ -152,7 +150,7 @@ subroutine grid_mech_spectral_basic_init !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) + call SNESSetOptionsPrefix(snes,'mechanical_',ierr);CHKERRQ(ierr) localK = 0 localK(worldrank) = grid3 call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr) @@ -182,8 +180,7 @@ subroutine grid_mech_spectral_basic_init restartRead: if (interface_restartInc > 0) then print'(/,a,i0,a)', ' reading restart data of increment ', interface_restartInc, ' from file' - write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName) + fileHandle = HDF5_openFile(getSolverJobName()//'_restart.hdf5','r') groupHandle = HDF5_openGroup(fileHandle,'solver') call HDF5_read(groupHandle,P_aim, 'P_aim') @@ -222,13 +219,13 @@ subroutine grid_mech_spectral_basic_init call utilities_updateGamma(C_minMaxAvg) call utilities_saveReferenceStiffness -end subroutine grid_mech_spectral_basic_init +end subroutine grid_mechanical_spectral_basic_init !-------------------------------------------------------------------------------------------------- !> @brief solution for the basic scheme with internal iterations !-------------------------------------------------------------------------------------------------- -function grid_mech_spectral_basic_solution(incInfoIn) result(solution) +function grid_mechanical_spectral_basic_solution(incInfoIn) result(solution) !-------------------------------------------------------------------------------------------------- ! input data for solution @@ -262,14 +259,14 @@ function grid_mech_spectral_basic_solution(incInfoIn) result(solution) terminallyIll = .false. P_aim = merge(P_aim,P_av,params%stress_mask) -end function grid_mech_spectral_basic_solution +end function grid_mechanical_spectral_basic_solution !-------------------------------------------------------------------------------------------------- !> @brief forwarding routine !> @details find new boundary conditions and best F estimate for end of current timestep !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& +subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& deformation_BC,stress_BC,rotation_BC) logical, intent(in) :: & @@ -339,13 +336,13 @@ subroutine grid_mech_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_old,t_ params%rotation_BC = rotation_BC params%timeinc = Delta_t -end subroutine grid_mech_spectral_basic_forward +end subroutine grid_mechanical_spectral_basic_forward !-------------------------------------------------------------------------------------------------- !> @brief Update coordinates !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_spectral_basic_updateCoords +subroutine grid_mechanical_spectral_basic_updateCoords PetscErrorCode :: ierr PetscScalar, dimension(:,:,:,:), pointer :: F @@ -354,25 +351,23 @@ subroutine grid_mech_spectral_basic_updateCoords call utilities_updateCoords(F) call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) -end subroutine grid_mech_spectral_basic_updateCoords +end subroutine grid_mechanical_spectral_basic_updateCoords !-------------------------------------------------------------------------------------------------- !> @brief Write current solver and constitutive data for restart to file !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_spectral_basic_restartWrite +subroutine grid_mechanical_spectral_basic_restartWrite PetscErrorCode :: ierr integer(HID_T) :: fileHandle, groupHandle PetscScalar, dimension(:,:,:,:), pointer :: F - character(len=pStringLen) :: fileName call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) print*, 'writing solver data required for restart to file'; flush(IO_STDOUT) - write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName,'w') + fileHandle = HDF5_openFile(getSolverJobName()//'_restart.hdf5','w') groupHandle = HDF5_addGroup(fileHandle,'solver') call HDF5_write(groupHandle,P_aim, 'P_aim') @@ -393,7 +388,7 @@ subroutine grid_mech_spectral_basic_restartWrite call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) -end subroutine grid_mech_spectral_basic_restartWrite +end subroutine grid_mechanical_spectral_basic_restartWrite !-------------------------------------------------------------------------------------------------- @@ -506,4 +501,4 @@ subroutine formResidual(in, F, & end subroutine formResidual -end module grid_mech_spectral_basic +end module grid_mechanical_spectral_basic diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 7160c1adc..31f69b4c5 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -4,7 +4,7 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @brief Grid solver for mechanics: Spectral Polarisation !-------------------------------------------------------------------------------------------------- -module grid_mech_spectral_polarisation +module grid_mechanical_spectral_polarisation #include #include use PETScdmda @@ -90,18 +90,18 @@ module grid_mech_spectral_polarisation totalIter = 0 !< total iteration in current increment public :: & - grid_mech_spectral_polarisation_init, & - grid_mech_spectral_polarisation_solution, & - grid_mech_spectral_polarisation_forward, & - grid_mech_spectral_polarisation_updateCoords, & - grid_mech_spectral_polarisation_restartWrite + grid_mechanical_spectral_polarisation_init, & + grid_mechanical_spectral_polarisation_solution, & + grid_mechanical_spectral_polarisation_forward, & + grid_mechanical_spectral_polarisation_updateCoords, & + grid_mechanical_spectral_polarisation_restartWrite contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_spectral_polarisation_init +subroutine grid_mechanical_spectral_polarisation_init real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P PetscErrorCode :: ierr @@ -112,13 +112,11 @@ subroutine grid_mech_spectral_polarisation_init PetscInt, dimension(0:worldsize-1) :: localK integer(HID_T) :: fileHandle, groupHandle integer :: fileUnit - character(len=pStringLen) :: & - fileName class (tNode), pointer :: & num_grid, & debug_grid - print'(/,a)', ' <<<+- grid_mech_spectral_polarisation init -+>>>'; flush(IO_STDOUT) + print'(/,a)', ' <<<+- grid_mechanical_spectral_polarization init -+>>>'; flush(IO_STDOUT) print*, 'Shanthraj et al., International Journal of Plasticity 66:31–45, 2015' print*, 'https://doi.org/10.1016/j.ijplas.2014.02.006' @@ -157,7 +155,7 @@ subroutine grid_mech_spectral_polarisation_init !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc - call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mech_snes_type ngmres',ierr) + call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',ierr) CHKERRQ(ierr) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),ierr) CHKERRQ(ierr) @@ -172,7 +170,7 @@ subroutine grid_mech_spectral_polarisation_init !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) + call SNESSetOptionsPrefix(snes,'mechanical_',ierr);CHKERRQ(ierr) localK = 0 localK(worldrank) = grid3 call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr) @@ -204,8 +202,7 @@ subroutine grid_mech_spectral_polarisation_init restartRead: if (interface_restartInc > 0) then print'(/,a,i0,a)', ' reading restart data of increment ', interface_restartInc, ' from file' - write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName) + fileHandle = HDF5_openFile(getSolverJobName()//'_restart.hdf5','r') groupHandle = HDF5_openGroup(fileHandle,'solver') call HDF5_read(groupHandle,P_aim, 'P_aim') @@ -250,13 +247,13 @@ subroutine grid_mech_spectral_polarisation_init C_scale = C_minMaxAvg S_scale = math_invSym3333(C_minMaxAvg) -end subroutine grid_mech_spectral_polarisation_init +end subroutine grid_mechanical_spectral_polarisation_init !-------------------------------------------------------------------------------------------------- !> @brief solution for the Polarisation scheme with internal iterations !-------------------------------------------------------------------------------------------------- -function grid_mech_spectral_polarisation_solution(incInfoIn) result(solution) +function grid_mechanical_spectral_polarisation_solution(incInfoIn) result(solution) !-------------------------------------------------------------------------------------------------- ! input data for solution @@ -294,14 +291,14 @@ function grid_mech_spectral_polarisation_solution(incInfoIn) result(solution) terminallyIll = .false. P_aim = merge(P_aim,P_av,params%stress_mask) -end function grid_mech_spectral_polarisation_solution +end function grid_mechanical_spectral_polarisation_solution !-------------------------------------------------------------------------------------------------- !> @brief forwarding routine !> @details find new boundary conditions and best F estimate for end of current timestep !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& +subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& deformation_BC,stress_BC,rotation_BC) logical, intent(in) :: & @@ -393,13 +390,13 @@ subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,Delta_t,Delta_t params%rotation_BC = rotation_BC params%timeinc = Delta_t -end subroutine grid_mech_spectral_polarisation_forward +end subroutine grid_mechanical_spectral_polarisation_forward !-------------------------------------------------------------------------------------------------- !> @brief Update coordinates !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_spectral_polarisation_updateCoords +subroutine grid_mechanical_spectral_polarisation_updateCoords PetscErrorCode :: ierr PetscScalar, dimension(:,:,:,:), pointer :: FandF_tau @@ -408,18 +405,17 @@ subroutine grid_mech_spectral_polarisation_updateCoords call utilities_updateCoords(FandF_tau(0:8,:,:,:)) call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr) -end subroutine grid_mech_spectral_polarisation_updateCoords +end subroutine grid_mechanical_spectral_polarisation_updateCoords !-------------------------------------------------------------------------------------------------- !> @brief Write current solver and constitutive data for restart to file !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_spectral_polarisation_restartWrite +subroutine grid_mechanical_spectral_polarisation_restartWrite PetscErrorCode :: ierr integer(HID_T) :: fileHandle, groupHandle PetscScalar, dimension(:,:,:,:), pointer :: FandF_tau, F, F_tau - character(len=pStringLen) :: fileName call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr) F => FandF_tau(0: 8,:,:,:) @@ -427,8 +423,7 @@ subroutine grid_mech_spectral_polarisation_restartWrite print*, 'writing solver data required for restart to file'; flush(IO_STDOUT) - write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName,'w') + fileHandle = HDF5_openFile(getSolverJobName()//'_restart.hdf5','w') groupHandle = HDF5_addGroup(fileHandle,'solver') call HDF5_write(groupHandle,F_aim, 'P_aim') @@ -450,7 +445,7 @@ subroutine grid_mech_spectral_polarisation_restartWrite call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr) -end subroutine grid_mech_spectral_polarisation_restartWrite +end subroutine grid_mechanical_spectral_polarisation_restartWrite !-------------------------------------------------------------------------------------------------- @@ -618,4 +613,4 @@ subroutine formResidual(in, FandF_tau, & end subroutine formResidual -end module grid_mech_spectral_polarisation +end module grid_mechanical_spectral_polarisation diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 259b45f33..5ac043a67 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -15,11 +15,11 @@ module grid_thermal_spectral use IO use spectral_utilities use discretization_grid - use thermal_conduction + use homogenization use YAML_types use config use material - + implicit none private @@ -45,11 +45,11 @@ module grid_thermal_spectral T_stagInc !< field of staggered temperature !-------------------------------------------------------------------------------------------------- -! reference diffusion tensor, mobility etc. +! reference diffusion tensor, mobility etc. integer :: totalIter = 0 !< total iteration in current increment real(pReal), dimension(3,3) :: K_ref real(pReal) :: mu_ref - + public :: & grid_thermal_spectral_init, & grid_thermal_spectral_solution, & @@ -61,10 +61,12 @@ contains !> @brief allocates all neccessary fields and fills them with data ! ToDo: Restart not implemented !-------------------------------------------------------------------------------------------------- -subroutine grid_thermal_spectral_init +subroutine grid_thermal_spectral_init(T_0) - PetscInt, dimension(0:worldsize-1) :: localK - integer :: i, j, k, cell + real(pReal), intent(in) :: T_0 + + PetscInt, dimension(0:worldsize-1) :: localK + integer :: i, j, k, ce DM :: thermal_grid PetscScalar, dimension(:,:,:), pointer :: x_scal PetscErrorCode :: ierr @@ -93,11 +95,11 @@ subroutine grid_thermal_spectral_init CHKERRQ(ierr) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),ierr) CHKERRQ(ierr) - + !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc call SNESCreate(PETSC_COMM_WORLD,thermal_snes,ierr); CHKERRQ(ierr) - call SNESSetOptionsPrefix(thermal_snes,'thermal_',ierr);CHKERRQ(ierr) + call SNESSetOptionsPrefix(thermal_snes,'thermal_',ierr);CHKERRQ(ierr) localK = 0 localK(worldrank) = grid3 call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr) @@ -115,25 +117,26 @@ subroutine grid_thermal_spectral_init call DMsetUp(thermal_grid,ierr); CHKERRQ(ierr) call DMCreateGlobalVector(thermal_grid,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,formResidual,PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector - CHKERRQ(ierr) + CHKERRQ(ierr) call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional CLI arguments !-------------------------------------------------------------------------------------------------- -! init fields +! init fields call DMDAGetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr) CHKERRQ(ierr) xend = xstart + xend - 1 yend = ystart + yend - 1 - zend = zstart + zend - 1 + zend = zstart + zend - 1 allocate(T_current(grid(1),grid(2),grid3), source=0.0_pReal) allocate(T_lastInc(grid(1),grid(2),grid3), source=0.0_pReal) allocate(T_stagInc(grid(1),grid(2),grid3), source=0.0_pReal) - cell = 0 + ce = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) - cell = cell + 1 - T_current(i,j,k) = temperature(material_homogenizationAt(cell))%p(material_homogenizationMemberAt(1,cell)) + ce = ce + 1 + T_current(i,j,k) = T_0 T_lastInc(i,j,k) = T_current(i,j,k) T_stagInc(i,j,k) = T_current(i,j,k) + call homogenization_thermal_setField(T_0,0.0_pReal,ce) enddo; enddo; enddo call DMDAVecGetArrayF90(thermal_grid,solution_vec,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with x_scal(xstart:xend,ystart:yend,zstart:zend) = T_current @@ -143,26 +146,26 @@ subroutine grid_thermal_spectral_init end subroutine grid_thermal_spectral_init - + !-------------------------------------------------------------------------------------------------- !> @brief solution for the spectral thermal scheme with internal iterations !-------------------------------------------------------------------------------------------------- function grid_thermal_spectral_solution(timeinc) result(solution) - + real(pReal), intent(in) :: & timeinc !< increment in time for current solution - integer :: i, j, k, cell + integer :: i, j, k, ce type(tSolutionState) :: solution PetscInt :: devNull PetscReal :: T_min, T_max, stagNorm, solnNorm - PetscErrorCode :: ierr + PetscErrorCode :: ierr SNESConvergedReason :: reason solution%converged =.false. - + !-------------------------------------------------------------------------------------------------- -! set module wide availabe data +! set module wide availabe data params%timeinc = timeinc call SNESSolve(thermal_snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) @@ -183,13 +186,13 @@ function grid_thermal_spectral_solution(timeinc) result(solution) solution%stagConverged = stagNorm < max(num%eps_thermal_atol, num%eps_thermal_rtol*solnNorm) !-------------------------------------------------------------------------------------------------- -! updating thermal state - cell = 0 +! updating thermal state + ce = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) - cell = cell + 1 - call thermal_conduction_putTemperatureAndItsRate(T_current(i,j,k), & + ce = ce + 1 + call homogenization_thermal_setField(T_current(i,j,k), & (T_current(i,j,k)-T_lastInc(i,j,k))/params%timeinc, & - 1,cell) + ce) enddo; enddo; enddo call VecMin(solution_vec,devNull,T_min,ierr); CHKERRQ(ierr) @@ -198,7 +201,7 @@ function grid_thermal_spectral_solution(timeinc) result(solution) print'(/,a)', ' ... thermal conduction converged ..................................' print'(/,a,f8.4,2x,f8.4,2x,f8.4)', ' Minimum|Maximum|Delta Temperature / K = ', T_min, T_max, stagNorm print'(/,a)', ' ===========================================================================' - flush(IO_STDOUT) + flush(IO_STDOUT) end function grid_thermal_spectral_solution @@ -207,36 +210,35 @@ end function grid_thermal_spectral_solution !> @brief forwarding routine !-------------------------------------------------------------------------------------------------- subroutine grid_thermal_spectral_forward(cutBack) - + logical, intent(in) :: cutBack - integer :: i, j, k, cell + integer :: i, j, k, ce DM :: dm_local PetscScalar, dimension(:,:,:), pointer :: x_scal PetscErrorCode :: ierr - - if (cutBack) then + + if (cutBack) then T_current = T_lastInc T_stagInc = T_lastInc !-------------------------------------------------------------------------------------------------- -! reverting thermal field state - cell = 0 +! reverting thermal field state + ce = 0 call SNESGetDM(thermal_snes,dm_local,ierr); CHKERRQ(ierr) call DMDAVecGetArrayF90(dm_local,solution_vec,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with x_scal(xstart:xend,ystart:yend,zstart:zend) = T_current call DMDAVecRestoreArrayF90(dm_local,solution_vec,x_scal,ierr); CHKERRQ(ierr) do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) - cell = cell + 1 - call thermal_conduction_putTemperatureAndItsRate(T_current(i,j,k), & - (T_current(i,j,k) - & - T_lastInc(i,j,k))/params%timeinc, & - 1,cell) + ce = ce + 1 + call homogenization_thermal_setField(T_current(i,j,k), & + (T_current(i,j,k)-T_lastInc(i,j,k))/params%timeinc, & + ce) enddo; enddo; enddo else T_lastInc = T_current call updateReference endif - + end subroutine grid_thermal_spectral_forward @@ -244,7 +246,7 @@ end subroutine grid_thermal_spectral_forward !> @brief forms the spectral thermal residual vector !-------------------------------------------------------------------------------------------------- subroutine formResidual(in,x_scal,f_scal,dummy,ierr) - + DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & in PetscScalar, dimension( & @@ -255,33 +257,33 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr) f_scal PetscObject :: dummy PetscErrorCode :: ierr - integer :: i, j, k, cell - real(pReal) :: Tdot, dTdot_dT + integer :: i, j, k, ce + real(pReal) :: Tdot - T_current = x_scal + T_current = x_scal !-------------------------------------------------------------------------------------------------- ! evaluate polarization field scalarField_real = 0.0_pReal - scalarField_real(1:grid(1),1:grid(2),1:grid3) = T_current + scalarField_real(1:grid(1),1:grid(2),1:grid3) = T_current call utilities_FFTscalarForward call utilities_fourierScalarGradient !< calculate gradient of temperature field call utilities_FFTvectorBackward - cell = 0 + ce = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) - cell = cell + 1 - vectorField_real(1:3,i,j,k) = matmul(thermal_conduction_getConductivity(1,cell) - K_ref, & + ce = ce + 1 + vectorField_real(1:3,i,j,k) = matmul(thermal_conduction_getConductivity(ce) - K_ref, & vectorField_real(1:3,i,j,k)) enddo; enddo; enddo call utilities_FFTvectorForward call utilities_fourierVectorDivergence !< calculate temperature divergence in fourier field call utilities_FFTscalarBackward - cell = 0 + ce = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) - cell = cell + 1 - call thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T_current(i,j,k), 1, cell) + ce = ce + 1 + call thermal_conduction_getSource(Tdot,1,ce) scalarField_real(i,j,k) = params%timeinc*(scalarField_real(i,j,k) + Tdot) & - + thermal_conduction_getMassDensity (1,cell)* & - thermal_conduction_getSpecificHeat(1,cell)*(T_lastInc(i,j,k) - & + + thermal_conduction_getMassDensity (ce)* & + thermal_conduction_getSpecificHeat(ce)*(T_lastInc(i,j,k) - & T_current(i,j,k))& + mu_ref*T_current(i,j,k) enddo; enddo; enddo @@ -291,7 +293,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr) call utilities_FFTscalarForward call utilities_fourierGreenConvolution(K_ref, mu_ref, params%timeinc) call utilities_FFTscalarBackward - + !-------------------------------------------------------------------------------------------------- ! constructing residual f_scal = T_current - scalarField_real(1:grid(1),1:grid(2),1:grid3) @@ -304,15 +306,15 @@ end subroutine formResidual !-------------------------------------------------------------------------------------------------- subroutine updateReference - integer :: i,j,k,cell,ierr - - cell = 0 + integer :: i,j,k,ce,ierr + + ce = 0 K_ref = 0.0_pReal mu_ref = 0.0_pReal do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) - cell = cell + 1 - K_ref = K_ref + thermal_conduction_getConductivity(1,cell) - mu_ref = mu_ref + thermal_conduction_getMassDensity(1,cell)* thermal_conduction_getSpecificHeat(1,cell) + ce = ce + 1 + K_ref = K_ref + thermal_conduction_getConductivity(ce) + mu_ref = mu_ref + thermal_conduction_getMassDensity(ce)* thermal_conduction_getSpecificHeat(ce) enddo; enddo; enddo K_ref = K_ref*wgt call MPI_Allreduce(MPI_IN_PLACE,K_ref,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 52553b57b..90654ee99 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -10,17 +10,47 @@ module homogenization use config use math use material - use constitutive + use phase use discretization - use thermal_isothermal - use thermal_conduction - use damage_none - use damage_nonlocal + use HDF5_utilities use results + use lattice implicit none private + + enum, bind(c); enumerator :: & + THERMAL_ISOTHERMAL_ID, & + THERMAL_CONDUCTION_ID, & + DAMAGE_NONE_ID, & + DAMAGE_NONLOCAL_ID, & + HOMOGENIZATION_UNDEFINED_ID, & + HOMOGENIZATION_NONE_ID, & + HOMOGENIZATION_ISOSTRAIN_ID, & + HOMOGENIZATION_RGC_ID + end enum + + type(tState), allocatable, dimension(:), public :: & + homogState, & + damageState_h + + integer(kind(THERMAL_isothermal_ID)), dimension(:), allocatable :: & + thermal_type !< thermal transport model + integer(kind(DAMAGE_none_ID)), dimension(:), allocatable :: & + damage_type !< nonlocal damage model + integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable :: & + homogenization_type !< type of each homogenization + + type, private :: tNumerics_damage + real(pReal) :: & + charLength !< characteristic length scale for gradient problems + end type tNumerics_damage + + type(tNumerics_damage), private :: & + num_damage + + logical, public :: & terminallyIll = .false. !< at least one material point is terminally ill @@ -39,10 +69,6 @@ module homogenization type :: tNumerics integer :: & nMPstate !< materialpoint state loop limit - real(pReal) :: & - subStepMinHomog, & !< minimum (relative) size of sub-step allowed during cutback in homogenization - subStepSizeHomog, & !< size of first substep when cutback in homogenization - stepIncreaseHomog !< increase of next substep size when previous substep converged in homogenization end type tNumerics type(tNumerics) :: num @@ -50,48 +76,143 @@ module homogenization !-------------------------------------------------------------------------------------------------- interface - module subroutine mech_init(num_homog) + module subroutine mechanical_init(num_homog) class(tNode), pointer, intent(in) :: & num_homog !< pointer to mechanical homogenization numerics data - end subroutine mech_init + end subroutine mechanical_init - module subroutine mech_partition(subF,ip,el) + module subroutine thermal_init + end subroutine thermal_init + + module subroutine damage_init + end subroutine damage_init + + module subroutine mechanical_partition(subF,ce) real(pReal), intent(in), dimension(3,3) :: & subF integer, intent(in) :: & - ip, & !< integration point - el !< element number - end subroutine mech_partition + ce + end subroutine mechanical_partition - module subroutine mech_homogenize(ip,el) + module subroutine thermal_partition(ce) + integer, intent(in) :: ce + end subroutine thermal_partition + + module subroutine damage_partition(ce) + integer, intent(in) :: ce + end subroutine damage_partition + + module subroutine thermal_homogenize(ip,el) + integer, intent(in) :: ip,el + end subroutine thermal_homogenize + + module subroutine mechanical_homogenize(dt,ce) + real(pReal), intent(in) :: dt integer, intent(in) :: & - ip, & !< integration point - el !< element number - end subroutine mech_homogenize + ce !< cell + end subroutine mechanical_homogenize - module subroutine mech_results(group_base,h) + module subroutine mechanical_results(group_base,ho) character(len=*), intent(in) :: group_base - integer, intent(in) :: h - end subroutine mech_results + integer, intent(in) :: ho + end subroutine mechanical_results - module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) + module function mechanical_updateState(subdt,subF,ce) result(doneAndHappy) real(pReal), intent(in) :: & - subdt !< current time step + subdt !< current time step real(pReal), intent(in), dimension(3,3) :: & subF integer, intent(in) :: & - ip, & !< integration point - el !< element number + ce !< cell logical, dimension(2) :: doneAndHappy - end function mech_updateState + end function mechanical_updateState + + + module function thermal_conduction_getConductivity(ce) result(K) + integer, intent(in) :: ce + real(pReal), dimension(3,3) :: K + end function thermal_conduction_getConductivity + + module function thermal_conduction_getSpecificHeat(ce) result(c_P) + integer, intent(in) :: ce + real(pReal) :: c_P + end function thermal_conduction_getSpecificHeat + + module function thermal_conduction_getMassDensity(ce) result(rho) + integer, intent(in) :: ce + real(pReal) :: rho + end function thermal_conduction_getMassDensity + + module subroutine homogenization_thermal_setField(T,dot_T, ce) + integer, intent(in) :: ce + real(pReal), intent(in) :: T, dot_T + end subroutine homogenization_thermal_setField + + module subroutine thermal_conduction_results(ho,group) + integer, intent(in) :: ho + character(len=*), intent(in) :: group + end subroutine thermal_conduction_results + + module function homogenization_thermal_T(ce) result(T) + integer, intent(in) :: ce + real(pReal) :: T + end function homogenization_thermal_T + + module subroutine thermal_conduction_getSource(Tdot, ip, el) + integer, intent(in) :: & + ip, & + el + real(pReal), intent(out) :: Tdot + end subroutine thermal_conduction_getSource + + module function damage_nonlocal_getMobility(ce) result(M) + integer, intent(in) :: ce + real(pReal) :: M + end function damage_nonlocal_getMobility + + module subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ce) + integer, intent(in) :: ce + real(pReal), intent(in) :: & + phi + real(pReal) :: & + phiDot, dPhiDot_dPhi + end subroutine damage_nonlocal_getSourceAndItsTangent + + module subroutine damage_nonlocal_putNonLocalDamage(phi,ce) + integer, intent(in) :: ce + real(pReal), intent(in) :: & + phi + end subroutine damage_nonlocal_putNonLocalDamage + + module subroutine damage_nonlocal_results(ho,group) + integer, intent(in) :: ho + character(len=*), intent(in) :: group + end subroutine damage_nonlocal_results end interface public :: & homogenization_init, & materialpoint_stressAndItsTangent, & + thermal_conduction_getSpecificHeat, & + thermal_conduction_getConductivity, & + thermal_conduction_getMassDensity, & + thermal_conduction_getSource, & + damage_nonlocal_getMobility, & + damage_nonlocal_getSourceAndItsTangent, & + damage_nonlocal_putNonLocalDamage, & + homogenization_thermal_setfield, & + homogenization_thermal_T, & homogenization_forward, & - homogenization_results + homogenization_results, & + homogenization_restartRead, & + homogenization_restartWrite, & + THERMAL_CONDUCTION_ID, & + DAMAGE_NONLOCAL_ID + + public :: & + damage_nonlocal_init, & + damage_nonlocal_getDiffusion contains @@ -99,7 +220,7 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief module initialization !-------------------------------------------------------------------------------------------------- -subroutine homogenization_init +subroutine homogenization_init() class (tNode) , pointer :: & num_homog, & @@ -107,27 +228,21 @@ subroutine homogenization_init print'(/,a)', ' <<<+- homogenization init -+>>>'; flush(IO_STDOUT) + + allocate(homogState (size(material_name_homogenization))) + allocate(damageState_h (size(material_name_homogenization))) + call material_parseHomogenization() + num_homog => config_numerics%get('homogenization',defaultVal=emptyDict) num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict) - num%nMPstate = num_homogGeneric%get_asInt ('nMPstate', defaultVal=10) - num%subStepMinHomog = num_homogGeneric%get_asFloat('subStepMin', defaultVal=1.0e-3_pReal) - num%subStepSizeHomog = num_homogGeneric%get_asFloat('subStepSize', defaultVal=0.25_pReal) - num%stepIncreaseHomog = num_homogGeneric%get_asFloat('stepIncrease', defaultVal=1.5_pReal) + num%nMPstate = num_homogGeneric%get_asInt('nMPstate',defaultVal=10) + if (num%nMPstate < 1) call IO_error(301,ext_msg='nMPstate') - if (num%nMPstate < 1) call IO_error(301,ext_msg='nMPstate') - if (num%subStepMinHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinHomog') - if (num%subStepSizeHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeHomog') - if (num%stepIncreaseHomog <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseHomog') - - - call mech_init(num_homog) - - if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init - if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init - - if (any(damage_type == DAMAGE_none_ID)) call damage_none_init - if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init + call mechanical_init(num_homog) + call thermal_init() + call damage_init() + call damage_nonlocal_init() end subroutine homogenization_init @@ -144,126 +259,96 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE NiterationMPstate, & ip, & !< integration point number el, & !< element number - myNgrains, co, ce, ho, me - real(pReal) :: & - subFrac, & - subStep + myNgrains, co, ce, ho, me, ph logical :: & converged logical, dimension(2) :: & doneAndHappy - - !$OMP PARALLEL DO PRIVATE(ce,me,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) + !$OMP PARALLEL + !$OMP DO PRIVATE(ce,me,ho,myNgrains,NiterationMPstate,converged,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) ho = material_homogenizationAt(el) myNgrains = homogenization_Nconstituents(ho) do ip = FEsolving_execIP(1),FEsolving_execIP(2) - me = material_homogenizationMemberAt(ip,el) -!-------------------------------------------------------------------------------------------------- -! initialize restoration points - call constitutive_initializeRestorationPoints(ip,el) + ce = (el-1)*discretization_nIPs + ip + me = material_homogenizationMemberAt2(ce) - subFrac = 0.0_pReal - converged = .false. ! pretend failed step ... - subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation + call phase_restore(ce,.false.) ! wrong name (is more a forward function) - if (homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,me) = homogState(ho)%State0(:,me) - if (damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,me) = damageState(ho)%State0(:,me) + if(homogState(ho)%sizeState > 0) homogState(ho)%State(:,me) = homogState(ho)%State0(:,me) + if(damageState_h(ho)%sizeState > 0) damageState_h(ho)%State(:,me) = damageState_h(ho)%State0(:,me) + call damage_partition(ce) - cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) + doneAndHappy = [.false.,.true.] - if (converged) then - subFrac = subFrac + subStep - subStep = min(1.0_pReal-subFrac,num%stepIncreaseHomog*subStep) ! introduce flexibility for step increase/acceleration + NiterationMPstate = 0 + convergenceLooping: do while (.not. (terminallyIll .or. doneAndHappy(1)) & + .and. NiterationMPstate < num%nMPstate) + NiterationMPstate = NiterationMPstate + 1 - steppingNeeded: if (subStep > num%subStepMinHomog) then - ! wind forward grain starting point - call constitutive_windForward(ip,el) + if (.not. doneAndHappy(1)) then + call mechanical_partition(homogenization_F(1:3,1:3,ce),ce) + converged = .true. + do co = 1, myNgrains + converged = converged .and. crystallite_stress(dt,co,ip,el) + enddo - if(homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,me) = homogState(ho)%State(:,me) - if(damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,me) = damageState(ho)%State(:,me) - - endif steppingNeeded - elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite - num%subStepSizeHomog * subStep <= num%subStepMinHomog ) then ! would require too small subStep - ! cutback makes no sense - if (.not. terminallyIll) & ! so first signals terminally ill... - print*, ' Integration point ', ip,' at element ', el, ' terminally ill' - terminallyIll = .true. ! ...and kills all others - else ! cutback makes sense - subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback - - call constitutive_restore(ip,el,subStep < 1.0_pReal) - - if(homogState(ho)%sizeState > 0) & - homogState(ho)%State(:,me) = homogState(ho)%subState0(:,me) - if(damageState(ho)%sizeState > 0) & - damageState(ho)%State(:,me) = damageState(ho)%subState0(:,me) + if (.not. converged) then + doneAndHappy = [.true.,.false.] + else + doneAndHappy = mechanical_updateState(dt,homogenization_F(1:3,1:3,ce),ce) + converged = all(doneAndHappy) + endif endif - if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] - - NiterationMPstate = 0 - convergenceLooping: do while (.not. terminallyIll & - .and. .not. doneAndHappy(1) & - .and. NiterationMPstate < num%nMPstate) - NiterationMPstate = NiterationMPstate + 1 - -!-------------------------------------------------------------------------------------------------- -! deformation partitioning - - if (.not. doneAndHappy(1)) then - ce = (el-1)*discretization_nIPs + ip - call mech_partition(homogenization_F0(1:3,1:3,ce) & - + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))& - *(subStep+subFrac), & - ip,el) - converged = .true. - do co = 1, myNgrains - converged = converged .and. crystallite_stress(dt*subStep,co,ip,el) - enddo - - if (.not. converged) then - doneAndHappy = [.true.,.false.] - else - ce = (el-1)*discretization_nIPs + ip - doneAndHappy = mech_updateState(dt*subStep, & - homogenization_F0(1:3,1:3,ce) & - + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce)) & - *(subStep+subFrac), & - ip,el) - converged = all(doneAndHappy) - endif - endif - - enddo convergenceLooping - enddo cutBackLooping + enddo convergenceLooping + if (.not. converged) then + if (.not. terminallyIll) print*, ' Integration point ', ip,' at element ', el, ' terminally ill' + terminallyIll = .true. + endif enddo enddo - !$OMP END PARALLEL DO + !$OMP END DO - if (.not. terminallyIll ) then - !$OMP PARALLEL DO PRIVATE(ho,myNgrains) + if (.not. terminallyIll) then + !$OMP DO PRIVATE(ho,ph,ce) + do el = FEsolving_execElem(1),FEsolving_execElem(2) + if (terminallyIll) continue + ho = material_homogenizationAt(el) + do ip = FEsolving_execIP(1),FEsolving_execIP(2) + ce = (el-1)*discretization_nIPs + ip + call thermal_partition(ce) + do co = 1, homogenization_Nconstituents(ho) + ph = material_phaseAt(co,el) + if (.not. thermal_stress(dt,ph,material_phaseMemberAt(co,ip,el))) then + if (.not. terminallyIll) & ! so first signals terminally ill... + print*, ' Integration point ', ip,' at element ', el, ' terminally ill' + terminallyIll = .true. ! ...and kills all others + endif + enddo + call thermal_homogenize(ip,el) + enddo + enddo + !$OMP END DO + + !$OMP DO PRIVATE(ho,ce) elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) ho = material_homogenizationAt(el) - myNgrains = homogenization_Nconstituents(ho) IpLooping3: do ip = FEsolving_execIP(1),FEsolving_execIP(2) - do co = 1, myNgrains + ce = (el-1)*discretization_nIPs + ip + do co = 1, homogenization_Nconstituents(ho) call crystallite_orientations(co,ip,el) enddo - call mech_homogenize(ip,el) + call mechanical_homogenize(dt,ce) enddo IpLooping3 enddo elementLooping3 - !$OMP END PARALLEL DO + !$OMP END DO else print'(/,a,/)', ' << HOMOG >> Material Point terminally ill' endif + !$OMP END PARALLEL end subroutine materialpoint_stressAndItsTangent @@ -283,7 +368,7 @@ subroutine homogenization_results group_base = 'current/homogenization/'//trim(material_name_homogenization(ho)) call results_closeGroup(results_addGroup(group_base)) - call mech_results(group_base,ho) + call mechanical_results(group_base,ho) group = trim(group_base)//'/damage' call results_closeGroup(results_addGroup(group)) @@ -315,9 +400,185 @@ subroutine homogenization_forward do ho = 1, size(material_name_homogenization) homogState (ho)%state0 = homogState (ho)%state - damageState(ho)%state0 = damageState(ho)%state + if(damageState_h(ho)%sizeState > 0) & + damageState_h(ho)%state0 = damageState_h(ho)%state enddo end subroutine homogenization_forward + +!-------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_restartWrite(fileHandle) + + integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle + integer :: ho + + + groupHandle(1) = HDF5_addGroup(fileHandle,'homogenization') + + do ho = 1, size(material_name_homogenization) + + groupHandle(2) = HDF5_addGroup(groupHandle(1),material_name_homogenization(ho)) + + call HDF5_write(groupHandle(2),homogState(ho)%state,'omega') ! ToDo: should be done by mech + + call HDF5_closeGroup(groupHandle(2)) + + enddo + + call HDF5_closeGroup(groupHandle(1)) + +end subroutine homogenization_restartWrite + + +!-------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_restartRead(fileHandle) + + integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle + integer :: ho + + + groupHandle(1) = HDF5_openGroup(fileHandle,'homogenization') + + do ho = 1, size(material_name_homogenization) + + groupHandle(2) = HDF5_openGroup(groupHandle(1),material_name_homogenization(ho)) + + call HDF5_read(groupHandle(2),homogState(ho)%state,'omega') ! ToDo: should be done by mech + + call HDF5_closeGroup(groupHandle(2)) + + enddo + + call HDF5_closeGroup(groupHandle(1)) + +end subroutine homogenization_restartRead + + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine damage_nonlocal_init + + integer :: Ninstances,Nmaterialpoints,h + class(tNode), pointer :: & + num_generic, & + material_homogenization + + print'(/,a)', ' <<<+- damage_nonlocal init -+>>>'; flush(6) + +!------------------------------------------------------------------------------------ +! read numerics parameter + num_generic => config_numerics%get('generic',defaultVal= emptyDict) + num_damage%charLength = num_generic%get_asFloat('charLength',defaultVal=1.0_pReal) + + Ninstances = count(damage_type == DAMAGE_nonlocal_ID) + + material_homogenization => config_material%get('homogenization') + do h = 1, material_homogenization%length + if (damage_type(h) /= DAMAGE_NONLOCAL_ID) cycle + + Nmaterialpoints = count(material_homogenizationAt == h) + damageState_h(h)%sizeState = 1 + allocate(damageState_h(h)%state0 (1,Nmaterialpoints), source=1.0_pReal) + allocate(damageState_h(h)%state (1,Nmaterialpoints), source=1.0_pReal) + + enddo + +end subroutine damage_nonlocal_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized non local damage diffusion tensor in reference configuration +!-------------------------------------------------------------------------------------------------- +function damage_nonlocal_getDiffusion(ce) + + integer, intent(in) :: ce + real(pReal), dimension(3,3) :: & + damage_nonlocal_getDiffusion + integer :: & + ho, & + co + + ho = material_homogenizationAt2(ce) + damage_nonlocal_getDiffusion = 0.0_pReal + + do co = 1, homogenization_Nconstituents(ho) + damage_nonlocal_getDiffusion = damage_nonlocal_getDiffusion + & + crystallite_push33ToRef(co,ce,lattice_D(1:3,1:3,material_phaseAt2(co,ce))) + enddo + + damage_nonlocal_getDiffusion = & + num_damage%charLength**2*damage_nonlocal_getDiffusion/real(homogenization_Nconstituents(ho),pReal) + +end function damage_nonlocal_getDiffusion + + +!-------------------------------------------------------------------------------------------------- +!> @brief parses the homogenization part from the material configuration +! ToDo: This should be done in homogenization +!-------------------------------------------------------------------------------------------------- +subroutine material_parseHomogenization + + class(tNode), pointer :: & + material_homogenization, & + homog, & + homogMech, & + homogThermal, & + homogDamage + + integer :: h + + material_homogenization => config_material%get('homogenization') + + allocate(homogenization_type(size(material_name_homogenization)), source=HOMOGENIZATION_undefined_ID) + allocate(thermal_type(size(material_name_homogenization)), source=THERMAL_isothermal_ID) + allocate(damage_type (size(material_name_homogenization)), source=DAMAGE_none_ID) + + do h=1, size(material_name_homogenization) + homog => material_homogenization%get(h) + homogMech => homog%get('mechanics') + select case (homogMech%get_asString('type')) + case('pass') + homogenization_type(h) = HOMOGENIZATION_NONE_ID + case('isostrain') + homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID + case('RGC') + homogenization_type(h) = HOMOGENIZATION_RGC_ID + case default + call IO_error(500,ext_msg=homogMech%get_asString('type')) + end select + + if (homog%contains('thermal')) then + homogThermal => homog%get('thermal') + select case (homogThermal%get_asString('type')) + case('pass') + thermal_type(h) = THERMAL_conduction_ID + case default + call IO_error(500,ext_msg=homogThermal%get_asString('type')) + end select + endif + + if (homog%contains('damage')) then + homogDamage => homog%get('damage') + select case (homogDamage%get_asString('type')) + case('pass') + damage_type(h) = DAMAGE_nonlocal_ID + case default + call IO_error(500,ext_msg=homogDamage%get_asString('type')) + end select + endif + enddo + +end subroutine material_parseHomogenization + + end module homogenization diff --git a/src/homogenization_damage.f90 b/src/homogenization_damage.f90 new file mode 100644 index 000000000..993ea84f6 --- /dev/null +++ b/src/homogenization_damage.f90 @@ -0,0 +1,168 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, KU Leuven +!-------------------------------------------------------------------------------------------------- +submodule(homogenization) homogenization_damage + + use lattice + + type :: tDataContainer + real(pReal), dimension(:), allocatable :: phi + end type tDataContainer + + type(tDataContainer), dimension(:), allocatable :: current + + type :: tParameters + character(len=pStringLen), allocatable, dimension(:) :: & + output + end type tParameters + + type(tparameters), dimension(:), allocatable :: & + param + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief Allocate variables and set parameters. +!-------------------------------------------------------------------------------------------------- +module subroutine damage_init() + + class(tNode), pointer :: & + configHomogenizations, & + configHomogenization, & + configHomogenizationDamage + integer :: ho + + + print'(/,a)', ' <<<+- homogenization:damage init -+>>>' + print'(/,a)', ' <<<+- homogenization:damage:isodamage init -+>>>' + + configHomogenizations => config_material%get('homogenization') + allocate(param(configHomogenizations%length)) + allocate(current(configHomogenizations%length)) + + do ho = 1, configHomogenizations%length + allocate(current(ho)%phi(count(material_homogenizationAt2==ho)), source=1.0_pReal) + configHomogenization => configHomogenizations%get(ho) + associate(prm => param(ho)) + if (configHomogenization%contains('damage')) then + configHomogenizationDamage => configHomogenization%get('damage') +#if defined (__GFORTRAN__) + prm%output = output_asStrings(configHomogenizationDamage) +#else + prm%output = configHomogenizationDamage%get_asStrings('output',defaultVal=emptyStringArray) +#endif + else + prm%output = emptyStringArray + endif + end associate + enddo + +end subroutine damage_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief Partition temperature onto the individual constituents. +!-------------------------------------------------------------------------------------------------- +module subroutine damage_partition(ce) + + real(pReal) :: phi + integer, intent(in) :: ce + + integer :: co + + + if(damageState_h(material_homogenizationAt2(ce))%sizeState < 1) return + phi = damagestate_h(material_homogenizationAt2(ce))%state(1,material_homogenizationMemberAt2(ce)) + do co = 1, homogenization_Nconstituents(material_homogenizationAt2(ce)) + call phase_damage_set_phi(phi,co,ce) + enddo + +end subroutine damage_partition + + + +!-------------------------------------------------------------------------------------------------- +!> @brief Returns homogenized nonlocal damage mobility +!-------------------------------------------------------------------------------------------------- +module function damage_nonlocal_getMobility(ce) result(M) + + integer, intent(in) :: ce + integer :: & + co + real(pReal) :: M + + M = 0.0_pReal + + do co = 1, homogenization_Nconstituents(material_homogenizationAt2(ce)) + M = M + lattice_M(material_phaseAt2(co,ce)) + enddo + + M = M/real(homogenization_Nconstituents(material_homogenizationAt2(ce)),pReal) + +end function damage_nonlocal_getMobility + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates homogenized damage driving forces +!-------------------------------------------------------------------------------------------------- +module subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ce) + + integer, intent(in) :: ce + real(pReal), intent(in) :: & + phi + real(pReal) :: & + phiDot, dPhiDot_dPhi + + phiDot = 0.0_pReal + dPhiDot_dPhi = 0.0_pReal + + call phase_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi, phi, ce) + phiDot = phiDot/real(homogenization_Nconstituents(material_homogenizationAt2(ce)),pReal) + dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Nconstituents(material_homogenizationAt2(ce)),pReal) + +end subroutine damage_nonlocal_getSourceAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief updated nonlocal damage field with solution from damage phase field PDE +!-------------------------------------------------------------------------------------------------- +module subroutine damage_nonlocal_putNonLocalDamage(phi,ce) + + integer, intent(in) :: ce + real(pReal), intent(in) :: & + phi + integer :: & + ho, & + me + + ho = material_homogenizationAt2(ce) + me = material_homogenizationMemberAt2(ce) + damagestate_h(ho)%state(1,me) = phi + +end subroutine damage_nonlocal_putNonLocalDamage + + +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +module subroutine damage_nonlocal_results(ho,group) + + integer, intent(in) :: ho + character(len=*), intent(in) :: group + + integer :: o + + associate(prm => param(ho)) + outputsLoop: do o = 1,size(prm%output) + select case(prm%output(o)) + case ('phi') + call results_writeDataset(group,damagestate_h(ho)%state(1,:),prm%output(o),& + 'damage indicator','-') + end select + enddo outputsLoop + end associate + +end subroutine damage_nonlocal_results + +end submodule homogenization_damage diff --git a/src/homogenization_mech.f90 b/src/homogenization_mechanical.f90 similarity index 56% rename from src/homogenization_mech.f90 rename to src/homogenization_mechanical.f90 index 641e960fd..f14ddf4db 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mechanical.f90 @@ -2,75 +2,72 @@ !> @author Martin Diehl, KU Leuven !> @brief Partition F and homogenize P/dPdF !-------------------------------------------------------------------------------------------------- -submodule(homogenization) homogenization_mech +submodule(homogenization) mechanical interface - module subroutine mech_none_init - end subroutine mech_none_init + module subroutine mechanical_pass_init + end subroutine mechanical_pass_init - module subroutine mech_isostrain_init - end subroutine mech_isostrain_init + module subroutine mechanical_isostrain_init + end subroutine mechanical_isostrain_init - module subroutine mech_RGC_init(num_homogMech) + module subroutine mechanical_RGC_init(num_homogMech) class(tNode), pointer, intent(in) :: & num_homogMech !< pointer to mechanical homogenization numerics data - end subroutine mech_RGC_init + end subroutine mechanical_RGC_init - module subroutine mech_isostrain_partitionDeformation(F,avgF) + module subroutine mechanical_isostrain_partitionDeformation(F,avgF) real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point - end subroutine mech_isostrain_partitionDeformation + end subroutine mechanical_isostrain_partitionDeformation - module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) + module subroutine mechanical_RGC_partitionDeformation(F,avgF,ce) real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point integer, intent(in) :: & - instance, & - of - end subroutine mech_RGC_partitionDeformation + ce + end subroutine mechanical_RGC_partitionDeformation - module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) + module subroutine mechanical_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,ho) real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: instance - end subroutine mech_isostrain_averageStressAndItsTangent + integer, intent(in) :: ho + end subroutine mechanical_isostrain_averageStressAndItsTangent - module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) + module subroutine mechanical_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,ho) real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: instance - end subroutine mech_RGC_averageStressAndItsTangent + integer, intent(in) :: ho + end subroutine mechanical_RGC_averageStressAndItsTangent - module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) + module function mechanical_RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy) logical, dimension(2) :: doneAndHappy real(pReal), dimension(:,:,:), intent(in) :: & P,& !< partitioned stresses - F,& !< partitioned deformation gradients - F0 !< partitioned initial deformation gradients + F !< partitioned deformation gradients real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses real(pReal), dimension(3,3), intent(in) :: avgF !< average F real(pReal), intent(in) :: dt !< time increment integer, intent(in) :: & - ip, & !< integration point number - el !< element number - end function mech_RGC_updateState + ce !< cell + end function mechanical_RGC_updateState - module subroutine mech_RGC_results(instance,group) - integer, intent(in) :: instance !< homogenization instance + module subroutine mechanical_RGC_results(ho,group) + integer, intent(in) :: ho !< homogenization type character(len=*), intent(in) :: group !< group name in HDF5 file - end subroutine mech_RGC_results + end subroutine mechanical_RGC_results end interface @@ -79,7 +76,7 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief Allocate variables and set parameters. !-------------------------------------------------------------------------------------------------- -module subroutine mech_init(num_homog) +module subroutine mechanical_init(num_homog) class(tNode), pointer, intent(in) :: & num_homog @@ -87,7 +84,7 @@ module subroutine mech_init(num_homog) class(tNode), pointer :: & num_homogMech - print'(/,a)', ' <<<+- homogenization_mech init -+>>>' + print'(/,a)', ' <<<+- homogenization:mechanical init -+>>>' allocate(homogenization_dPdF(3,3,3,3,discretization_nIPs*discretization_Nelems), source=0.0_pReal) homogenization_F0 = spread(math_I3,3,discretization_nIPs*discretization_Nelems) ! initialize to identity @@ -95,150 +92,145 @@ module subroutine mech_init(num_homog) allocate(homogenization_P(3,3,discretization_nIPs*discretization_Nelems), source=0.0_pReal) num_homogMech => num_homog%get('mech',defaultVal=emptyDict) - if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init - if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init - if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init(num_homogMech) + if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mechanical_pass_init + if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mechanical_isostrain_init + if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mechanical_RGC_init(num_homogMech) -end subroutine mech_init +end subroutine mechanical_init !-------------------------------------------------------------------------------------------------- !> @brief Partition F onto the individual constituents. !-------------------------------------------------------------------------------------------------- -module subroutine mech_partition(subF,ip,el) +module subroutine mechanical_partition(subF,ce) real(pReal), intent(in), dimension(3,3) :: & subF integer, intent(in) :: & - ip, & !< integration point - el !< element number + ce - chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) + integer :: co + real(pReal), dimension (3,3,homogenization_Nconstituents(material_homogenizationAt2(ce))) :: Fs + + + chosenHomogenization: select case(homogenization_type(material_homogenizationAt2(ce))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - crystallite_F(1:3,1:3,1,ip,el) = subF + Fs(1:3,1:3,1) = subF case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - call mech_isostrain_partitionDeformation(& - crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - subF) + call mechanical_isostrain_partitionDeformation(Fs,subF) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - call mech_RGC_partitionDeformation(& - crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - subF,& - ip, & - el) + call mechanical_RGC_partitionDeformation(Fs,subF,ce) end select chosenHomogenization -end subroutine mech_partition + do co = 1,homogenization_Nconstituents(material_homogenizationAt2(ce)) + call phase_mechanical_setF(Fs(1:3,1:3,co),co,ce) + enddo + + +end subroutine mechanical_partition !-------------------------------------------------------------------------------------------------- !> @brief Average P and dPdF from the individual constituents. !-------------------------------------------------------------------------------------------------- -module subroutine mech_homogenize(ip,el) +module subroutine mechanical_homogenize(dt,ce) - integer, intent(in) :: & - ip, & !< integration point - el !< element number - integer :: co,ce - real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + real(pReal), intent(in) :: dt + integer, intent(in) :: ce + + integer :: co + real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt2(ce))) + real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationAt2(ce))) - ce = (el-1)* discretization_nIPs + ip - chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) + chosenHomogenization: select case(homogenization_type(material_homogenizationAt2(ce))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - homogenization_P(1:3,1:3,ce) = crystallite_P(1:3,1:3,1,ip,el) - homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = crystallite_stressTangent(1,ip,el) + homogenization_P(1:3,1:3,ce) = phase_mechanical_getP(1,ce) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = phase_mechanical_dPdF(dt,1,ce) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + do co = 1, homogenization_Nconstituents(material_homogenizationAt2(ce)) + dPdFs(:,:,:,:,co) = phase_mechanical_dPdF(dt,co,ce) + Ps(:,:,co) = phase_mechanical_getP(co,ce) enddo - call mech_isostrain_averageStressAndItsTangent(& + call mechanical_isostrain_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& - crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - dPdFs, & - homogenization_typeInstance(material_homogenizationAt(el))) + Ps,dPdFs, & + material_homogenizationAt2(ce)) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + do co = 1, homogenization_Nconstituents(material_homogenizationAt2(ce)) + dPdFs(:,:,:,:,co) = phase_mechanical_dPdF(dt,co,ce) + Ps(:,:,co) = phase_mechanical_getP(co,ce) enddo - call mech_RGC_averageStressAndItsTangent(& + call mechanical_RGC_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& - crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - dPdFs, & - homogenization_typeInstance(material_homogenizationAt(el))) + Ps,dPdFs, & + material_homogenizationAt2(ce)) end select chosenHomogenization -end subroutine mech_homogenize +end subroutine mechanical_homogenize !-------------------------------------------------------------------------------------------------- !> @brief update the internal state of the homogenization scheme and tell whether "done" and !> "happy" with result !-------------------------------------------------------------------------------------------------- -module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) +module function mechanical_updateState(subdt,subF,ce) result(doneAndHappy) real(pReal), intent(in) :: & subdt !< current time step real(pReal), intent(in), dimension(3,3) :: & subF integer, intent(in) :: & - ip, & !< integration point - el !< element number + ce logical, dimension(2) :: doneAndHappy integer :: co - real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt2(ce))) + real(pReal) :: Fs(3,3,homogenization_Nconstituents(material_homogenizationAt2(ce))) + real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationAt2(ce))) - if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then - do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + if (homogenization_type(material_homogenizationAt2(ce)) == HOMOGENIZATION_RGC_ID) then + do co = 1, homogenization_Nconstituents(material_homogenizationAt2(ce)) + dPdFs(:,:,:,:,co) = phase_mechanical_dPdF(subdt,co,ce) + Fs(:,:,co) = phase_mechanical_getF(co,ce) + Ps(:,:,co) = phase_mechanical_getP(co,ce) enddo - doneAndHappy = & - mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& - subF,& - subdt, & - dPdFs, & - ip, & - el) + doneAndHappy = mechanical_RGC_updateState(Ps,Fs,subF,subdt,dPdFs,ce) else doneAndHappy = .true. endif -end function mech_updateState +end function mechanical_updateState !-------------------------------------------------------------------------------------------------- !> @brief Write results to file. !-------------------------------------------------------------------------------------------------- -module subroutine mech_results(group_base,h) - use material, only: & - material_homogenization_type => homogenization_type +module subroutine mechanical_results(group_base,ho) character(len=*), intent(in) :: group_base - integer, intent(in) :: h + integer, intent(in) :: ho character(len=:), allocatable :: group group = trim(group_base)//'/mech' call results_closeGroup(results_addGroup(group)) - select case(material_homogenization_type(h)) + select case(homogenization_type(ho)) case(HOMOGENIZATION_rgc_ID) - call mech_RGC_results(homogenization_typeInstance(h),group) + call mechanical_RGC_results(ho,group) end select @@ -249,7 +241,7 @@ module subroutine mech_results(group_base,h) !call results_writeDataset(group,temp,'P',& ! '1st Piola-Kirchhoff stress','Pa') -end subroutine mech_results +end subroutine mechanical_results -end submodule homogenization_mech +end submodule mechanical diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mechanical_RGC.f90 similarity index 83% rename from src/homogenization_mech_RGC.f90 rename to src/homogenization_mechanical_RGC.f90 index 04ec73845..a68e9b772 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mechanical_RGC.f90 @@ -6,7 +6,7 @@ !> @brief Relaxed grain cluster (RGC) homogenization scheme !> N_constituents is defined as p x q x r (cluster) !-------------------------------------------------------------------------------------------------- -submodule(homogenization:homogenization_mech) homogenization_mech_RGC +submodule(homogenization:mechanical) RGC use rotations use lattice @@ -24,9 +24,6 @@ submodule(homogenization:homogenization_mech) homogenization_mech_RGC end type tParameters type :: tRGCstate - real(pReal), pointer, dimension(:) :: & - work, & - penaltyEnergy real(pReal), pointer, dimension(:,:) :: & relaxationVector end type tRGCstate @@ -74,14 +71,13 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -module subroutine mech_RGC_init(num_homogMech) +module subroutine mechanical_RGC_init(num_homogMech) class(tNode), pointer, intent(in) :: & num_homogMech !< pointer to mechanical homogenization numerics data integer :: & - Ninstances, & - h, & + ho, & Nmaterialpoints, & sizeState, nIntFaceTot @@ -91,10 +87,9 @@ module subroutine mech_RGC_init(num_homogMech) homog, & homogMech - print'(/,a)', ' <<<+- homogenization_mech_rgc init -+>>>' + print'(/,a)', ' <<<+- homogenization:mechanical:RGC init -+>>>' - Ninstances = count(homogenization_type == HOMOGENIZATION_RGC_ID) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) + print'(a,i2)', ' # instances: ',count(homogenization_type == HOMOGENIZATION_RGC_ID); flush(IO_STDOUT) print*, 'Tjahjanto et al., International Journal of Material Forming 2(1):939–942, 2009' print*, 'https://doi.org/10.1007/s12289-009-0619-1'//IO_EOL @@ -104,10 +99,11 @@ module subroutine mech_RGC_init(num_homogMech) - allocate(param(Ninstances)) - allocate(state(Ninstances)) - allocate(state0(Ninstances)) - allocate(dependentState(Ninstances)) + material_homogenization => config_material%get('homogenization') + allocate(param(material_homogenization%length)) + allocate(state(material_homogenization%length)) + allocate(state0(material_homogenization%length)) + allocate(dependentState(material_homogenization%length)) num_RGC => num_homogMech%get('RGC',defaultVal=emptyDict) @@ -140,15 +136,14 @@ module subroutine mech_RGC_init(num_homogMech) if (num%volDiscrPow <= 0.0_pReal) call IO_error(301,ext_msg='volDiscrPw_RGC') - material_homogenization => config_material%get('homogenization') - do h = 1, size(homogenization_type) - if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle - homog => material_homogenization%get(h) + do ho = 1, size(homogenization_type) + if (homogenization_type(ho) /= HOMOGENIZATION_RGC_ID) cycle + homog => material_homogenization%get(ho) homogMech => homog%get('mechanics') - associate(prm => param(homogenization_typeInstance(h)), & - stt => state(homogenization_typeInstance(h)), & - st0 => state0(homogenization_typeInstance(h)), & - dst => dependentState(homogenization_typeInstance(h))) + associate(prm => param(ho), & + stt => state(ho), & + st0 => state0(ho), & + dst => dependentState(ho)) #if defined (__GFORTRAN__) prm%output = output_asStrings(homogMech) @@ -157,8 +152,8 @@ module subroutine mech_RGC_init(num_homogMech) #endif prm%N_constituents = homogMech%get_asInts('cluster_size',requiredSize=3) - if (homogenization_Nconstituents(h) /= product(prm%N_constituents)) & - call IO_error(211,ext_msg='N_constituents (mech_RGC)') + if (homogenization_Nconstituents(ho) /= product(prm%N_constituents)) & + call IO_error(211,ext_msg='N_constituents (mechanical_RGC)') prm%xi_alpha = homogMech%get_asFloat('xi_alpha') prm%c_alpha = homogMech%get_asFloat('c_alpha') @@ -166,22 +161,18 @@ module subroutine mech_RGC_init(num_homogMech) prm%D_alpha = homogMech%get_asFloats('D_alpha', requiredSize=3) prm%a_g = homogMech%get_asFloats('a_g', requiredSize=3) - Nmaterialpoints = count(material_homogenizationAt == h) + Nmaterialpoints = count(material_homogenizationAt == ho) nIntFaceTot = 3*( (prm%N_constituents(1)-1)*prm%N_constituents(2)*prm%N_constituents(3) & + prm%N_constituents(1)*(prm%N_constituents(2)-1)*prm%N_constituents(3) & + prm%N_constituents(1)*prm%N_constituents(2)*(prm%N_constituents(3)-1)) - sizeState = nIntFaceTot & - + size(['avg constitutive work ','average penalty energy']) + sizeState = nIntFaceTot - homogState(h)%sizeState = sizeState - allocate(homogState(h)%state0 (sizeState,Nmaterialpoints), source=0.0_pReal) - allocate(homogState(h)%subState0(sizeState,Nmaterialpoints), source=0.0_pReal) - allocate(homogState(h)%state (sizeState,Nmaterialpoints), source=0.0_pReal) + homogState(ho)%sizeState = sizeState + allocate(homogState(ho)%state0 (sizeState,Nmaterialpoints), source=0.0_pReal) + allocate(homogState(ho)%state (sizeState,Nmaterialpoints), source=0.0_pReal) - stt%relaxationVector => homogState(h)%state(1:nIntFaceTot,:) - st0%relaxationVector => homogState(h)%state0(1:nIntFaceTot,:) - stt%work => homogState(h)%state(nIntFaceTot+1,:) - stt%penaltyEnergy => homogState(h)%state(nIntFaceTot+2,:) + stt%relaxationVector => homogState(ho)%state(1:nIntFaceTot,:) + st0%relaxationVector => homogState(ho)%state0(1:nIntFaceTot,:) allocate(dst%volumeDiscrepancy( Nmaterialpoints), source=0.0_pReal) allocate(dst%relaxationRate_avg( Nmaterialpoints), source=0.0_pReal) @@ -190,35 +181,36 @@ module subroutine mech_RGC_init(num_homogMech) !-------------------------------------------------------------------------------------------------- ! assigning cluster orientations - dependentState(homogenization_typeInstance(h))%orientation = spread(eu2om(prm%a_g*inRad),3,Nmaterialpoints) + dependentState(ho)%orientation = spread(eu2om(prm%a_g*inRad),3,Nmaterialpoints) !dst%orientation = spread(eu2om(prm%a_g*inRad),3,Nmaterialpoints) ifort version 18.0.1 crashes (for whatever reason) end associate enddo -end subroutine mech_RGC_init +end subroutine mechanical_RGC_init !-------------------------------------------------------------------------------------------------- !> @brief partitions the deformation gradient onto the constituents !-------------------------------------------------------------------------------------------------- -module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) +module subroutine mechanical_RGC_partitionDeformation(F,avgF,ce) real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned F per grain real(pReal), dimension (3,3), intent(in) :: avgF !< averaged F integer, intent(in) :: & - instance, & - of + ce real(pReal), dimension(3) :: aVect,nVect integer, dimension(4) :: intFace integer, dimension(3) :: iGrain3 - integer :: iGrain,iFace,i,j - - associate(prm => param(instance)) + integer :: iGrain,iFace,i,j,ho,me + associate(prm => param(material_homogenizationAt2(ce))) + + ho = material_homogenizationAt2(ce) + me = material_homogenizationMemberAt2(ce) !-------------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations F = 0.0_pReal @@ -226,8 +218,8 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) iGrain3 = grain1to3(iGrain,prm%N_constituents) do iFace = 1,6 intFace = getInterface(iFace,iGrain3) ! identifying 6 interfaces of each grain - aVect = relaxationVector(intFace,instance,of) ! get the relaxation vectors for each interface from global relaxation vector array - nVect = interfaceNormal(intFace,instance,of) + aVect = relaxationVector(intFace,ho,me) ! get the relaxation vectors for each interface from global relaxation vector array + nVect = interfaceNormal(intFace,ho,me) forall (i=1:3,j=1:3) & F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! calculating deformation relaxations due to interface relaxation enddo @@ -236,29 +228,27 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) end associate -end subroutine mech_RGC_partitionDeformation +end subroutine mechanical_RGC_partitionDeformation !-------------------------------------------------------------------------------------------------- !> @brief update the internal state of the homogenization scheme and tell whether "done" and ! "happy" with result !-------------------------------------------------------------------------------------------------- -module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) +module function mechanical_RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy) logical, dimension(2) :: doneAndHappy real(pReal), dimension(:,:,:), intent(in) :: & P,& !< partitioned stresses - F,& !< partitioned deformation gradients - F0 !< partitioned initial deformation gradients + F !< partitioned deformation gradients real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses real(pReal), dimension(3,3), intent(in) :: avgF !< average F real(pReal), intent(in) :: dt !< time increment integer, intent(in) :: & - ip, & !< integration point number - el !< element number + ce !< cell integer, dimension(4) :: intFaceN,intFaceP,faceID integer, dimension(3) :: nGDim,iGr3N,iGr3P - integer :: instance,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain, of + integer :: ho,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,iGrain,nGrain, me real(pReal), dimension(3,3,size(P,3)) :: R,pF,pR,D,pD real(pReal), dimension(3,size(P,3)) :: NN,devNull real(pReal), dimension(3) :: normP,normN,mornP,mornN @@ -272,10 +262,10 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa return endif zeroTimeStep - instance = homogenization_typeInstance(material_homogenizationAt(el)) - of = material_homogenizationMemberAt(ip,el) + ho = material_homogenizationAt2(ce) - associate(stt => state(instance), st0 => state0(instance), dst => dependentState(instance), prm => param(instance)) + me = material_homogenizationMemberAt2(ce) + associate(stt => state(ho), st0 => state0(ho), dst => dependentState(ho), prm => param(ho)) !-------------------------------------------------------------------------------------------------- ! get the dimension of the cluster (grains and interfaces) @@ -287,38 +277,38 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !-------------------------------------------------------------------------------------------------- ! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster - allocate(resid(3*nIntFaceTot), source=0.0_pReal) - allocate(tract(nIntFaceTot,3), source=0.0_pReal) - relax = stt%relaxationVector(:,of) - drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) + allocate(resid(3*nIntFaceTot), source=0.0_pReal) + allocate(tract(nIntFaceTot,3), source=0.0_pReal) + relax = stt%relaxationVector(:,me) + drelax = stt%relaxationVector(:,me) - st0%relaxationVector(:,me) !-------------------------------------------------------------------------------------------------- ! computing interface mismatch and stress penalty tensor for all interfaces of all grains - call stressPenalty(R,NN,avgF,F,ip,el,instance,of) + call stressPenalty(R,NN,avgF,F,ho,me) !-------------------------------------------------------------------------------------------------- ! calculating volume discrepancy and stress penalty related to overall volume discrepancy - call volumePenalty(D,dst%volumeDiscrepancy(of),avgF,F,nGrain,instance,of) + call volumePenalty(D,dst%volumeDiscrepancy(me),avgF,F,nGrain) !------------------------------------------------------------------------------------------------ ! computing the residual stress from the balance of traction at all (interior) interfaces do iNum = 1,nIntFaceTot - faceID = interface1to4(iNum,param(instance)%N_constituents) ! identifying the interface ID in local coordinate system (4-dimensional index) + faceID = interface1to4(iNum,param(ho)%N_constituents) ! identifying the interface ID in local coordinate system (4-dimensional index) !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrN = grain3to1(iGr3N,param(instance)%N_constituents) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrN = grain3to1(iGr3N,param(ho)%N_constituents) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceN = getInterface(2*faceID(1),iGr3N) - normN = interfaceNormal(intFaceN,instance,of) + normN = interfaceNormal(intFaceN,ho,me) !-------------------------------------------------------------------------------------------------- ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1 ! identifying the grain ID in local coordinate system (3-dimensional index) - iGrP = grain3to1(iGr3P,param(instance)%N_constituents) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrP = grain3to1(iGr3P,param(ho)%N_constituents) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceP = getInterface(2*faceID(1)-1,iGr3P) - normP = interfaceNormal(intFaceP,instance,of) + normP = interfaceNormal(intFaceP,ho,me) !-------------------------------------------------------------------------------------------------- ! compute the residual of traction at the interface (in local system, 4-dimensional index) @@ -346,20 +336,9 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa if (residMax < num%rtol*stresMax .or. residMax < num%atol) then doneAndHappy = .true. -!-------------------------------------------------------------------------------------------------- -! compute/update the state for postResult, i.e., all energy densities computed by time-integration - do iGrain = 1,product(prm%N_constituents) - do i = 1,3;do j = 1,3 - stt%work(of) = stt%work(of) & - + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) - stt%penaltyEnergy(of) = stt%penaltyEnergy(of) & - + R(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) - enddo; enddo - enddo - - dst%mismatch(1:3,of) = sum(NN,2)/real(nGrain,pReal) - dst%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pReal) - dst%relaxationRate_max(of) = maxval(abs(drelax))/dt + dst%mismatch(1:3,me) = sum(NN,2)/real(nGrain,pReal) + dst%relaxationRate_avg(me) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pReal) + dst%relaxationRate_max(me) = maxval(abs(drelax))/dt return @@ -378,18 +357,18 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa ! ... of the constitutive stress tangent, assembled from dPdF or material constitutive model "smatrix" allocate(smatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal) do iNum = 1,nIntFaceTot - faceID = interface1to4(iNum,param(instance)%N_constituents) ! assembling of local dPdF into global Jacobian matrix + faceID = interface1to4(iNum,param(ho)%N_constituents) ! assembling of local dPdF into global Jacobian matrix !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identifying the grain ID in local coordinate sytem - iGrN = grain3to1(iGr3N,param(instance)%N_constituents) ! translate into global grain ID + iGrN = grain3to1(iGr3N,param(ho)%N_constituents) ! translate into global grain ID intFaceN = getInterface(2*faceID(1),iGr3N) ! identifying the connecting interface in local coordinate system - normN = interfaceNormal(intFaceN,instance,of) + normN = interfaceNormal(intFaceN,ho,me) do iFace = 1,6 intFaceN = getInterface(iFace,iGr3N) ! identifying all interfaces that influence relaxation of the above interface - mornN = interfaceNormal(intFaceN,instance,of) - iMun = interface4to1(intFaceN,param(instance)%N_constituents) ! translate the interfaces ID into local 4-dimensional index + mornN = interfaceNormal(intFaceN,ho,me) + iMun = interface4to1(intFaceN,param(ho)%N_constituents) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0) then ! get the corresponding tangent do i=1,3; do j=1,3; do k=1,3; do l=1,3 smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) & @@ -404,13 +383,13 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1 ! identifying the grain ID in local coordinate sytem - iGrP = grain3to1(iGr3P,param(instance)%N_constituents) ! translate into global grain ID + iGrP = grain3to1(iGr3P,param(ho)%N_constituents) ! translate into global grain ID intFaceP = getInterface(2*faceID(1)-1,iGr3P) ! identifying the connecting interface in local coordinate system - normP = interfaceNormal(intFaceP,instance,of) + normP = interfaceNormal(intFaceP,ho,me) do iFace = 1,6 intFaceP = getInterface(iFace,iGr3P) ! identifying all interfaces that influence relaxation of the above interface - mornP = interfaceNormal(intFaceP,instance,of) - iMun = interface4to1(intFaceP,param(instance)%N_constituents) ! translate the interfaces ID into local 4-dimensional index + mornP = interfaceNormal(intFaceP,ho,me) + iMun = interface4to1(intFaceP,param(ho)%N_constituents) ! translate the interfaces ID into local 4-dimensional index if (iMun > 0) then ! get the corresponding tangent do i=1,3; do j=1,3; do k=1,3; do l=1,3 smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) & @@ -430,31 +409,31 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa do ipert = 1,3*nIntFaceTot p_relax = relax p_relax(ipert) = relax(ipert) + num%pPert ! perturb the relaxation vector - stt%relaxationVector(:,of) = p_relax - call grainDeformation(pF,avgF,instance,of) ! rain deformation from perturbed state - call stressPenalty(pR,DevNull, avgF,pF,ip,el,instance,of) ! stress penalty due to interface mismatch from perturbed state - call volumePenalty(pD,devNull(1,1), avgF,pF,nGrain,instance,of) ! stress penalty due to volume discrepancy from perturbed state + stt%relaxationVector(:,me) = p_relax + call grainDeformation(pF,avgF,ho,me) ! rain deformation from perturbed state + call stressPenalty(pR,DevNull, avgF,pF,ho,me) ! stress penalty due to interface mismatch from perturbed state + call volumePenalty(pD,devNull(1,1), avgF,pF,nGrain) ! stress penalty due to volume discrepancy from perturbed state !-------------------------------------------------------------------------------------------------- ! computing the global stress residual array from the perturbed state p_resid = 0.0_pReal do iNum = 1,nIntFaceTot - faceID = interface1to4(iNum,param(instance)%N_constituents) ! identifying the interface ID in local coordinate system (4-dimensional index) + faceID = interface1to4(iNum,param(ho)%N_constituents) ! identifying the interface ID in local coordinate system (4-dimensional index) !-------------------------------------------------------------------------------------------------- ! identify the left/bottom/back grain (-|N) iGr3N = faceID(2:4) ! identify the grain ID in local coordinate system (3-dimensional index) - iGrN = grain3to1(iGr3N,param(instance)%N_constituents) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrN = grain3to1(iGr3N,param(ho)%N_constituents) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceN = getInterface(2*faceID(1),iGr3N) ! identify the interface ID of the grain - normN = interfaceNormal(intFaceN,instance,of) + normN = interfaceNormal(intFaceN,ho,me) !-------------------------------------------------------------------------------------------------- ! identify the right/up/front grain (+|P) iGr3P = iGr3N iGr3P(faceID(1)) = iGr3N(faceID(1))+1 ! identify the grain ID in local coordinate system (3-dimensional index) - iGrP = grain3to1(iGr3P,param(instance)%N_constituents) ! translate the local grain ID into global coordinate system (1-dimensional index) + iGrP = grain3to1(iGr3P,param(ho)%N_constituents) ! translate the local grain ID into global coordinate system (1-dimensional index) intFaceP = getInterface(2*faceID(1)-1,iGr3P) ! identify the interface ID of the grain - normP = interfaceNormal(intFaceP,instance,of) + normP = interfaceNormal(intFaceP,ho,me) !-------------------------------------------------------------------------------------------------- ! compute the residual stress (contribution of mismatch and volume penalties) from perturbed state @@ -494,11 +473,11 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa do i = 1,3*nIntFaceTot;do j = 1,3*nIntFaceTot drelax(i) = drelax(i) - jnverse(i,j)*resid(j) ! Calculate the correction for the state variable enddo; enddo - stt%relaxationVector(:,of) = relax + drelax ! Updateing the state variable for the next iteration + stt%relaxationVector(:,me) = relax + drelax ! Updateing the state variable for the next iteration if (any(abs(drelax) > num%maxdRelax)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large doneAndHappy = [.true.,.false.] !$OMP CRITICAL (write2out) - print'(a,i3,a,i3,a)',' RGC_updateState: ip ',ip,' | el ',el,' enforces cutback' + print'(a,i3,a,i3,a)',' RGC_updateState: enforces cutback' print'(a,e15.8)',' due to large relaxation change = ',maxval(abs(drelax)) flush(IO_STDOUT) !$OMP END CRITICAL (write2out) @@ -510,27 +489,26 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !------------------------------------------------------------------------------------------------ !> @brief calculate stress-like penalty due to deformation mismatch !------------------------------------------------------------------------------------------------ - subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of) + subroutine stressPenalty(rPen,nMis,avgF,fDef,ho,me) real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch real(pReal), dimension (:,:,:), intent(in) :: fDef !< deformation gradients real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor - integer, intent(in) :: ip,el,instance,of + integer, intent(in) :: ho, me integer, dimension (4) :: intFace integer, dimension (3) :: iGrain3,iGNghb3,nGDim real(pReal), dimension (3,3) :: gDef,nDef real(pReal), dimension (3) :: nVect,surfCorr - real(pReal), dimension (2) :: Gmoduli integer :: iGrain,iGNghb,iFace,i,j,k,l real(pReal) :: muGrain,muGNghb,nDefNorm real(pReal), parameter :: & nDefToler = 1.0e-10_pReal, & b = 2.5e-10_pReal ! Length of Burgers vector - nGDim = param(instance)%N_constituents + nGDim = param(ho)%N_constituents rPen = 0.0_pReal nMis = 0.0_pReal @@ -538,27 +516,26 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa ! get the correction factor the modulus of penalty stress representing the evolution of area of ! the interfaces due to deformations - surfCorr = surfaceCorrection(avgF,instance,of) - - associate(prm => param(instance)) + surfCorr = surfaceCorrection(avgF,ho,me) + associate(prm => param(ho)) !----------------------------------------------------------------------------------------------- ! computing the mismatch and penalty stress tensor of all grains grainLoop: do iGrain = 1,product(prm%N_constituents) - muGrain = equivalentMu(iGrain,ip,el) + muGrain = equivalentMu(iGrain,ce) iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position interfaceLoop: do iFace = 1,6 intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain - nVect = interfaceNormal(intFace,instance,of) + nVect = interfaceNormal(intFace,ho,me) iGNghb3 = iGrain3 ! identify the neighboring grain across the interface iGNghb3(abs(intFace(1))) = iGNghb3(abs(intFace(1))) & + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal)) where(iGNghb3 < 1) iGNghb3 = nGDim where(iGNghb3 >nGDim) iGNghb3 = 1 iGNghb = grain3to1(iGNghb3,prm%N_constituents) ! get the ID of the neighboring grain - muGNghb = equivalentMu(iGNghb,ip,el) + muGNghb = equivalentMu(iGNghb,ce) gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! difference/jump in deformation gradeint across the neighbor !------------------------------------------------------------------------------------------- @@ -597,7 +574,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !------------------------------------------------------------------------------------------------ !> @brief calculate stress-like penalty due to volume discrepancy !------------------------------------------------------------------------------------------------ - subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of) + subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain) real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume real(pReal), intent(out) :: vDiscrep ! total volume discrepancy @@ -605,9 +582,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa real(pReal), dimension (:,:,:), intent(in) :: fDef ! deformation gradients real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient integer, intent(in) :: & - Ngrain, & - instance, & - of + Ngrain real(pReal), dimension(size(vPen,3)) :: gVol integer :: i @@ -637,14 +612,14 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !> @brief compute the correction factor accouted for surface evolution (area change) due to ! deformation !-------------------------------------------------------------------------------------------------- - function surfaceCorrection(avgF,instance,of) + function surfaceCorrection(avgF,ho,me) real(pReal), dimension(3) :: surfaceCorrection real(pReal), dimension(3,3), intent(in) :: avgF !< average F integer, intent(in) :: & - instance, & - of + ho, & + me real(pReal), dimension(3,3) :: invC real(pReal), dimension(3) :: nVect real(pReal) :: detF @@ -655,7 +630,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa surfaceCorrection = 0.0_pReal do iBase = 1,3 - nVect = interfaceNormal([iBase,1,1,1],instance,of) + nVect = interfaceNormal([iBase,1,1,1],ho,me) do i = 1,3; do j = 1,3 surfaceCorrection(iBase) = surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j) ! compute the component of (the inverse of) the stretch in the direction of the normal enddo; enddo @@ -668,15 +643,17 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !------------------------------------------------------------------------------------------------- !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor !------------------------------------------------------------------------------------------------- - real(pReal) function equivalentMu(grainID,ip,el) + real(pReal) function equivalentMu(grainID,ce) integer, intent(in) :: & grainID,& - ip, & !< integration point number - el !< element number + ce + + real(pReal), dimension(6,6) :: C - equivalentMu = lattice_equivalent_mu(constitutive_homogenizedC(grainID,ip,el),'voigt') + C = phase_homogenizedC(material_phaseAt2(grainID,ce),material_phaseMemberAt2(grainID,ce)) + equivalentMu = lattice_equivalent_mu(C,'voigt') end function equivalentMu @@ -685,14 +662,14 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !> @brief calculating the grain deformation gradient (the same with ! homogenization_RGC_partitionDeformation, but used only for perturbation scheme) !------------------------------------------------------------------------------------------------- - subroutine grainDeformation(F, avgF, instance, of) + subroutine grainDeformation(F, avgF, ho, me) real(pReal), dimension(:,:,:), intent(out) :: F !< partitioned F per grain real(pReal), dimension(:,:), intent(in) :: avgF !< averaged F integer, intent(in) :: & - instance, & - of + ho, & + me real(pReal), dimension(3) :: aVect,nVect integer, dimension(4) :: intFace @@ -702,15 +679,15 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !----------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations - associate(prm => param(instance)) + associate (prm => param(ho)) F = 0.0_pReal do iGrain = 1,product(prm%N_constituents) iGrain3 = grain1to3(iGrain,prm%N_constituents) do iFace = 1,6 intFace = getInterface(iFace,iGrain3) - aVect = relaxationVector(intFace,instance,of) - nVect = interfaceNormal(intFace,instance,of) + aVect = relaxationVector(intFace,ho,me) + nVect = interfaceNormal(intFace,ho,me) forall (i=1:3,j=1:3) & F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! effective relaxations enddo @@ -721,49 +698,43 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa end subroutine grainDeformation -end function mech_RGC_updateState +end function mechanical_RGC_updateState !-------------------------------------------------------------------------------------------------- !> @brief derive average stress and stiffness from constituent quantities !-------------------------------------------------------------------------------------------------- -module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) +module subroutine mechanical_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,ho) real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: instance + integer, intent(in) :: ho - avgP = sum(P,3) /real(product(param(instance)%N_constituents),pReal) - dAvgPdAvgF = sum(dPdF,5)/real(product(param(instance)%N_constituents),pReal) + avgP = sum(P,3) /real(product(param(ho)%N_constituents),pReal) + dAvgPdAvgF = sum(dPdF,5)/real(product(param(ho)%N_constituents),pReal) -end subroutine mech_RGC_averageStressAndItsTangent +end subroutine mechanical_RGC_averageStressAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief writes results to HDF5 output file !-------------------------------------------------------------------------------------------------- -module subroutine mech_RGC_results(instance,group) +module subroutine mechanical_RGC_results(ho,group) - integer, intent(in) :: instance + integer, intent(in) :: ho character(len=*), intent(in) :: group integer :: o - associate(stt => state(instance), dst => dependentState(instance), prm => param(instance)) + associate(stt => state(ho), dst => dependentState(ho), prm => param(ho)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case('W') - call results_writeDataset(group,stt%work,trim(prm%output(o)), & - 'work density','J/m³') case('M') call results_writeDataset(group,dst%mismatch,trim(prm%output(o)), & 'average mismatch tensor','1') - case('R') - call results_writeDataset(group,stt%penaltyEnergy,trim(prm%output(o)), & - 'mismatch penalty density','J/m³') case('Delta_V') call results_writeDataset(group,dst%volumeDiscrepancy,trim(prm%output(o)), & 'volume discrepancy','m³') @@ -777,17 +748,17 @@ module subroutine mech_RGC_results(instance,group) enddo outputsLoop end associate -end subroutine mech_RGC_results +end subroutine mechanical_RGC_results !-------------------------------------------------------------------------------------------------- !> @brief collect relaxation vectors of an interface !-------------------------------------------------------------------------------------------------- -pure function relaxationVector(intFace,instance,of) +pure function relaxationVector(intFace,ho,me) real(pReal), dimension (3) :: relaxationVector - integer, intent(in) :: instance,of + integer, intent(in) :: ho,me integer, dimension(4), intent(in) :: intFace !< set of interface ID in 4D array (normal and position) integer :: iNum @@ -795,29 +766,35 @@ pure function relaxationVector(intFace,instance,of) !-------------------------------------------------------------------------------------------------- ! collect the interface relaxation vector from the global state array - iNum = interface4to1(intFace,param(instance)%N_constituents) ! identify the position of the interface in global state array + associate (prm => param(ho), & + stt => state(ho)) + + iNum = interface4to1(intFace,prm%N_constituents) ! identify the position of the interface in global state array if (iNum > 0) then - relaxationVector = state(instance)%relaxationVector((3*iNum-2):(3*iNum),of) + relaxationVector = stt%relaxationVector((3*iNum-2):(3*iNum),me) else relaxationVector = 0.0_pReal endif + end associate + end function relaxationVector !-------------------------------------------------------------------------------------------------- !> @brief identify the normal of an interface !-------------------------------------------------------------------------------------------------- -pure function interfaceNormal(intFace,instance,of) +pure function interfaceNormal(intFace,ho,me) real(pReal), dimension(3) :: interfaceNormal integer, dimension(4), intent(in) :: intFace !< interface ID in 4D array (normal and position) integer, intent(in) :: & - instance, & - of + ho, & + me integer :: nPos + associate (dst => dependentState(ho)) !-------------------------------------------------------------------------------------------------- ! get the normal of the interface, identified from the value of intFace(1) @@ -825,7 +802,9 @@ pure function interfaceNormal(intFace,instance,of) nPos = abs(intFace(1)) ! identify the position of the interface in global state array interfaceNormal(nPos) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis - interfaceNormal = matmul(dependentState(instance)%orientation(1:3,1:3,of),interfaceNormal) ! map the normal vector into sample coordinate system (basis) + interfaceNormal = matmul(dst%orientation(1:3,1:3,me),interfaceNormal) ! map the normal vector into sample coordinate system (basis) + + end associate end function interfaceNormal @@ -970,4 +949,4 @@ pure function interface1to4(iFace1D, nGDim) end function interface1to4 -end submodule homogenization_mech_RGC +end submodule RGC diff --git a/src/homogenization_mech_isostrain.f90 b/src/homogenization_mechanical_isostrain.f90 similarity index 77% rename from src/homogenization_mech_isostrain.f90 rename to src/homogenization_mechanical_isostrain.f90 index a56104647..4773e3081 100644 --- a/src/homogenization_mech_isostrain.f90 +++ b/src/homogenization_mechanical_isostrain.f90 @@ -4,7 +4,7 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @brief Isostrain (full constraint Taylor assuption) homogenization scheme !-------------------------------------------------------------------------------------------------- -submodule(homogenization:homogenization_mech) homogenization_mech_isostrain +submodule(homogenization:mechanical) isostrain enum, bind(c); enumerator :: & parallel_ID, & @@ -26,10 +26,9 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all neccessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -module subroutine mech_isostrain_init +module subroutine mechanical_isostrain_init integer :: & - Ninstances, & h, & Nmaterialpoints class(tNode), pointer :: & @@ -37,19 +36,18 @@ module subroutine mech_isostrain_init homog, & homogMech - print'(/,a)', ' <<<+- homogenization_mech_isostrain init -+>>>' + print'(/,a)', ' <<<+- homogenization:mechanical:isostrain init -+>>>' - Ninstances = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - - allocate(param(Ninstances)) ! one container of parameters per instance + print'(a,i2)', ' # instances: ',count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID); flush(IO_STDOUT) material_homogenization => config_material%get('homogenization') + allocate(param(material_homogenization%length)) ! one container of parameters per homog + do h = 1, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_ISOSTRAIN_ID) cycle homog => material_homogenization%get(h) homogMech => homog%get('mechanics') - associate(prm => param(homogenization_typeInstance(h))) + associate(prm => param(h)) prm%N_constituents = homogenization_Nconstituents(h) select case(homogMech%get_asString('mapping',defaultVal = 'sum')) @@ -58,26 +56,25 @@ module subroutine mech_isostrain_init case ('avg') prm%mapping = average_ID case default - call IO_error(211,ext_msg='sum'//' (mech_isostrain)') + call IO_error(211,ext_msg='sum'//' (mechanical_isostrain)') end select Nmaterialpoints = count(material_homogenizationAt == h) homogState(h)%sizeState = 0 allocate(homogState(h)%state0 (0,Nmaterialpoints)) - allocate(homogState(h)%subState0(0,Nmaterialpoints)) allocate(homogState(h)%state (0,Nmaterialpoints)) end associate enddo -end subroutine mech_isostrain_init +end subroutine mechanical_isostrain_init !-------------------------------------------------------------------------------------------------- !> @brief partitions the deformation gradient onto the constituents !-------------------------------------------------------------------------------------------------- -module subroutine mech_isostrain_partitionDeformation(F,avgF) +module subroutine mechanical_isostrain_partitionDeformation(F,avgF) real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient @@ -85,22 +82,22 @@ module subroutine mech_isostrain_partitionDeformation(F,avgF) F = spread(avgF,3,size(F,3)) -end subroutine mech_isostrain_partitionDeformation +end subroutine mechanical_isostrain_partitionDeformation !-------------------------------------------------------------------------------------------------- !> @brief derive average stress and stiffness from constituent quantities !-------------------------------------------------------------------------------------------------- -module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) +module subroutine mechanical_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,ho) real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: instance + integer, intent(in) :: ho - associate(prm => param(instance)) + associate(prm => param(ho)) select case (prm%mapping) case (parallel_ID) @@ -113,6 +110,6 @@ module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dP end associate -end subroutine mech_isostrain_averageStressAndItsTangent +end subroutine mechanical_isostrain_averageStressAndItsTangent -end submodule homogenization_mech_isostrain +end submodule isostrain diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mechanical_pass.f90 similarity index 79% rename from src/homogenization_mech_none.f90 rename to src/homogenization_mechanical_pass.f90 index d434d1ca0..6217e6836 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mechanical_pass.f90 @@ -4,21 +4,21 @@ !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief dummy homogenization homogenization scheme for 1 constituent per material point !-------------------------------------------------------------------------------------------------- -submodule(homogenization:homogenization_mech) homogenization_mech_none +submodule(homogenization:mechanical) none contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -module subroutine mech_none_init +module subroutine mechanical_pass_init integer :: & Ninstances, & h, & Nmaterialpoints - print'(/,a)', ' <<<+- homogenization_mech_none init -+>>>' + print'(/,a)', ' <<<+- homogenization:mechanical:pass init -+>>>' Ninstances = count(homogenization_type == HOMOGENIZATION_NONE_ID) print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) @@ -27,16 +27,15 @@ module subroutine mech_none_init if(homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle if(homogenization_Nconstituents(h) /= 1) & - call IO_error(211,ext_msg='N_constituents (mech_none)') + call IO_error(211,ext_msg='N_constituents (mechanical_pass)') Nmaterialpoints = count(material_homogenizationAt == h) homogState(h)%sizeState = 0 allocate(homogState(h)%state0 (0,Nmaterialpoints)) - allocate(homogState(h)%subState0(0,Nmaterialpoints)) allocate(homogState(h)%state (0,Nmaterialpoints)) enddo -end subroutine mech_none_init +end subroutine mechanical_pass_init -end submodule homogenization_mech_none +end submodule none diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 new file mode 100644 index 000000000..efb6e7b58 --- /dev/null +++ b/src/homogenization_thermal.f90 @@ -0,0 +1,244 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, KU Leuven +!-------------------------------------------------------------------------------------------------- +submodule(homogenization) thermal + + use lattice + + type :: tDataContainer + real(pReal), dimension(:), allocatable :: T, dot_T + end type tDataContainer + + type(tDataContainer), dimension(:), allocatable :: current + + type :: tParameters + character(len=pStringLen), allocatable, dimension(:) :: & + output + end type tParameters + + type(tparameters), dimension(:), allocatable :: & + param + + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief Allocate variables and set parameters. +!-------------------------------------------------------------------------------------------------- +module subroutine thermal_init() + + class(tNode), pointer :: & + configHomogenizations, & + configHomogenization, & + configHomogenizationThermal + integer :: ho + + + print'(/,a)', ' <<<+- homogenization:thermal init -+>>>' + print'(/,a)', ' <<<+- homogenization:thermal:isotemperature init -+>>>' + + + + configHomogenizations => config_material%get('homogenization') + allocate(param(configHomogenizations%length)) + allocate(current(configHomogenizations%length)) + + do ho = 1, configHomogenizations%length + allocate(current(ho)%T(count(material_homogenizationAt2==ho)), source=300.0_pReal) + allocate(current(ho)%dot_T(count(material_homogenizationAt2==ho)), source=0.0_pReal) + configHomogenization => configHomogenizations%get(ho) + associate(prm => param(ho)) + if (configHomogenization%contains('thermal')) then + configHomogenizationThermal => configHomogenization%get('thermal') +#if defined (__GFORTRAN__) + prm%output = output_asStrings(configHomogenizationThermal) +#else + prm%output = configHomogenizationThermal%get_asStrings('output',defaultVal=emptyStringArray) +#endif + else + prm%output = emptyStringArray + endif + end associate + enddo + +end subroutine thermal_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief Partition temperature onto the individual constituents. +!-------------------------------------------------------------------------------------------------- +module subroutine thermal_partition(ce) + + integer, intent(in) :: ce + + real(pReal) :: T, dot_T + integer :: co + + + T = current(material_homogenizationAt2(ce))%T(material_homogenizationMemberAt2(ce)) + dot_T = current(material_homogenizationAt2(ce))%dot_T(material_homogenizationMemberAt2(ce)) + do co = 1, homogenization_Nconstituents(material_homogenizationAt2(ce)) + call phase_thermal_setField(T,dot_T,co,ce) + enddo + +end subroutine thermal_partition + + +!-------------------------------------------------------------------------------------------------- +!> @brief Homogenize temperature rates +!-------------------------------------------------------------------------------------------------- +module subroutine thermal_homogenize(ip,el) + + integer, intent(in) :: ip,el + + !call phase_thermal_getRate(homogenization_dot_T((el-1)*discretization_nIPs+ip), ip,el) + +end subroutine thermal_homogenize + + +!-------------------------------------------------------------------------------------------------- +!> @brief return homogenized thermal conductivity in reference configuration +!-------------------------------------------------------------------------------------------------- +module function thermal_conduction_getConductivity(ce) result(K) + + integer, intent(in) :: ce + real(pReal), dimension(3,3) :: K + + integer :: & + co + + K = 0.0_pReal + + do co = 1, homogenization_Nconstituents(material_homogenizationAt2(ce)) + K = K + crystallite_push33ToRef(co,ce,lattice_K(:,:,material_phaseAt2(co,ce))) + enddo + + K = K / real(homogenization_Nconstituents(material_homogenizationAt2(ce)),pReal) + +end function thermal_conduction_getConductivity + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized specific heat capacity +!-------------------------------------------------------------------------------------------------- +module function thermal_conduction_getSpecificHeat(ce) result(c_P) + + integer, intent(in) :: ce + real(pReal) :: c_P + + integer :: co + + + c_P = 0.0_pReal + + do co = 1, homogenization_Nconstituents(material_homogenizationAt2(ce)) + c_P = c_P + lattice_c_p(material_phaseAt2(co,ce)) + enddo + + c_P = c_P / real(homogenization_Nconstituents(material_homogenizationAt2(ce)),pReal) + +end function thermal_conduction_getSpecificHeat + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns homogenized mass density +!-------------------------------------------------------------------------------------------------- +module function thermal_conduction_getMassDensity(ce) result(rho) + + integer, intent(in) :: ce + real(pReal) :: rho + + integer :: co + + + rho = 0.0_pReal + + do co = 1, homogenization_Nconstituents(material_homogenizationAt2(ce)) + rho = rho + lattice_rho(material_phaseAt2(co,ce)) + enddo + + rho = rho / real(homogenization_Nconstituents(material_homogenizationAt2(ce)),pReal) + +end function thermal_conduction_getMassDensity + + + +!-------------------------------------------------------------------------------------------------- +!> @brief Set thermal field and its rate (T and dot_T) +!-------------------------------------------------------------------------------------------------- +module subroutine homogenization_thermal_setField(T,dot_T, ce) + + integer, intent(in) :: ce + real(pReal), intent(in) :: T, dot_T + + + current(material_homogenizationAt2(ce))%T(material_homogenizationMemberAt2(ce)) = T + current(material_homogenizationAt2(ce))%dot_T(material_homogenizationMemberAt2(ce)) = dot_T + + +end subroutine homogenization_thermal_setField + + + +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +module subroutine thermal_conduction_results(ho,group) + + integer, intent(in) :: ho + character(len=*), intent(in) :: group + + integer :: o + + associate(prm => param(ho)) + outputsLoop: do o = 1,size(prm%output) + select case(trim(prm%output(o))) + case('T') + call results_writeDataset(group,current(ho)%T,'T','temperature','K') + end select + enddo outputsLoop + end associate + +end subroutine thermal_conduction_results + + +module function homogenization_thermal_T(ce) result(T) + + integer, intent(in) :: ce + real(pReal) :: T + + T = current(material_homogenizationAt2(ce))%T(material_homogenizationMemberAt2(ce)) + +end function homogenization_thermal_T + + + +!-------------------------------------------------------------------------------------------------- +!> @brief return heat generation rate +!-------------------------------------------------------------------------------------------------- +module subroutine thermal_conduction_getSource(Tdot, ip, el) + + integer, intent(in) :: & + ip, & + el + real(pReal), intent(out) :: & + Tdot + + integer :: co, ho,ph,me + real(pReal) :: dot_T_temp + + ho = material_homogenizationAt(el) + Tdot = 0.0_pReal + do co = 1, homogenization_Nconstituents(ho) + ph = material_phaseAt(co,el) + me = material_phasememberAt(co,ip,el) + call phase_thermal_getRate(dot_T_temp, ph,me) + Tdot = Tdot + dot_T_temp + enddo + + Tdot = Tdot/real(homogenization_Nconstituents(ho),pReal) + +end subroutine thermal_conduction_getSource + + +end submodule thermal diff --git a/src/lattice.f90 b/src/lattice.f90 index 6af135e4e..e5f5453d4 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -453,12 +453,14 @@ contains !-------------------------------------------------------------------------------------------------- subroutine lattice_init - integer :: Nphases, p,i + integer :: Nphases, ph,i class(tNode), pointer :: & phases, & phase, & mech, & - elasticity + elasticity, & + thermal, & + damage print'(/,a)', ' <<<+- lattice init -+>>>'; flush(IO_STDOUT) @@ -476,67 +478,75 @@ subroutine lattice_init lattice_mu, lattice_nu,& source=[(0.0_pReal,i=1,Nphases)]) - do p = 1, phases%length - phase => phases%get(p) + do ph = 1, phases%length + phase => phases%get(ph) mech => phase%get('mechanics') elasticity => mech%get('elasticity') - lattice_C66(1,1,p) = elasticity%get_asFloat('C_11') - lattice_C66(1,2,p) = elasticity%get_asFloat('C_12') + lattice_C66(1,1,ph) = elasticity%get_asFloat('C_11') + lattice_C66(1,2,ph) = elasticity%get_asFloat('C_12') - lattice_C66(1,3,p) = elasticity%get_asFloat('C_13',defaultVal=0.0_pReal) - lattice_C66(2,2,p) = elasticity%get_asFloat('C_22',defaultVal=0.0_pReal) - lattice_C66(2,3,p) = elasticity%get_asFloat('C_23',defaultVal=0.0_pReal) - lattice_C66(3,3,p) = elasticity%get_asFloat('C_33',defaultVal=0.0_pReal) - lattice_C66(4,4,p) = elasticity%get_asFloat('C_44',defaultVal=0.0_pReal) - lattice_C66(5,5,p) = elasticity%get_asFloat('C_55',defaultVal=0.0_pReal) - lattice_C66(6,6,p) = elasticity%get_asFloat('C_66',defaultVal=0.0_pReal) + lattice_C66(1,3,ph) = elasticity%get_asFloat('C_13',defaultVal=0.0_pReal) + lattice_C66(2,2,ph) = elasticity%get_asFloat('C_22',defaultVal=0.0_pReal) + lattice_C66(2,3,ph) = elasticity%get_asFloat('C_23',defaultVal=0.0_pReal) + lattice_C66(3,3,ph) = elasticity%get_asFloat('C_33',defaultVal=0.0_pReal) + lattice_C66(4,4,ph) = elasticity%get_asFloat('C_44',defaultVal=0.0_pReal) + lattice_C66(5,5,ph) = elasticity%get_asFloat('C_55',defaultVal=0.0_pReal) + lattice_C66(6,6,ph) = elasticity%get_asFloat('C_66',defaultVal=0.0_pReal) select case(phase%get_asString('lattice')) case('cF') - lattice_structure(p) = lattice_FCC_ID + lattice_structure(ph) = lattice_FCC_ID case('cI') - lattice_structure(p) = lattice_BCC_ID + lattice_structure(ph) = lattice_BCC_ID case('hP') - lattice_structure(p) = lattice_HEX_ID + lattice_structure(ph) = lattice_HEX_ID case('tI') - lattice_structure(p) = lattice_BCT_ID + lattice_structure(ph) = lattice_BCT_ID case('oP') - lattice_structure(p) = lattice_ORT_ID + lattice_structure(ph) = lattice_ORT_ID case('aP') - lattice_structure(p) = lattice_ISO_ID + lattice_structure(ph) = lattice_ISO_ID case default call IO_error(130,ext_msg='lattice_init: '//phase%get_asString('lattice')) end select - lattice_C66(1:6,1:6,p) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,p),phase%get_asString('lattice')) + lattice_C66(1:6,1:6,ph) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,ph),phase%get_asString('lattice')) - lattice_nu(p) = lattice_equivalent_nu(lattice_C66(1:6,1:6,p),'voigt') - lattice_mu(p) = lattice_equivalent_mu(lattice_C66(1:6,1:6,p),'voigt') + lattice_nu(ph) = lattice_equivalent_nu(lattice_C66(1:6,1:6,ph),'voigt') + lattice_mu(ph) = lattice_equivalent_mu(lattice_C66(1:6,1:6,ph),'voigt') - lattice_C66(1:6,1:6,p) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,p))) ! Literature data is in Voigt notation + lattice_C66(1:6,1:6,ph) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,ph))) ! Literature data is in Voigt notation do i = 1, 6 - if (abs(lattice_C66(i,i,p)) phase%get('thermal') + lattice_K(1,1,ph) = thermal%get_asFloat('K_11',defaultVal=0.0_pReal) + lattice_K(2,2,ph) = thermal%get_asFloat('K_22',defaultVal=0.0_pReal) + lattice_K(3,3,ph) = thermal%get_asFloat('K_33',defaultVal=0.0_pReal) + lattice_K(1:3,1:3,ph) = lattice_applyLatticeSymmetry33(lattice_K(1:3,1:3,ph), & + phase%get_asString('lattice')) + lattice_c_p(ph) = thermal%get_asFloat('c_p', defaultVal=0.0_pReal) + endif + + + if (phase%contains('damage')) then + damage => phase%get('damage') + damage => damage%get(1) + lattice_D(1,1,ph) = damage%get_asFloat('D_11',defaultVal=0.0_pReal) + lattice_D(2,2,ph) = damage%get_asFloat('D_22',defaultVal=0.0_pReal) + lattice_D(3,3,ph) = damage%get_asFloat('D_33',defaultVal=0.0_pReal) + lattice_D(1:3,1:3,ph) = lattice_applyLatticeSymmetry33(lattice_D(1:3,1:3,ph), & phase%get_asString('lattice')) - lattice_c_p(p) = phase%get_asFloat('c_p', defaultVal=0.0_pReal) - lattice_rho(p) = phase%get_asFloat('rho', defaultVal=0.0_pReal) - - lattice_D(1,1,p) = phase%get_asFloat('D_11',defaultVal=0.0_pReal) - lattice_D(2,2,p) = phase%get_asFloat('D_22',defaultVal=0.0_pReal) - lattice_D(3,3,p) = phase%get_asFloat('D_33',defaultVal=0.0_pReal) - lattice_D(1:3,1:3,p) = lattice_applyLatticeSymmetry33(lattice_D(1:3,1:3,p), & - phase%get_asString('lattice')) - - lattice_M(p) = phase%get_asFloat('M',defaultVal=0.0_pReal) + lattice_M(ph) = damage%get_asFloat('M',defaultVal=0.0_pReal) + endif ! SHOULD NOT BE PART OF LATTICE END call selfTest diff --git a/src/marc/discretization_marc.f90 b/src/marc/discretization_marc.f90 index 675e57bd3..d92623215 100644 --- a/src/marc/discretization_marc.f90 +++ b/src/marc/discretization_marc.f90 @@ -20,6 +20,14 @@ module discretization_marc implicit none private + real(pReal), public, protected :: & + mesh_unitlength !< physical length of one unit in mesh MD: needs systematic_name + + integer, dimension(:), allocatable, public, protected :: & + mesh_FEM2DAMASK_elem, & !< DAMASK element ID for Marc element ID MD: Needs systematic name + mesh_FEM2DAMASK_node !< DAMASK node ID for Marc node ID MD: needs systematic_name + + type tCellNodeDefinition integer, dimension(:,:), allocatable :: parents integer, dimension(:,:), allocatable :: weights @@ -27,15 +35,12 @@ module discretization_marc type(tCellNodeDefinition), dimension(:), allocatable :: cellNodeDefinition - real(pReal), public, protected :: & - mesh_unitlength !< physical length of one unit in mesh - - integer, dimension(:), allocatable, public :: & - mesh_FEM2DAMASK_elem, & !< DAMASK element ID for Marc element ID - mesh_FEM2DAMASK_node !< DAMASK node ID for Marc node ID + integer, dimension(:,:,:), allocatable :: & + connectivity_cell !< cell connectivity for each element,ip/cell public :: & - discretization_marc_init + discretization_marc_init, & + discretization_marc_UpdateNodeAndIpCoords contains @@ -45,25 +50,22 @@ contains !-------------------------------------------------------------------------------------------------- subroutine discretization_marc_init - real(pReal), dimension(:,:), allocatable :: & + real(pReal), dimension(:,:), allocatable :: & node0_elem, & !< node x,y,z coordinates (initially!) node0_cell type(tElement) :: elem - integer, dimension(:), allocatable :: & + integer, dimension(:), allocatable :: & materialAt integer:: & - Nnodes, & !< total number of nodes in the mesh Nelems, & !< total number of elements in the mesh debug_e, debug_i - real(pReal), dimension(:,:), allocatable :: & + real(pReal), dimension(:,:), allocatable :: & IP_reshaped - integer,dimension(:,:,:), allocatable :: & - connectivity_cell !< cell connectivity for each element,ip/cell - integer, dimension(:,:), allocatable :: & + integer, dimension(:,:), allocatable :: & connectivity_elem - real(pReal), dimension(:,:,:,:),allocatable :: & + real(pReal), dimension(:,:,:,:), allocatable :: & unscaledNormals class(tNode), pointer :: & @@ -90,18 +92,14 @@ subroutine discretization_marc_init allocate(cellNodeDefinition(elem%nNodes-1)) allocate(connectivity_cell(elem%NcellNodesPerCell,elem%nIPs,nElems)) + call buildCells(connectivity_cell,cellNodeDefinition,& elem,connectivity_elem) - allocate(node0_cell(3,maxval(connectivity_cell))) - call buildCellNodes(node0_cell,& - cellNodeDefinition,node0_elem) - allocate(IP_reshaped(3,elem%nIPs*nElems),source=0.0_pReal) - call buildIPcoordinates(IP_reshaped,reshape(connectivity_cell,[elem%NcellNodesPerCell,& - elem%nIPs*nElems]),node0_cell) + node0_cell = buildCellNodes(node0_elem) + + IP_reshaped = buildIPcoordinates(node0_cell) - call discretization_init(materialAt,& - IP_reshaped,& - node0_cell) + call discretization_init(materialAt, IP_reshaped, node0_cell) call writeGeometry(elem,connectivity_elem,& reshape(connectivity_cell,[elem%NcellNodesPerCell,elem%nIPs*nElems]),& @@ -109,55 +107,65 @@ subroutine discretization_marc_init !-------------------------------------------------------------------------------------------------- ! geometry information required by the nonlocal CP model - call geometry_plastic_nonlocal_setIPvolume(IPvolume(elem,node0_cell,connectivity_cell)) - unscaledNormals = IPareaNormal(elem,nElems,connectivity_cell,node0_cell) + call geometry_plastic_nonlocal_setIPvolume(IPvolume(elem,node0_cell)) + unscaledNormals = IPareaNormal(elem,nElems,node0_cell) call geometry_plastic_nonlocal_setIParea(norm2(unscaledNormals,1)) call geometry_plastic_nonlocal_setIPareaNormal(unscaledNormals/spread(norm2(unscaledNormals,1),1,3)) - call geometry_plastic_nonlocal_setIPneighborhood(IPneighborhood(elem,connectivity_cell)) + call geometry_plastic_nonlocal_setIPneighborhood(IPneighborhood(elem)) call geometry_plastic_nonlocal_results end subroutine discretization_marc_init +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate and set current nodal and IP positions (including cell nodes) +!-------------------------------------------------------------------------------------------------- +subroutine discretization_marc_UpdateNodeAndIpCoords(d_n) + + real(pReal), dimension(:,:), intent(in) :: d_n + + real(pReal), dimension(:,:), allocatable :: node_cell + + + node_cell = buildCellNodes(discretization_NodeCoords0(1:3,1:maxval(mesh_FEM2DAMASK_node)) + d_n) + + call discretization_setNodeCoords(node_cell) + call discretization_setIPcoords(buildIPcoordinates(node_cell)) + +end subroutine discretization_marc_UpdateNodeAndIpCoords + + !-------------------------------------------------------------------------------------------------- !> @brief Write all information needed for the DADF5 geometry !-------------------------------------------------------------------------------------------------- subroutine writeGeometry(elem, & - connectivity_elem,connectivity_cell, & + connectivity_elem,connectivity_cell_reshaped, & coordinates_nodes,coordinates_points) type(tElement), intent(in) :: & elem integer, dimension(:,:), intent(in) :: & connectivity_elem, & - connectivity_cell + connectivity_cell_reshaped real(pReal), dimension(:,:), intent(in) :: & coordinates_nodes, & coordinates_points - integer, dimension(:,:), allocatable :: & - connectivity_temp - real(pReal), dimension(:,:), allocatable :: & - coordinates_temp call results_openJobFile call results_closeGroup(results_addGroup('geometry')) - connectivity_temp = connectivity_elem - call results_writeDataset('geometry',connectivity_temp,'T_e',& + call results_writeDataset('geometry',connectivity_elem,'T_e',& 'connectivity of the elements','-') - connectivity_temp = connectivity_cell - call results_writeDataset('geometry',connectivity_temp,'T_c', & + call results_writeDataset('geometry',connectivity_cell_reshaped,'T_c', & 'connectivity of the cells','-') call results_addAttribute('VTK_TYPE',elem%vtkType,'geometry/T_c') - coordinates_temp = coordinates_nodes - call results_writeDataset('geometry',coordinates_temp,'x_n', & + call results_writeDataset('geometry',coordinates_nodes,'x_n', & 'initial coordinates of the nodes','m') - coordinates_temp = coordinates_points - call results_writeDataset('geometry',coordinates_temp,'x_p', & + call results_writeDataset('geometry',coordinates_points,'x_p', & 'initial coordinates of the materialpoints (cell centers)','m') call results_closeJobFile @@ -186,13 +194,13 @@ subroutine inputRead(elem,node0_elem,connectivity_elem,materialAt) nElems integer, dimension(:), allocatable :: & matNumber !< material numbers for hypoelastic material - character(len=pStringLen), dimension(:), allocatable :: inputFile !< file content, separated per lines - character(len=pStringLen), dimension(:), allocatable :: & + inputFile, & !< file content, separated per lines nameElemSet integer, dimension(:,:), allocatable :: & mapElemSet !< list of elements in elementSet + inputFile = IO_readlines(trim(getSolverJobName())//trim(InputFileExtension)) call inputRead_fileFormat(fileFormatVersion, & inputFile) @@ -588,20 +596,20 @@ subroutine inputRead_elemType(elem, & mapElemtype = 1 ! Two-dimensional Plane Strain Triangle case ( '125') ! 155, 128 (need test) mapElemtype = 2 ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) - !case ( '11') ! need test - ! mapElemtype = 3 ! Arbitrary Quadrilateral Plane-strain + case ( '11') + mapElemtype = 3 ! Arbitrary Quadrilateral Plane-strain case ( '27') mapElemtype = 4 ! Plane Strain, Eight-node Distorted Quadrilateral case ( '54') mapElemtype = 5 ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration - !case ( '134') ! need test - ! mapElemtype = 6 ! Three-dimensional Four-node Tetrahedron + case ( '134') + mapElemtype = 6 ! Three-dimensional Four-node Tetrahedron !case ( '157') ! need test ! mapElemtype = 7 ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations - !case ( '127') ! need test - ! mapElemtype = 8 ! Three-dimensional Ten-node Tetrahedron - !case ( '136') ! need test - ! mapElemtype = 9 ! Three-dimensional Arbitrarily Distorted Pentahedral + case ( '127') + mapElemtype = 8 ! Three-dimensional Ten-node Tetrahedron + case ( '136') + mapElemtype = 9 ! Three-dimensional Arbitrarily Distorted Pentahedral case ( '117') ! 123 (need test) mapElemtype = 10 ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration case ( '7') @@ -727,11 +735,11 @@ end subroutine inputRead_material !-------------------------------------------------------------------------------------------------- !> @brief Calculates cell node coordinates from element node coordinates !-------------------------------------------------------------------------------------------------- -pure subroutine buildCells(connectivity_cell,cellNodeDefinition, & +pure subroutine buildCells(connectivity,definition, & elem,connectivity_elem) - type(tCellNodeDefinition), dimension(:), intent(out) :: cellNodeDefinition ! definition of cell nodes for increasing number of parents - integer, dimension(:,:,:),intent(out) :: connectivity_cell + type(tCellNodeDefinition), dimension(:), intent(out) :: definition ! definition of cell nodes for increasing number of parents + integer, dimension(:,:,:),intent(out) :: connectivity type(tElement), intent(in) :: elem ! element definition integer, dimension(:,:), intent(in) :: connectivity_elem ! connectivity of the elements @@ -745,7 +753,7 @@ pure subroutine buildCells(connectivity_cell,cellNodeDefinition, & !--------------------------------------------------------------------------------------------------- ! initialize global connectivity to negative local connectivity - connectivity_cell = -spread(elem%cell,3,Nelem) ! local cell node ID + connectivity = -spread(elem%cell,3,Nelem) ! local cell node ID !--------------------------------------------------------------------------------------------------- ! set connectivity of cell nodes that coincide with FE nodes (defined by 1 parent node) @@ -753,9 +761,7 @@ pure subroutine buildCells(connectivity_cell,cellNodeDefinition, & do e = 1, Nelem do c = 1, elem%NcellNodes realNode: if (count(elem%cellNodeParentNodeWeights(:,c) /= 0) == 1) then - where(connectivity_cell(:,:,e) == -c) - connectivity_cell(:,:,e) = connectivity_elem(c,e) - end where + where(connectivity(:,:,e) == -c) connectivity(:,:,e) = connectivity_elem(c,e) endif realNode enddo enddo @@ -821,8 +827,8 @@ pure subroutine buildCells(connectivity_cell,cellNodeDefinition, & enddo i = uniqueRows(candidates_global(1:2*nParentNodes,:)) - allocate(cellNodeDefinition(nParentNodes-1)%parents(i,nParentNodes)) - allocate(cellNodeDefinition(nParentNodes-1)%weights(i,nParentNodes)) + allocate(definition(nParentNodes-1)%parents(i,nParentNodes)) + allocate(definition(nParentNodes-1)%weights(i,nParentNodes)) i = 1 n = 1 @@ -836,15 +842,15 @@ pure subroutine buildCells(connectivity_cell,cellNodeDefinition, & do while (n+j<= size(candidates_local)*Nelem) if (any(candidates_global(1:2*nParentNodes,n+j)/=candidates_global(1:2*nParentNodes,n))) exit - where (connectivity_cell(:,:,candidates_global(nParentNodes*2+1,n+j)) == -candidates_global(nParentNodes*2+2,n+j)) ! still locally defined - connectivity_cell(:,:,candidates_global(nParentNodes*2+1,n+j)) = nCellNode + 1 ! gets current new cell node id + where (connectivity(:,:,candidates_global(nParentNodes*2+1,n+j)) == -candidates_global(nParentNodes*2+2,n+j)) ! still locally defined + connectivity(:,:,candidates_global(nParentNodes*2+1,n+j)) = nCellNode + 1 ! gets current new cell node id end where j = j+1 enddo nCellNode = nCellNode + 1 - cellNodeDefinition(nParentNodes-1)%parents(i,:) = parentsAndWeights(:,1) - cellNodeDefinition(nParentNodes-1)%weights(i,:) = parentsAndWeights(:,2) + definition(nParentNodes-1)%parents(i,:) = parentsAndWeights(:,1) + definition(nParentNodes-1)%weights(i,:) = parentsAndWeights(:,2) i = i + 1 n = n+j enddo @@ -884,55 +890,62 @@ end subroutine buildCells !-------------------------------------------------------------------------------------------------- !> @brief Calculates cell node coordinates from element node coordinates !-------------------------------------------------------------------------------------------------- -pure subroutine buildCellNodes(node_cell, & - definition,node_elem) +pure function buildCellNodes(node_elem) - real(pReal), dimension(:,:), intent(out) :: node_cell !< cell node coordinates - type(tCellNodeDefinition), dimension(:), intent(in) :: definition !< cell node definition (weights and parents) real(pReal), dimension(:,:), intent(in) :: node_elem !< element nodes + real(pReal), dimension(:,:), allocatable :: buildCellNodes !< cell node coordinates integer :: i, j, k, n - n = size(node_elem,2) - node_cell(:,1:n) = node_elem !< initial nodes coincide with element nodes - do i = 1, size(cellNodeDefinition,1) + allocate(buildCellNodes(3,maxval(connectivity_cell))) + n = size(node_elem,2) + buildCellNodes(:,1:n) = node_elem !< initial nodes coincide with element nodes + + do i = 1, size(cellNodeDefinition) do j = 1, size(cellNodeDefinition(i)%parents,1) n = n+1 - node_cell(:,n) = 0.0_pReal + buildCellNodes(:,n) = 0.0_pReal do k = 1, size(cellNodeDefinition(i)%parents,2) - node_cell(:,n) = node_cell(:,n) & - + node_cell(:,definition(i)%parents(j,k)) * real(definition(i)%weights(j,k),pReal) + buildCellNodes(:,n) = buildCellNodes(:,n) & + + buildCellNodes(:,cellNodeDefinition(i)%parents(j,k)) & + * real(cellNodeDefinition(i)%weights(j,k),pReal) enddo - node_cell(:,n) = node_cell(:,n)/real(sum(definition(i)%weights(j,:)),pReal) + buildCellNodes(:,n) = buildCellNodes(:,n)/real(sum(cellNodeDefinition(i)%weights(j,:)),pReal) enddo enddo -end subroutine buildCellNodes +end function buildCellNodes !-------------------------------------------------------------------------------------------------- !> @brief Calculates IP coordinates as center of cell !-------------------------------------------------------------------------------------------------- -pure subroutine buildIPcoordinates(IPcoordinates, & - connectivity_cell,node_cell) +pure function buildIPcoordinates(node_cell) - real(pReal), dimension(:,:), intent(out):: IPcoordinates !< cell-center/IP coordinates - integer, dimension(:,:), intent(in) :: connectivity_cell !< connectivity for each cell - real(pReal), dimension(:,:), intent(in) :: node_cell !< cell node coordinates + real(pReal), dimension(:,:), intent(in) :: node_cell !< cell node coordinates + real(pReal), dimension(:,:), allocatable :: buildIPcoordinates !< cell-center/IP coordinates - integer :: i, n + integer, dimension(:,:), allocatable :: connectivity_cell_reshaped + integer :: i, n, NcellNodesPerCell,Ncells - do i = 1, size(connectivity_cell,2) - IPcoordinates(:,i) = 0.0_pReal - do n = 1, size(connectivity_cell,1) - IPcoordinates(:,i) = IPcoordinates(:,i) & - + node_cell(:,connectivity_cell(n,i)) + + NcellNodesPerCell = size(connectivity_cell,1) + Ncells = size(connectivity_cell,2)*size(connectivity_cell,3) + connectivity_cell_reshaped = reshape(connectivity_cell,[NcellNodesPerCell,Ncells]) + + allocate(buildIPcoordinates(3,Ncells)) + + do i = 1, size(connectivity_cell_reshaped,2) + buildIPcoordinates(:,i) = 0.0_pReal + do n = 1, size(connectivity_cell_reshaped,1) + buildIPcoordinates(:,i) = buildIPcoordinates(:,i) & + + node_cell(:,connectivity_cell_reshaped(n,i)) enddo - IPcoordinates(:,i) = IPcoordinates(:,i)/real(size(connectivity_cell,1),pReal) + buildIPcoordinates(:,i) = buildIPcoordinates(:,i)/real(size(connectivity_cell_reshaped,1),pReal) enddo -end subroutine buildIPcoordinates +end function buildIPcoordinates !--------------------------------------------------------------------------------------------------- @@ -940,50 +953,50 @@ end subroutine buildIPcoordinates !> @details The IP volume is calculated differently depending on the cell type. !> 2D cells assume an element depth of 1.0 !--------------------------------------------------------------------------------------------------- -pure function IPvolume(elem,node,connectivity) +pure function IPvolume(elem,node) type(tElement), intent(in) :: elem real(pReal), dimension(:,:), intent(in) :: node - integer, dimension(:,:,:), intent(in) :: connectivity - real(pReal), dimension(elem%nIPs,size(connectivity,3)) :: IPvolume + real(pReal), dimension(elem%nIPs,size(connectivity_cell,3)) :: IPvolume real(pReal), dimension(3) :: x0,x1,x2,x3,x4,x5,x6,x7 integer :: e,i - do e = 1,size(connectivity,3) + + do e = 1,size(connectivity_cell,3) do i = 1,elem%nIPs select case (elem%cellType) case (1) ! 2D 3node - IPvolume(i,e) = math_areaTriangle(node(1:3,connectivity(1,i,e)), & - node(1:3,connectivity(2,i,e)), & - node(1:3,connectivity(3,i,e))) + IPvolume(i,e) = math_areaTriangle(node(1:3,connectivity_cell(1,i,e)), & + node(1:3,connectivity_cell(2,i,e)), & + node(1:3,connectivity_cell(3,i,e))) case (2) ! 2D 4node - IPvolume(i,e) = math_areaTriangle(node(1:3,connectivity(1,i,e)), & ! assume planar shape, division in two triangles suffices - node(1:3,connectivity(2,i,e)), & - node(1:3,connectivity(3,i,e))) & - + math_areaTriangle(node(1:3,connectivity(3,i,e)), & - node(1:3,connectivity(4,i,e)), & - node(1:3,connectivity(1,i,e))) + IPvolume(i,e) = math_areaTriangle(node(1:3,connectivity_cell(1,i,e)), & ! assume planar shape, division in two triangles suffices + node(1:3,connectivity_cell(2,i,e)), & + node(1:3,connectivity_cell(3,i,e))) & + + math_areaTriangle(node(1:3,connectivity_cell(3,i,e)), & + node(1:3,connectivity_cell(4,i,e)), & + node(1:3,connectivity_cell(1,i,e))) case (3) ! 3D 4node - IPvolume(i,e) = math_volTetrahedron(node(1:3,connectivity(1,i,e)), & - node(1:3,connectivity(2,i,e)), & - node(1:3,connectivity(3,i,e)), & - node(1:3,connectivity(4,i,e))) + IPvolume(i,e) = math_volTetrahedron(node(1:3,connectivity_cell(1,i,e)), & + node(1:3,connectivity_cell(2,i,e)), & + node(1:3,connectivity_cell(3,i,e)), & + node(1:3,connectivity_cell(4,i,e))) case (4) ! 3D 8node ! J. Grandy, Efficient Calculation of Volume of Hexahedral Cells ! Lawrence Livermore National Laboratory ! https://www.osti.gov/servlets/purl/632793 - x0 = node(1:3,connectivity(1,i,e)) - x1 = node(1:3,connectivity(2,i,e)) - x2 = node(1:3,connectivity(4,i,e)) - x3 = node(1:3,connectivity(3,i,e)) - x4 = node(1:3,connectivity(5,i,e)) - x5 = node(1:3,connectivity(6,i,e)) - x6 = node(1:3,connectivity(8,i,e)) - x7 = node(1:3,connectivity(7,i,e)) + x0 = node(1:3,connectivity_cell(1,i,e)) + x1 = node(1:3,connectivity_cell(2,i,e)) + x2 = node(1:3,connectivity_cell(4,i,e)) + x3 = node(1:3,connectivity_cell(3,i,e)) + x4 = node(1:3,connectivity_cell(5,i,e)) + x5 = node(1:3,connectivity_cell(6,i,e)) + x6 = node(1:3,connectivity_cell(8,i,e)) + x7 = node(1:3,connectivity_cell(7,i,e)) IPvolume(i,e) = dot_product((x7-x1)+(x6-x0),math_cross((x7-x2), (x3-x0))) & + dot_product((x6-x0), math_cross((x7-x2)+(x5-x0),(x7-x4))) & + dot_product((x7-x1), math_cross((x5-x0), (x7-x4)+(x3-x0))) @@ -998,11 +1011,10 @@ end function IPvolume !-------------------------------------------------------------------------------------------------- !> @brief calculation of IP interface areas !-------------------------------------------------------------------------------------------------- -pure function IPareaNormal(elem,nElem,connectivity,node) +pure function IPareaNormal(elem,nElem,node) type(tElement), intent(in) :: elem integer, intent(in) :: nElem - integer, dimension(:,:,:), intent(in) :: connectivity real(pReal), dimension(:,:), intent(in) :: node real(pReal), dimension(3,elem%nIPneighbors,elem%nIPs,nElem) :: ipAreaNormal @@ -1015,7 +1027,7 @@ pure function IPareaNormal(elem,nElem,connectivity,node) do e = 1,nElem do i = 1,elem%nIPs do f = 1,elem%nIPneighbors - nodePos = node(1:3,connectivity(elem%cellface(1:m,f),i,e)) + nodePos = node(1:3,connectivity_cell(elem%cellface(1:m,f),i,e)) select case (elem%cellType) case (1,2) ! 2D 3 or 4 node @@ -1046,23 +1058,22 @@ end function IPareaNormal !-------------------------------------------------------------------------------------------------- !> @brief IP neighborhood !-------------------------------------------------------------------------------------------------- -function IPneighborhood(elem,connectivity) +function IPneighborhood(elem) type(tElement), intent(in) :: elem ! definition of the element in use - integer, dimension(:,:,:), intent(in) :: connectivity ! cell connectivity integer, dimension(3,size(elem%cellFace,2), & - size(connectivity,2),size(connectivity,3)) :: IPneighborhood ! neighboring IPs as [element ID, IP ID, face ID] + size(connectivity_cell,2),size(connectivity_cell,3)) :: IPneighborhood ! neighboring IPs as [element ID, IP ID, face ID] integer, dimension(size(elem%cellFace,1)+3,& - size(elem%cellFace,2)*size(connectivity,2)*size(connectivity,3)) :: face - integer, dimension(size(connectivity,1)) :: myConnectivity - integer, dimension(size(elem%cellFace,1)) :: face_unordered + size(elem%cellFace,2)*size(connectivity_cell,2)*size(connectivity_cell,3)) :: face + integer, dimension(size(connectivity_cell,1)) :: myConnectivity + integer, dimension(size(elem%cellFace,1)) :: face_unordered integer :: e,i,f,n,c,s c = 0 - do e = 1, size(connectivity,3) - do i = 1, size(connectivity,2) - myConnectivity = connectivity(:,i,e) + do e = 1, size(connectivity_cell,3) + do i = 1, size(connectivity_cell,2) + myConnectivity = connectivity_cell(:,i,e) do f = 1, size(elem%cellFace,2) c = c + 1 face_unordered = myConnectivity(elem%cellFace(:,f)) diff --git a/src/material.f90 b/src/material.f90 index 581182d22..aecfaa1dd 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -6,107 +6,58 @@ !-------------------------------------------------------------------------------------------------- module material use prec - use math use config use results use IO use rotations use discretization + use YAML_types implicit none private - enum, bind(c); enumerator :: & - THERMAL_ISOTHERMAL_ID, & - THERMAL_CONDUCTION_ID, & - DAMAGE_NONE_ID, & - DAMAGE_NONLOCAL_ID, & - HOMOGENIZATION_UNDEFINED_ID, & - HOMOGENIZATION_NONE_ID, & - HOMOGENIZATION_ISOSTRAIN_ID, & - HOMOGENIZATION_RGC_ID - end enum + integer, dimension(:), allocatable, public, protected :: & + homogenization_Nconstituents !< number of grains in each homogenization character(len=:), public, protected, allocatable, dimension(:) :: & material_name_phase, & !< name of each phase material_name_homogenization !< name of each homogenization - integer(kind(THERMAL_isothermal_ID)), dimension(:), allocatable, public, protected :: & - thermal_type !< thermal transport model - integer(kind(DAMAGE_none_ID)), dimension(:), allocatable, public, protected :: & - damage_type !< nonlocal damage model - integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: & - homogenization_type !< type of each homogenization - integer, public, protected :: & homogenization_maxNconstituents !< max number of grains in any USED homogenization - integer, dimension(:), allocatable, public, protected :: & - homogenization_Nconstituents, & !< number of grains in each homogenization - homogenization_typeInstance, & !< instance of particular type of each homogenization - thermal_typeInstance, & !< instance of particular type of each thermal transport - damage_typeInstance !< instance of particular type of each nonlocal damage - - real(pReal), dimension(:), allocatable, public, protected :: & - thermal_initialT !< initial temperature per each homogenization - integer, dimension(:), allocatable, public, protected :: & ! (elem) - material_homogenizationAt !< homogenization ID of each element - integer, dimension(:,:), allocatable, public, protected :: & ! (ip,elem) + material_homogenizationAt, & !< homogenization ID of each element + material_homogenizationAt2, & !< per cell + material_homogenizationMemberAt2 !< cell + integer, dimension(:,:), allocatable :: & ! (ip,elem) material_homogenizationMemberAt !< position of the element within its homogenization instance integer, dimension(:,:), allocatable, public, protected :: & ! (constituent,elem) - material_phaseAt !< phase ID of each element + material_phaseAt, & !< phase ID of each element + material_phaseAt2, & !< per constituent,cell + material_phaseMemberAt2 !< per constituent, cell integer, dimension(:,:,:), allocatable, public, protected :: & ! (constituent,IP,elem) material_phaseMemberAt !< position of the element within its phase instance - type(tState), allocatable, dimension(:), public :: & - homogState, & - damageState - - type(Rotation), dimension(:,:,:), allocatable, public, protected :: & - material_orientation0 !< initial orientation of each grain,IP,element - - type(group_float), allocatable, dimension(:), public :: & - temperature, & !< temperature field - damage, & !< damage field - temperatureRate !< temperature change rate field - public :: & - material_init, & - THERMAL_ISOTHERMAL_ID, & - THERMAL_CONDUCTION_ID, & - DAMAGE_NONE_ID, & - DAMAGE_NONLOCAL_ID, & - HOMOGENIZATION_NONE_ID, & - HOMOGENIZATION_ISOSTRAIN_ID, & - HOMOGENIZATION_RGC_ID + material_init contains !-------------------------------------------------------------------------------------------------- -!> @brief parses material configuration file +!> @brief Parse material configuration file (material.yaml). !-------------------------------------------------------------------------------------------------- subroutine material_init(restart) logical, intent(in) :: restart + print'(/,a)', ' <<<+- material init -+>>>'; flush(IO_STDOUT) call material_parseMaterial print*, 'Material parsed' - call material_parseHomogenization - print*, 'Homogenization parsed' - - - allocate(homogState (size(material_name_homogenization))) - allocate(damageState (size(material_name_homogenization))) - - allocate(temperature (size(material_name_homogenization))) - allocate(damage (size(material_name_homogenization))) - allocate(temperatureRate (size(material_name_homogenization))) - if (.not. restart) then call results_openJobFile @@ -118,82 +69,6 @@ subroutine material_init(restart) end subroutine material_init -!-------------------------------------------------------------------------------------------------- -!> @brief parses the homogenization part from the material configuration -! ToDo: This should be done in homogenization -!-------------------------------------------------------------------------------------------------- -subroutine material_parseHomogenization - - class(tNode), pointer :: & - material_homogenization, & - homog, & - homogMech, & - homogThermal, & - homogDamage - - integer :: h - - material_homogenization => config_material%get('homogenization') - - allocate(homogenization_type(size(material_name_homogenization)), source=HOMOGENIZATION_undefined_ID) - allocate(thermal_type(size(material_name_homogenization)), source=THERMAL_isothermal_ID) - allocate(damage_type (size(material_name_homogenization)), source=DAMAGE_none_ID) - allocate(homogenization_typeInstance(size(material_name_homogenization)), source=0) - allocate(thermal_typeInstance(size(material_name_homogenization)), source=0) - allocate(damage_typeInstance(size(material_name_homogenization)), source=0) - allocate(thermal_initialT(size(material_name_homogenization)), source=300.0_pReal) - - do h=1, size(material_name_homogenization) - homog => material_homogenization%get(h) - homogMech => homog%get('mechanics') - select case (homogMech%get_asString('type')) - case('none') - homogenization_type(h) = HOMOGENIZATION_NONE_ID - case('isostrain') - homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID - case('RGC') - homogenization_type(h) = HOMOGENIZATION_RGC_ID - case default - call IO_error(500,ext_msg=homogMech%get_asString('type')) - end select - - homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h)) - - if(homog%contains('thermal')) then - homogThermal => homog%get('thermal') - thermal_initialT(h) = homogThermal%get_asFloat('T_0',defaultVal=300.0_pReal) - - select case (homogThermal%get_asString('type')) - case('isothermal') - thermal_type(h) = THERMAL_isothermal_ID - case('conduction') - thermal_type(h) = THERMAL_conduction_ID - case default - call IO_error(500,ext_msg=homogThermal%get_asString('type')) - end select - endif - - if(homog%contains('damage')) then - homogDamage => homog%get('damage') - select case (homogDamage%get_asString('type')) - case('none') - damage_type(h) = DAMAGE_none_ID - case('nonlocal') - damage_type(h) = DAMAGE_nonlocal_ID - case default - call IO_error(500,ext_msg=homogDamage%get_asString('type')) - end select - endif - enddo - - do h=1, size(material_name_homogenization) - homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h)) - thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h)) - damage_typeInstance(h) = count(damage_type (1:h) == damage_type (h)) - enddo - -end subroutine material_parseHomogenization - !-------------------------------------------------------------------------------------------------- !> @brief parses the material part in the material configuration file @@ -215,8 +90,8 @@ subroutine material_parseMaterial real(pReal) :: & frac integer :: & - e, i, c, & - h + el, ip, co, & + h, ce materials => config_material%get('material') phases => config_material%get('phase') @@ -241,29 +116,38 @@ subroutine material_parseMaterial allocate(material_phaseAt(homogenization_maxNconstituents,discretization_Nelems),source=0) allocate(material_phaseMemberAt(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems),source=0) - allocate(material_orientation0(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems)) - do e = 1, discretization_Nelems - material => materials%get(discretization_materialAt(e)) + allocate(material_homogenizationAt2(discretization_nIPs*discretization_Nelems),source=0) + allocate(material_homogenizationMemberAt2(discretization_nIPs*discretization_Nelems),source=0) + allocate(material_phaseAt2(homogenization_maxNconstituents,discretization_nIPs*discretization_Nelems),source=0) + allocate(material_phaseMemberAt2(homogenization_maxNconstituents,discretization_nIPs*discretization_Nelems),source=0) + + do el = 1, discretization_Nelems + material => materials%get(discretization_materialAt(el)) constituents => material%get('constituents') - material_homogenizationAt(e) = homogenizations%getIndex(material%get_asString('homogenization')) - do i = 1, discretization_nIPs - counterHomogenization(material_homogenizationAt(e)) = counterHomogenization(material_homogenizationAt(e)) + 1 - material_homogenizationMemberAt(i,e) = counterHomogenization(material_homogenizationAt(e)) + material_homogenizationAt(el) = homogenizations%getIndex(material%get_asString('homogenization')) + do ip = 1, discretization_nIPs + ce = (el-1)*discretization_nIPs + ip + counterHomogenization(material_homogenizationAt(el)) = counterHomogenization(material_homogenizationAt(el)) + 1 + material_homogenizationMemberAt(ip,el) = counterHomogenization(material_homogenizationAt(el)) + material_homogenizationAt2(ce) = material_homogenizationAt(el) + material_homogenizationMemberAt2(ce) = material_homogenizationMemberAt(ip,el) enddo frac = 0.0_pReal - do c = 1, constituents%length - constituent => constituents%get(c) - frac = frac + constituent%get_asFloat('fraction') + do co = 1, constituents%length + constituent => constituents%get(co) + frac = frac + constituent%get_asFloat('v') - material_phaseAt(c,e) = phases%getIndex(constituent%get_asString('phase')) - do i = 1, discretization_nIPs - counterPhase(material_phaseAt(c,e)) = counterPhase(material_phaseAt(c,e)) + 1 - material_phaseMemberAt(c,i,e) = counterPhase(material_phaseAt(c,e)) + material_phaseAt(co,el) = phases%getIndex(constituent%get_asString('phase')) + do ip = 1, discretization_nIPs + ce = (el-1)*discretization_nIPs + ip + counterPhase(material_phaseAt(co,el)) = counterPhase(material_phaseAt(co,el)) + 1 + material_phaseMemberAt(co,ip,el) = counterPhase(material_phaseAt(co,el)) - call material_orientation0(c,i,e)%fromQuaternion(constituent%get_asFloats('O',requiredSize=4)) ! should be done in crystallite + material_phaseAt2(co,ce) = material_phaseAt(co,el) + material_phaseMemberAt2(co,ce) = material_phaseMemberAt(co,ip,el) enddo enddo diff --git a/src/math.f90 b/src/math.f90 index 6b89a9923..6ef942677 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -1133,6 +1133,7 @@ real(pReal) pure function math_areaTriangle(v1,v2,v3) real(pReal), dimension (3), intent(in) :: v1,v2,v3 + math_areaTriangle = 0.5_pReal * norm2(math_cross(v1-v2,v1-v3)) end function math_areaTriangle @@ -1147,11 +1148,13 @@ real(pReal) pure elemental function math_clip(a, left, right) real(pReal), intent(in) :: a real(pReal), intent(in), optional :: left, right + math_clip = a if (present(left)) math_clip = max(left,math_clip) if (present(right)) math_clip = min(right,math_clip) - if (present(left) .and. present(right)) & - math_clip = merge (IEEE_value(1.0_pReal,IEEE_quiet_NaN),math_clip, left>right) + if (present(left) .and. present(right)) then + if(left>right) error stop 'left > right' + endif end function math_clip @@ -1182,6 +1185,7 @@ subroutine selfTest integer :: d logical :: e + if (any(abs([1.0_pReal,2.0_pReal,2.0_pReal,3.0_pReal,3.0_pReal,3.0_pReal] - & math_expand([1.0_pReal,2.0_pReal,3.0_pReal],[1,2,3,0])) > tol_math_check)) & error stop 'math_expand [1,2,3] by [1,2,3,0] => [1,2,2,3,3,3]' diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90 index 7369520c1..5ef0f7a36 100644 --- a/src/mesh/DAMASK_mesh.f90 +++ b/src/mesh/DAMASK_mesh.f90 @@ -18,7 +18,7 @@ program DAMASK_mesh use config use discretization_mesh use FEM_Utilities - use mesh_mech_FEM + use mesh_mechanical_FEM implicit none @@ -242,7 +242,7 @@ program DAMASK_mesh do field = 1, nActiveFields select case (loadCases(1)%fieldBC(field)%ID) case(FIELD_MECH_ID) - call FEM_mech_init(loadCases(1)%fieldBC(field)) + call FEM_mechanical_init(loadCases(1)%fieldBC(field)) end select enddo @@ -306,7 +306,7 @@ program DAMASK_mesh do field = 1, nActiveFields select case (loadCases(currentLoadCase)%fieldBC(field)%ID) case(FIELD_MECH_ID) - call FEM_mech_forward (& + call FEM_mechanical_forward (& guess,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field)) end select @@ -320,7 +320,7 @@ program DAMASK_mesh do field = 1, nActiveFields select case (loadCases(currentLoadCase)%fieldBC(field)%ID) case(FIELD_MECH_ID) - solres(field) = FEM_mech_solution (& + solres(field) = FEM_mechanical_solution (& incInfo,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field)) end select diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 2f3633e11..4b3be8a42 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -127,12 +127,12 @@ subroutine FEM_utilities_init CHKERRQ(ierr) if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr) CHKERRQ(ierr) - call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mech_snes_type newtonls & - &-mech_snes_linesearch_type cp -mech_snes_ksp_ew & - &-mech_snes_ksp_ew_rtol0 0.01 -mech_snes_ksp_ew_rtolmax 0.01 & - &-mech_ksp_type fgmres -mech_ksp_max_it 25 & - &-mech_pc_type ml -mech_mg_levels_ksp_type chebyshev & - &-mech_mg_levels_pc_type sor -mech_pc_ml_nullspace user',ierr) + call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type newtonls & + &-mechanical_snes_linesearch_type cp -mechanical_snes_ksp_ew & + &-mechanical_snes_ksp_ew_rtol0 0.01 -mechanical_snes_ksp_ew_rtolmax 0.01 & + &-mechanical_ksp_type fgmres -mechanical_ksp_max_it 25 & + &-mechanical_pc_type ml -mechanical_mg_levels_ksp_type chebyshev & + &-mechanical_mg_levels_pc_type sor -mechanical_pc_ml_nullspace user',ierr) CHKERRQ(ierr) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_mesh%get_asString('petsc_options',defaultVal=''),ierr) CHKERRQ(ierr) diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index 21c5feace..4d8546b6a 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -83,6 +83,7 @@ subroutine discretization_mesh_init(restart) num_mesh integer :: integrationOrder !< order of quadrature rule required + print'(/,a)', ' <<<+- discretization_mesh init -+>>>' !-------------------------------------------------------------------------------- @@ -95,13 +96,15 @@ subroutine discretization_mesh_init(restart) debug_element = config_debug%get_asInt('element',defaultVal=1) debug_ip = config_debug%get_asInt('integrationpoint',defaultVal=1) - call DMPlexCreateFromFile(PETSC_COMM_WORLD,interface_geomFile,PETSC_TRUE,globalMesh,ierr) CHKERRQ(ierr) call DMGetDimension(globalMesh,dimPlex,ierr) CHKERRQ(ierr) call DMGetStratumSize(globalMesh,'depth',dimPlex,mesh_NcpElemsGlobal,ierr) CHKERRQ(ierr) + call DMView(globalMesh, PETSC_VIEWER_STDOUT_WORLD,ierr) + CHKERRQ(ierr) + ! get number of IDs in face sets (for boundary conditions?) call DMGetLabelSize(globalMesh,'Face Sets',mesh_Nboundaries,ierr) CHKERRQ(ierr) @@ -109,6 +112,13 @@ subroutine discretization_mesh_init(restart) call MPI_Bcast(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) call MPI_Bcast(dimPlex,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + if (worldrank == 0) then + call DMClone(globalMesh,geomMesh,ierr) + else + call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr) + endif + CHKERRQ(ierr) + allocate(mesh_boundaries(mesh_Nboundaries), source = 0) call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr) CHKERRQ(ierr) @@ -123,35 +133,6 @@ subroutine discretization_mesh_init(restart) endif call MPI_Bcast(mesh_boundaries,mesh_Nboundaries,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) - if (worldrank == 0) then - fileContent = IO_readlines(interface_geomFile) - l = 0 - do - l = l + 1 - if (IO_isBlank(fileContent(l))) cycle ! need also to ignore C and C++ style comments? - if (trim(fileContent(l)) == '$Elements') then - j = 0 - l = l + 1 - do - l = l + 1 - if (trim(fileContent(l)) == '$EndElements') exit - chunkPos = IO_stringPos(fileContent(l)) - if (chunkPos(1) == 3+IO_intValue(fileContent(l),chunkPos,3)+dimPlex+1) then - call DMSetLabelValue(globalMesh,'material',j,IO_intValue(fileContent(l),chunkPos,4),ierr) - CHKERRQ(ierr) - j = j + 1 - endif - enddo - exit - endif - enddo - call DMClone(globalMesh,geomMesh,ierr) - CHKERRQ(ierr) - else - call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr) - CHKERRQ(ierr) - endif - call DMDestroy(globalMesh,ierr); CHKERRQ(ierr) call DMGetStratumSize(geomMesh,'depth',dimPlex,mesh_NcpElems,ierr) @@ -166,9 +147,10 @@ subroutine discretization_mesh_init(restart) allocate(materialAt(mesh_NcpElems)) do j = 1, mesh_NcpElems - call DMGetLabelValue(geomMesh,'material',j-1,materialAt(j),ierr) + call DMGetLabelValue(geomMesh,'Cell Sets',j-1,materialAt(j),ierr) CHKERRQ(ierr) end do + materialAt = materialAt + 1 if (debug_element < 1 .or. debug_element > mesh_NcpElems) call IO_error(602,ext_msg='element') if (debug_ip < 1 .or. debug_ip > mesh_maxNips) call IO_error(602,ext_msg='IP') diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index e19c35998..c811d842b 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -4,7 +4,7 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @brief FEM PETSc solver !-------------------------------------------------------------------------------------------------- -module mesh_mech_FEM +module mesh_mechanical_FEM #include #include #include @@ -50,7 +50,7 @@ module mesh_mech_FEM type(tNumerics), private :: num !-------------------------------------------------------------------------------------------------- ! PETSc data - SNES :: mech_snes + SNES :: mechanical_snes Vec :: solution, solution_rate, solution_local PetscInt :: dimPlex, cellDof, nQuadrature, nBasis PetscReal, allocatable, target :: qPoints(:), qWeights(:) @@ -65,20 +65,20 @@ module mesh_mech_FEM real(pReal), parameter :: eps = 1.0e-18_pReal public :: & - FEM_mech_init, & - FEM_mech_solution, & - FEM_mech_forward + FEM_mechanical_init, & + FEM_mechanical_solution, & + FEM_mechanical_forward contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all neccessary fields and fills them with data !-------------------------------------------------------------------------------------------------- -subroutine FEM_mech_init(fieldBC) +subroutine FEM_mechanical_init(fieldBC) type(tFieldBC), intent(in) :: fieldBC - DM :: mech_mesh + DM :: mechanical_mesh PetscFE :: mechFE PetscQuadrature :: mechQuad, functional PetscDS :: mechDS @@ -126,8 +126,8 @@ subroutine FEM_mech_init(fieldBC) !-------------------------------------------------------------------------------------------------- ! Setup FEM mech mesh - call DMClone(geomMesh,mech_mesh,ierr); CHKERRQ(ierr) - call DMGetDimension(mech_mesh,dimPlex,ierr); CHKERRQ(ierr) + call DMClone(geomMesh,mechanical_mesh,ierr); CHKERRQ(ierr) + call DMGetDimension(mechanical_mesh,dimPlex,ierr); CHKERRQ(ierr) !-------------------------------------------------------------------------------------------------- ! Setup FEM mech discretization @@ -146,22 +146,22 @@ subroutine FEM_mech_init(fieldBC) call PetscFESetQuadrature(mechFE,mechQuad,ierr); CHKERRQ(ierr) call PetscFEGetDimension(mechFE,nBasis,ierr); CHKERRQ(ierr) nBasis = nBasis/nc - call DMAddField(mech_mesh,PETSC_NULL_DMLABEL,mechFE,ierr); CHKERRQ(ierr) - call DMCreateDS(mech_mesh,ierr); CHKERRQ(ierr) - call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr) + call DMAddField(mechanical_mesh,PETSC_NULL_DMLABEL,mechFE,ierr); CHKERRQ(ierr) + call DMCreateDS(mechanical_mesh,ierr); CHKERRQ(ierr) + call DMGetDS(mechanical_mesh,mechDS,ierr); CHKERRQ(ierr) call PetscDSGetTotalDimension(mechDS,cellDof,ierr); CHKERRQ(ierr) call PetscFEDestroy(mechFE,ierr); CHKERRQ(ierr) call PetscQuadratureDestroy(mechQuad,ierr); CHKERRQ(ierr) !-------------------------------------------------------------------------------------------------- ! Setup FEM mech boundary conditions - call DMGetLabel(mech_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr) - call DMPlexLabelComplete(mech_mesh,BCLabel,ierr); CHKERRQ(ierr) - call DMGetLocalSection(mech_mesh,section,ierr); CHKERRQ(ierr) + call DMGetLabel(mechanical_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr) + call DMPlexLabelComplete(mechanical_mesh,BCLabel,ierr); CHKERRQ(ierr) + call DMGetLocalSection(mechanical_mesh,section,ierr); CHKERRQ(ierr) allocate(pnumComp(1), source=dimPlex) allocate(pnumDof(0:dimPlex), source = 0) do topologDim = 0, dimPlex - call DMPlexGetDepthStratum(mech_mesh,topologDim,cellStart,cellEnd,ierr) + call DMPlexGetDepthStratum(mechanical_mesh,topologDim,cellStart,cellEnd,ierr) CHKERRQ(ierr) call PetscSectionGetDof(section,cellStart,pnumDof(topologDim),ierr) CHKERRQ(ierr) @@ -179,10 +179,10 @@ subroutine FEM_mech_init(fieldBC) numBC = numBC + 1 call ISCreateGeneral(PETSC_COMM_WORLD,1,[field-1],PETSC_COPY_VALUES,pbcComps(numBC),ierr) CHKERRQ(ierr) - call DMGetStratumSize(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcSize,ierr) + call DMGetStratumSize(mechanical_mesh,'Face Sets',mesh_boundaries(faceSet),bcSize,ierr) CHKERRQ(ierr) if (bcSize > 0) then - call DMGetStratumIS(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcPoint,ierr) + call DMGetStratumIS(mechanical_mesh,'Face Sets',mesh_boundaries(faceSet),bcPoint,ierr) CHKERRQ(ierr) call ISGetIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr) call ISCreateGeneral(PETSC_COMM_WORLD,bcSize,pBcPoint,PETSC_COPY_VALUES,pbcPoints(numBC),ierr) @@ -195,32 +195,32 @@ subroutine FEM_mech_init(fieldBC) endif endif enddo; enddo - call DMPlexCreateSection(mech_mesh,nolabel,pNumComp,pNumDof, & + call DMPlexCreateSection(mechanical_mesh,nolabel,pNumComp,pNumDof, & numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS,section,ierr) CHKERRQ(ierr) - call DMSetSection(mech_mesh,section,ierr); CHKERRQ(ierr) + call DMSetSection(mechanical_mesh,section,ierr); CHKERRQ(ierr) do faceSet = 1, numBC call ISDestroy(pbcPoints(faceSet),ierr); CHKERRQ(ierr) enddo !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc - call SNESCreate(PETSC_COMM_WORLD,mech_snes,ierr);CHKERRQ(ierr) - call SNESSetOptionsPrefix(mech_snes,'mech_',ierr);CHKERRQ(ierr) - call SNESSetDM(mech_snes,mech_mesh,ierr); CHKERRQ(ierr) !< set the mesh for non-linear solver - call DMCreateGlobalVector(mech_mesh,solution ,ierr); CHKERRQ(ierr) !< locally owned displacement Dofs - call DMCreateGlobalVector(mech_mesh,solution_rate ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step - call DMCreateLocalVector (mech_mesh,solution_local ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step - call DMSNESSetFunctionLocal(mech_mesh,FEM_mech_formResidual,PETSC_NULL_VEC,ierr) !< function to evaluate residual forces + call SNESCreate(PETSC_COMM_WORLD,mechanical_snes,ierr);CHKERRQ(ierr) + call SNESSetOptionsPrefix(mechanical_snes,'mechanical_',ierr);CHKERRQ(ierr) + call SNESSetDM(mechanical_snes,mechanical_mesh,ierr); CHKERRQ(ierr) !< set the mesh for non-linear solver + call DMCreateGlobalVector(mechanical_mesh,solution ,ierr); CHKERRQ(ierr) !< locally owned displacement Dofs + call DMCreateGlobalVector(mechanical_mesh,solution_rate ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step + call DMCreateLocalVector (mechanical_mesh,solution_local ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step + call DMSNESSetFunctionLocal(mechanical_mesh,FEM_mechanical_formResidual,PETSC_NULL_VEC,ierr) !< function to evaluate residual forces CHKERRQ(ierr) - call DMSNESSetJacobianLocal(mech_mesh,FEM_mech_formJacobian,PETSC_NULL_VEC,ierr) !< function to evaluate stiffness matrix + call DMSNESSetJacobianLocal(mechanical_mesh,FEM_mechanical_formJacobian,PETSC_NULL_VEC,ierr) !< function to evaluate stiffness matrix CHKERRQ(ierr) - call SNESSetMaxLinearSolveFailures(mech_snes, huge(1), ierr); CHKERRQ(ierr) !< ignore linear solve failures - call SNESSetConvergenceTest(mech_snes,FEM_mech_converged,PETSC_NULL_VEC,PETSC_NULL_FUNCTION,ierr) + call SNESSetMaxLinearSolveFailures(mechanical_snes, huge(1), ierr); CHKERRQ(ierr) !< ignore linear solve failures + call SNESSetConvergenceTest(mechanical_snes,FEM_mechanical_converged,PETSC_NULL_VEC,PETSC_NULL_FUNCTION,ierr) CHKERRQ(ierr) - call SNESSetTolerances(mech_snes,1.0,0.0,0.0,num%itmax,num%itmax,ierr) + call SNESSetTolerances(mechanical_snes,1.0,0.0,0.0,num%itmax,num%itmax,ierr) CHKERRQ(ierr) - call SNESSetFromOptions(mech_snes,ierr); CHKERRQ(ierr) + call SNESSetFromOptions(mechanical_snes,ierr); CHKERRQ(ierr) !-------------------------------------------------------------------------------------------------- ! init fields @@ -236,11 +236,11 @@ subroutine FEM_mech_init(fieldBC) call PetscDSGetDiscretization(mechDS,0,mechFE,ierr) CHKERRQ(ierr) call PetscFEGetDualSpace(mechFE,mechDualSpace,ierr); CHKERRQ(ierr) - call DMPlexGetHeightStratum(mech_mesh,0,cellStart,cellEnd,ierr) + call DMPlexGetHeightStratum(mechanical_mesh,0,cellStart,cellEnd,ierr) CHKERRQ(ierr) do cell = cellStart, cellEnd-1 !< loop over all elements x_scal = 0.0_pReal - call DMPlexComputeCellGeometryAffineFEM(mech_mesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + call DMPlexComputeCellGeometryAffineFEM(mechanical_mesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) CHKERRQ(ierr) cellJMat = reshape(pCellJ,shape=[dimPlex,dimPlex]) do basis = 0, nBasis*dimPlex-1, dimPlex @@ -251,17 +251,17 @@ subroutine FEM_mech_init(fieldBC) x_scal(basis+1:basis+dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0_pReal) enddo px_scal => x_scal - call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,5,ierr) + call DMPlexVecSetClosure(mechanical_mesh,section,solution_local,cell,px_scal,5,ierr) CHKERRQ(ierr) enddo -end subroutine FEM_mech_init +end subroutine FEM_mechanical_init !-------------------------------------------------------------------------------------------------- !> @brief solution for the FEM load step !-------------------------------------------------------------------------------------------------- -type(tSolutionState) function FEM_mech_solution( & +type(tSolutionState) function FEM_mechanical_solution( & incInfoIn,timeinc,timeinc_old,fieldBC) !-------------------------------------------------------------------------------------------------- @@ -278,35 +278,35 @@ type(tSolutionState) function FEM_mech_solution( & SNESConvergedReason :: reason incInfo = incInfoIn - FEM_mech_solution%converged =.false. + FEM_mechanical_solution%converged =.false. !-------------------------------------------------------------------------------------------------- ! set module wide availabe data params%timeinc = timeinc params%fieldBC = fieldBC - call SNESSolve(mech_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) ! solve mech_snes based on solution guess (result in solution) - call SNESGetConvergedReason(mech_snes,reason,ierr); CHKERRQ(ierr) ! solution converged? + call SNESSolve(mechanical_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) ! solve mechanical_snes based on solution guess (result in solution) + call SNESGetConvergedReason(mechanical_snes,reason,ierr); CHKERRQ(ierr) ! solution converged? terminallyIll = .false. if (reason < 1) then ! 0: still iterating (will not occur), negative -> convergence error - FEM_mech_solution%converged = .false. - FEM_mech_solution%iterationsNeeded = num%itmax + FEM_mechanical_solution%converged = .false. + FEM_mechanical_solution%iterationsNeeded = num%itmax else ! >= 1 proper convergence (or terminally ill) - FEM_mech_solution%converged = .true. - call SNESGetIterationNumber(mech_snes,FEM_mech_solution%iterationsNeeded,ierr) + FEM_mechanical_solution%converged = .true. + call SNESGetIterationNumber(mechanical_snes,FEM_mechanical_solution%iterationsNeeded,ierr) CHKERRQ(ierr) endif print'(/,a)', ' ===========================================================================' flush(IO_STDOUT) -end function FEM_mech_solution +end function FEM_mechanical_solution !-------------------------------------------------------------------------------------------------- !> @brief forms the FEM residual vector !-------------------------------------------------------------------------------------------------- -subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) +subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,ierr) DM :: dm_local PetscObject,intent(in) :: dummy @@ -431,13 +431,13 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) enddo call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) -end subroutine FEM_mech_formResidual +end subroutine FEM_mechanical_formResidual !-------------------------------------------------------------------------------------------------- !> @brief forms the FEM stiffness matrix !-------------------------------------------------------------------------------------------------- -subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) +subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) DM :: dm_local @@ -575,13 +575,13 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) call MatSetNearNullSpace(Jac,matnull,ierr); CHKERRQ(ierr) call MatNullSpaceDestroy(matnull,ierr); CHKERRQ(ierr) -end subroutine FEM_mech_formJacobian +end subroutine FEM_mechanical_formJacobian !-------------------------------------------------------------------------------------------------- !> @brief forwarding routine !-------------------------------------------------------------------------------------------------- -subroutine FEM_mech_forward(guess,timeinc,timeinc_old,fieldBC) +subroutine FEM_mechanical_forward(guess,timeinc,timeinc_old,fieldBC) type(tFieldBC), intent(in) :: & fieldBC @@ -603,7 +603,7 @@ subroutine FEM_mech_forward(guess,timeinc,timeinc_old,fieldBC) if (guess .and. .not. cutBack) then ForwardData = .True. homogenization_F0 = homogenization_F - call SNESGetDM(mech_snes,dm_local,ierr); CHKERRQ(ierr) !< retrieve mesh info from mech_snes into dm_local + call SNESGetDM(mechanical_snes,dm_local,ierr); CHKERRQ(ierr) !< retrieve mesh info from mechanical_snes into dm_local call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr) call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) call VecSet(x_local,0.0_pReal,ierr); CHKERRQ(ierr) @@ -634,13 +634,13 @@ subroutine FEM_mech_forward(guess,timeinc,timeinc_old,fieldBC) call VecCopy(solution_rate,solution,ierr); CHKERRQ(ierr) call VecScale(solution,timeinc,ierr); CHKERRQ(ierr) -end subroutine FEM_mech_forward +end subroutine FEM_mechanical_forward !-------------------------------------------------------------------------------------------------- !> @brief reporting !-------------------------------------------------------------------------------------------------- -subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr) +subroutine FEM_mechanical_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr) SNES :: snes_local PetscInt :: PETScIter @@ -662,6 +662,6 @@ subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dumm ' Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pReal flush(IO_STDOUT) -end subroutine FEM_mech_converged +end subroutine FEM_mechanical_converged -end module mesh_mech_FEM +end module mesh_mechanical_FEM diff --git a/src/parallelization.f90 b/src/parallelization.f90 index 11a3574ec..8413ba825 100644 --- a/src/parallelization.f90 +++ b/src/parallelization.f90 @@ -9,9 +9,8 @@ module parallelization #ifdef PETSc #include use petscsys -#endif !$ use OMP_LIB - +#endif use prec implicit none @@ -21,6 +20,7 @@ module parallelization worldrank = 0, & !< MPI worldrank (/=0 for MPI simulations only) worldsize = 1 !< MPI worldsize (/=1 for MPI simulations only) +#ifdef PETSc public :: & parallelization_init @@ -32,16 +32,12 @@ contains subroutine parallelization_init integer :: err, typeSize -!$ integer :: got_env, DAMASK_NUM_THREADS, threadLevel +!$ integer :: got_env, threadLevel +!$ integer(pI32) :: OMP_NUM_THREADS !$ character(len=6) NumThreadsString -#ifdef PETSc + + PetscErrorCode :: petsc_err - -#else - print'(/,a)', ' <<<+- parallelization init -+>>>'; flush(OUTPUT_UNIT) -#endif - -#ifdef PETSc #ifdef _OPENMP ! If openMP is enabled, check if the MPI libary supports it and initialize accordingly. ! Otherwise, the first call to PETSc will do the initialization. @@ -64,7 +60,7 @@ subroutine parallelization_init #endif CHKERRQ(petsc_err) -call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,err) + call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,err) if (err /= 0) error stop 'Could not determine worldrank' if (worldrank == 0) print'(/,a)', ' <<<+- parallelization init -+>>>' @@ -80,27 +76,27 @@ call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,err) call MPI_Type_size(MPI_DOUBLE,typeSize,err) if (err /= 0) error stop 'Could not determine MPI real size' if (typeSize*8 /= storage_size(0.0_pReal)) error stop 'Mismatch between MPI and DAMASK real' -#endif if (worldrank /= 0) then close(OUTPUT_UNIT) ! disable output open(OUTPUT_UNIT,file='/dev/null',status='replace') ! close() alone will leave some temp files in cwd endif -!$ call get_environment_variable(name='DAMASK_NUM_THREADS',value=NumThreadsString,STATUS=got_env) +!$ call get_environment_variable(name='OMP_NUM_THREADS',value=NumThreadsString,STATUS=got_env) !$ if(got_env /= 0) then -!$ print*, 'Could not determine value of $DAMASK_NUM_THREADS' -!$ DAMASK_NUM_THREADS = 1_pI32 +!$ print*, 'Could not determine value of $OMP_NUM_THREADS' +!$ OMP_NUM_THREADS = 1_pI32 !$ else -!$ read(NumThreadsString,'(i6)') DAMASK_NUM_THREADS -!$ if (DAMASK_NUM_THREADS < 1_pI32) then -!$ print*, 'Invalid DAMASK_NUM_THREADS: '//trim(NumThreadsString) -!$ DAMASK_NUM_THREADS = 1_pI32 +!$ read(NumThreadsString,'(i6)') OMP_NUM_THREADS +!$ if (OMP_NUM_THREADS < 1_pI32) then +!$ print*, 'Invalid OMP_NUM_THREADS: '//trim(NumThreadsString) +!$ OMP_NUM_THREADS = 1_pI32 !$ endif !$ endif -!$ print'(a,i2)', ' DAMASK_NUM_THREADS: ',DAMASK_NUM_THREADS -!$ call omp_set_num_threads(DAMASK_NUM_THREADS) +!$ print'(a,i2)', ' OMP_NUM_THREADS: ',OMP_NUM_THREADS +!$ call omp_set_num_threads(OMP_NUM_THREADS) end subroutine parallelization_init +#endif end module parallelization diff --git a/src/phase.f90 b/src/phase.f90 new file mode 100644 index 000000000..add26ae0b --- /dev/null +++ b/src/phase.f90 @@ -0,0 +1,724 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief elasticity, plasticity, damage & thermal internal microstructure state +!-------------------------------------------------------------------------------------------------- +module phase + use prec + use math + use rotations + use IO + use config + use material + use results + use lattice + use discretization + use parallelization + use HDF5_utilities + + implicit none + private + + type(Rotation), dimension(:,:,:), allocatable :: & + material_orientation0 !< initial orientation of each grain,IP,element + + type(rotation), dimension(:,:,:), allocatable :: & + crystallite_orientation !< current orientation + + type :: tTensorContainer + real(pReal), dimension(:,:,:), allocatable :: data + end type + + type :: tNumerics + integer :: & + iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp + nState, & !< state loop limit + nStress !< stress loop limit + real(pReal) :: & + subStepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback + subStepSizeCryst, & !< size of first substep when cutback + subStepSizeLp, & !< size of first substep when cutback in Lp calculation + subStepSizeLi, & !< size of first substep when cutback in Li calculation + stepIncreaseCryst, & !< increase of next substep size when previous substep converged + rtol_crystalliteState, & !< relative tolerance in state loop + rtol_crystalliteStress, & !< relative tolerance in stress loop + atol_crystalliteStress !< absolute tolerance in stress loop + end type tNumerics + + type(tNumerics) :: num ! numerics parameters. Better name? + + type :: tDebugOptions + logical :: & + basic, & + extensive, & + selective + integer :: & + element, & + ip, & + grain + end type tDebugOptions + + type(tDebugOptions) :: debugCrystallite + + integer, dimension(:), allocatable, public :: & !< ToDo: should be protected (bug in Intel compiler) + phase_elasticityInstance, & + phase_NstiffnessDegradations + + logical, dimension(:), allocatable, public :: & ! ToDo: should be protected (bug in Intel Compiler) + phase_localPlasticity !< flags phases with local constitutive law + + type(tPlasticState), allocatable, dimension(:), public :: & + plasticState + type(tState), allocatable, dimension(:), public :: & + damageState + + + integer, public, protected :: & + phase_plasticity_maxSizeDotState, & + phase_source_maxSizeDotState + + interface + +! == cleaned:begin ================================================================================= + module subroutine mechanical_init(materials,phases) + class(tNode), pointer :: materials,phases + end subroutine mechanical_init + + module subroutine damage_init + end subroutine damage_init + + module subroutine thermal_init(phases) + class(tNode), pointer :: phases + end subroutine thermal_init + + + module subroutine mechanical_results(group,ph) + character(len=*), intent(in) :: group + integer, intent(in) :: ph + end subroutine mechanical_results + + module subroutine damage_results(group,ph) + character(len=*), intent(in) :: group + integer, intent(in) :: ph + end subroutine damage_results + + module subroutine mechanical_windForward(ph,me) + integer, intent(in) :: ph, me + end subroutine mechanical_windForward + + + module subroutine mechanical_forward() + end subroutine mechanical_forward + + module subroutine thermal_forward() + end subroutine thermal_forward + + + module subroutine mechanical_restore(ce,includeL) + integer, intent(in) :: ce + logical, intent(in) :: includeL + end subroutine mechanical_restore + + + module function phase_mechanical_dPdF(dt,co,ce) result(dPdF) + real(pReal), intent(in) :: dt + integer, intent(in) :: & + co, & !< counter in constituent loop + ce + real(pReal), dimension(3,3,3,3) :: dPdF + end function phase_mechanical_dPdF + + module subroutine mechanical_restartWrite(groupHandle,ph) + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + end subroutine mechanical_restartWrite + + module subroutine mechanical_restartRead(groupHandle,ph) + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + end subroutine mechanical_restartRead + + + module function mechanical_S(ph,me) result(S) + integer, intent(in) :: ph,me + real(pReal), dimension(3,3) :: S + end function mechanical_S + + module function mechanical_L_p(ph,me) result(L_p) + integer, intent(in) :: ph,me + real(pReal), dimension(3,3) :: L_p + end function mechanical_L_p + + module function phase_mechanical_getF(co,ce) result(F) + integer, intent(in) :: co, ce + real(pReal), dimension(3,3) :: F + end function phase_mechanical_getF + + module function mechanical_F_e(ph,me) result(F_e) + integer, intent(in) :: ph,me + real(pReal), dimension(3,3) :: F_e + end function mechanical_F_e + + module function phase_mechanical_getP(co,ce) result(P) + integer, intent(in) :: co, ce + real(pReal), dimension(3,3) :: P + end function phase_mechanical_getP + + module function phase_damage_get_phi(co,ip,el) result(phi) + integer, intent(in) :: co, ip, el + real(pReal) :: phi + end function phase_damage_get_phi + + module function thermal_T(ph,me) result(T) + integer, intent(in) :: ph,me + real(pReal) :: T + end function thermal_T + + module function thermal_dot_T(ph,me) result(dot_T) + integer, intent(in) :: ph,me + real(pReal) :: dot_T + end function thermal_dot_T + + module function damage_phi(ph,me) result(phi) + integer, intent(in) :: ph,me + real(pReal) :: phi + end function damage_phi + + + module subroutine phase_mechanical_setF(F,co,ce) + real(pReal), dimension(3,3), intent(in) :: F + integer, intent(in) :: co, ce + end subroutine phase_mechanical_setF + + module subroutine phase_thermal_setField(T,dot_T, co,ce) + real(pReal), intent(in) :: T, dot_T + integer, intent(in) :: ce, co + end subroutine phase_thermal_setField + + module subroutine phase_damage_set_phi(phi,co,ce) + real(pReal), intent(in) :: phi + integer, intent(in) :: co, ce + end subroutine phase_damage_set_phi + +! == cleaned:end =================================================================================== + + module function thermal_stress(Delta_t,ph,me) result(converged_) + + real(pReal), intent(in) :: Delta_t + integer, intent(in) :: ph, me + logical :: converged_ + + end function thermal_stress + + module function integrateDamageState(dt,co,ip,el) result(broken) + real(pReal), intent(in) :: dt + integer, intent(in) :: & + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop + logical :: broken + end function integrateDamageState + + module function crystallite_stress(dt,co,ip,el) result(converged_) + real(pReal), intent(in) :: dt + integer, intent(in) :: co, ip, el + logical :: converged_ + end function crystallite_stress + + module function phase_homogenizedC(ph,me) result(C) + integer, intent(in) :: ph, me + real(pReal), dimension(6,6) :: C + end function phase_homogenizedC + + + module subroutine phase_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi, phi, ce) + integer, intent(in) :: ce + real(pReal), intent(in) :: & + phi !< damage parameter + real(pReal), intent(inout) :: & + phiDot, & + dPhiDot_dPhi + end subroutine phase_damage_getRateAndItsTangents + + module subroutine phase_thermal_getRate(TDot, ph,me) + integer, intent(in) :: ph, me + real(pReal), intent(out) :: & + TDot + end subroutine phase_thermal_getRate + + module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,i,e) + integer, intent(in) :: & + ph, & + i, & + e + type(rotation), dimension(1,discretization_nIPs,discretization_Nelems), intent(in) :: & + orientation !< crystal orientation + end subroutine plastic_nonlocal_updateCompatibility + + module subroutine plastic_dependentState(co,ip,el) + integer, intent(in) :: & + co, & !< component-ID of integration point + ip, & !< integration point + el !< element + end subroutine plastic_dependentState + + + module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ph,me) + integer, intent(in) :: ph, me + real(pReal), intent(in), dimension(3,3) :: & + S + real(pReal), intent(out), dimension(3,3) :: & + Ld !< damage velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) + end subroutine kinematics_cleavage_opening_LiAndItsTangent + + module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ph,me) + integer, intent(in) :: ph, me + real(pReal), intent(in), dimension(3,3) :: & + S + real(pReal), intent(out), dimension(3,3) :: & + Ld !< damage velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) + end subroutine kinematics_slipplane_opening_LiAndItsTangent + + end interface + + + + type(tDebugOptions) :: debugConstitutive +#if __INTEL_COMPILER >= 1900 + public :: & + prec, & + math, & + rotations, & + IO, & + config, & + material, & + results, & + lattice, & + discretization, & + HDF5_utilities +#endif + + public :: & + phase_init, & + phase_homogenizedC, & + phase_damage_getRateAndItsTangents, & + phase_thermal_getRate, & + phase_results, & + phase_allocateState, & + phase_forward, & + phase_restore, & + plastic_nonlocal_updateCompatibility, & + converged, & + crystallite_init, & + crystallite_stress, & + thermal_stress, & + phase_mechanical_dPdF, & + crystallite_orientations, & + crystallite_push33ToRef, & + phase_restartWrite, & + phase_restartRead, & + integrateDamageState, & + phase_thermal_setField, & + phase_damage_set_phi, & + phase_damage_get_phi, & + phase_mechanical_getP, & + phase_mechanical_setF, & + phase_mechanical_getF, & + phase_windForward + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief Initialze constitutive models for individual physics +!-------------------------------------------------------------------------------------------------- +subroutine phase_init + + integer :: & + ph, & !< counter in phase loop + so !< counter in source loop + class (tNode), pointer :: & + debug_constitutive, & + materials, & + phases + + + print'(/,a)', ' <<<+- phase init -+>>>'; flush(IO_STDOUT) + + debug_constitutive => config_debug%get('constitutive', defaultVal=emptyList) + debugConstitutive%basic = debug_constitutive%contains('basic') + debugConstitutive%extensive = debug_constitutive%contains('extensive') + debugConstitutive%selective = debug_constitutive%contains('selective') + debugConstitutive%element = config_debug%get_asInt('element',defaultVal = 1) + debugConstitutive%ip = config_debug%get_asInt('integrationpoint',defaultVal = 1) + debugConstitutive%grain = config_debug%get_asInt('grain',defaultVal = 1) + + + materials => config_material%get('material') + phases => config_material%get('phase') + + call mechanical_init(materials,phases) + call damage_init + call thermal_init(phases) + + + phase_source_maxSizeDotState = 0 + PhaseLoop2:do ph = 1,phases%length +!-------------------------------------------------------------------------------------------------- +! partition and initialize state + plasticState(ph)%state = plasticState(ph)%state0 + if(damageState(ph)%sizeState > 0) & + damageState(ph)%state = damageState(ph)%state0 + enddo PhaseLoop2 + + phase_source_maxSizeDotState = maxval(damageState%sizeDotState) + phase_plasticity_maxSizeDotState = maxval(plasticState%sizeDotState) + +end subroutine phase_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief Allocate the components of the state structure for a given phase +!-------------------------------------------------------------------------------------------------- +subroutine phase_allocateState(state, & + Nconstituents,sizeState,sizeDotState,sizeDeltaState) + + class(tState), intent(out) :: & + state + integer, intent(in) :: & + Nconstituents, & + sizeState, & + sizeDotState, & + sizeDeltaState + + + state%sizeState = sizeState + state%sizeDotState = sizeDotState + state%sizeDeltaState = sizeDeltaState + state%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition + + allocate(state%atol (sizeState), source=0.0_pReal) + allocate(state%state0 (sizeState,Nconstituents), source=0.0_pReal) + allocate(state%state (sizeState,Nconstituents), source=0.0_pReal) + + allocate(state%dotState (sizeDotState,Nconstituents), source=0.0_pReal) + + allocate(state%deltaState (sizeDeltaState,Nconstituents), source=0.0_pReal) + + +end subroutine phase_allocateState + + +!-------------------------------------------------------------------------------------------------- +!> @brief Restore data after homog cutback. +!-------------------------------------------------------------------------------------------------- +subroutine phase_restore(ce,includeL) + + logical, intent(in) :: includeL + integer, intent(in) :: ce + + integer :: & + co + + + do co = 1,homogenization_Nconstituents(material_homogenizationAt2(ce)) + if (damageState(material_phaseAt2(co,ce))%sizeState > 0) & + damageState(material_phaseAt2(co,ce))%state( :,material_phasememberAt2(co,ce)) = & + damageState(material_phaseAt2(co,ce))%state0(:,material_phasememberAt2(co,ce)) + enddo + + call mechanical_restore(ce,includeL) + +end subroutine phase_restore + + +!-------------------------------------------------------------------------------------------------- +!> @brief Forward data after successful increment. +! ToDo: Any guessing for the current states possible? +!-------------------------------------------------------------------------------------------------- +subroutine phase_forward() + + integer :: ph + + + call mechanical_forward() + call thermal_forward() + + do ph = 1, size(damageState) + if (damageState(ph)%sizeState > 0) & + damageState(ph)%state0 = damageState(ph)%state + enddo + +end subroutine phase_forward + + +!-------------------------------------------------------------------------------------------------- +!> @brief writes constitutive results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine phase_results() + + integer :: ph + character(len=:), allocatable :: group + + + call results_closeGroup(results_addGroup('/current/phase/')) + + do ph = 1, size(material_name_phase) + + group = '/current/phase/'//trim(material_name_phase(ph))//'/' + call results_closeGroup(results_addGroup(group)) + + call mechanical_results(group,ph) + call damage_results(group,ph) + + enddo + +end subroutine phase_results + + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates and initialize per grain variables +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_init() + + integer :: & + ph, & + me, & + co, & !< counter in integration point component loop + ip, & !< counter in integration point loop + el, & !< counter in element loop + so, & + cMax, & !< maximum number of integration point components + iMax, & !< maximum number of integration points + eMax !< maximum number of elements + + class(tNode), pointer :: & + num_crystallite, & + debug_crystallite, & ! pointer to debug options for crystallite + phases + + + print'(/,a)', ' <<<+- crystallite init -+>>>' + + debug_crystallite => config_debug%get('crystallite', defaultVal=emptyList) + debugCrystallite%extensive = debug_crystallite%contains('extensive') + + cMax = homogenization_maxNconstituents + iMax = discretization_nIPs + eMax = discretization_Nelems + + allocate(crystallite_orientation(cMax,iMax,eMax)) + + num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) + + num%subStepMinCryst = num_crystallite%get_asFloat ('subStepMin', defaultVal=1.0e-3_pReal) + num%subStepSizeCryst = num_crystallite%get_asFloat ('subStepSize', defaultVal=0.25_pReal) + num%stepIncreaseCryst = num_crystallite%get_asFloat ('stepIncrease', defaultVal=1.5_pReal) + num%subStepSizeLp = num_crystallite%get_asFloat ('subStepSizeLp', defaultVal=0.5_pReal) + num%subStepSizeLi = num_crystallite%get_asFloat ('subStepSizeLi', defaultVal=0.5_pReal) + num%rtol_crystalliteState = num_crystallite%get_asFloat ('rtol_State', defaultVal=1.0e-6_pReal) + num%rtol_crystalliteStress = num_crystallite%get_asFloat ('rtol_Stress', defaultVal=1.0e-6_pReal) + num%atol_crystalliteStress = num_crystallite%get_asFloat ('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) + + if(num%subStepMinCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinCryst') + if(num%subStepSizeCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeCryst') + if(num%stepIncreaseCryst <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseCryst') + + if(num%subStepSizeLp <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLp') + if(num%subStepSizeLi <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLi') + + if(num%rtol_crystalliteState <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteState') + if(num%rtol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteStress') + if(num%atol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='atol_crystalliteStress') + + if(num%iJacoLpresiduum < 1) call IO_error(301,ext_msg='iJacoLpresiduum') + + if(num%nState < 1) call IO_error(301,ext_msg='nState') + if(num%nStress< 1) call IO_error(301,ext_msg='nStress') + + + phases => config_material%get('phase') + + do ph = 1, phases%length + if (damageState(ph)%sizeState > 0) & + allocate(damageState(ph)%subState0,source=damageState(ph)%state0) ! ToDo: hack + enddo + + print'(a42,1x,i10)', ' # of elements: ', eMax + print'(a42,1x,i10)', ' # of integration points/element: ', iMax + print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax + flush(IO_STDOUT) + + + !$OMP PARALLEL DO PRIVATE(ph,me) + do el = 1, size(material_phaseMemberAt,3) + do ip = 1, size(material_phaseMemberAt,2) + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + call crystallite_orientations(co,ip,el) + call plastic_dependentState(co,ip,el) ! update dependent state variables to be consistent with basic states + enddo + enddo + enddo + !$OMP END PARALLEL DO + + +end subroutine crystallite_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief Wind homog inc forward. +!-------------------------------------------------------------------------------------------------- +subroutine phase_windForward(ip,el) + + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + + integer :: & + co, & !< constituent number + so, ph, me + + + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + call mechanical_windForward(ph,me) + + if(damageState(ph)%sizeState > 0) damageState(ph)%state0(:,me) = damageState(ph)%state(:,me) + + + enddo + +end subroutine phase_windForward + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates orientations +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_orientations(co,ip,el) + + integer, intent(in) :: & + co, & !< counter in integration point component loop + ip, & !< counter in integration point loop + el !< counter in element loop + + + call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(& + mechanical_F_e(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el))))) + + if (plasticState(material_phaseAt(1,el))%nonlocal) & + call plastic_nonlocal_updateCompatibility(crystallite_orientation, & + material_phaseAt(1,el),ip,el) + + +end subroutine crystallite_orientations + + +!-------------------------------------------------------------------------------------------------- +!> @brief Map 2nd order tensor to reference config +!-------------------------------------------------------------------------------------------------- +function crystallite_push33ToRef(co,ce, tensor33) + + real(pReal), dimension(3,3), intent(in) :: tensor33 + integer, intent(in):: & + co, & + ce + real(pReal), dimension(3,3) :: crystallite_push33ToRef + + real(pReal), dimension(3,3) :: T + integer :: ph, me + + ph = material_phaseAt2(co,ce) + me = material_phaseMemberAt2(co,ce) + T = matmul(material_orientation0(co,ph,me)%asMatrix(),transpose(math_inv33(phase_mechanical_getF(co,ce)))) ! ToDo: initial orientation correct? + + crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) + +end function crystallite_push33ToRef + + +!-------------------------------------------------------------------------------------------------- +!> @brief determines whether a point is converged +!-------------------------------------------------------------------------------------------------- +logical pure function converged(residuum,state,atol) + + real(pReal), intent(in), dimension(:) ::& + residuum, state, atol + real(pReal) :: & + rTol + + rTol = num%rTol_crystalliteState + + converged = all(abs(residuum) <= max(atol, rtol*abs(state))) + +end function converged + + +!-------------------------------------------------------------------------------------------------- +!> @brief Write current restart information (Field and constitutive data) to file. +! ToDo: Merge data into one file for MPI +!-------------------------------------------------------------------------------------------------- +subroutine phase_restartWrite(fileHandle) + + integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle + integer :: ph + + + groupHandle(1) = HDF5_addGroup(fileHandle,'phase') + + do ph = 1, size(material_name_phase) + + groupHandle(2) = HDF5_addGroup(groupHandle(1),material_name_phase(ph)) + + call mechanical_restartWrite(groupHandle(2),ph) + + call HDF5_closeGroup(groupHandle(2)) + + enddo + + call HDF5_closeGroup(groupHandle(1)) + +end subroutine phase_restartWrite + + +!-------------------------------------------------------------------------------------------------- +!> @brief Read data for restart +! ToDo: Merge data into one file for MPI +!-------------------------------------------------------------------------------------------------- +subroutine phase_restartRead(fileHandle) + + integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle + integer :: ph + + + groupHandle(1) = HDF5_openGroup(fileHandle,'phase') + + do ph = 1, size(material_name_phase) + + groupHandle(2) = HDF5_openGroup(groupHandle(1),material_name_phase(ph)) + + call mechanical_restartRead(groupHandle(2),ph) + + call HDF5_closeGroup(groupHandle(2)) + + enddo + + call HDF5_closeGroup(groupHandle(1)) + +end subroutine phase_restartRead + + +end module phase diff --git a/src/phase_damage.f90 b/src/phase_damage.f90 new file mode 100644 index 000000000..c85075288 --- /dev/null +++ b/src/phase_damage.f90 @@ -0,0 +1,506 @@ +!---------------------------------------------------------------------------------------------------- +!> @brief internal microstructure state for all damage sources and kinematics constitutive models +!---------------------------------------------------------------------------------------------------- +submodule(phase) damagee + enum, bind(c); enumerator :: & + DAMAGE_UNDEFINED_ID, & + DAMAGE_ISOBRITTLE_ID, & + DAMAGE_ISODUCTILE_ID, & + DAMAGE_ANISOBRITTLE_ID, & + DAMAGE_ANISODUCTILE_ID + end enum + + + type :: tDataContainer + real(pReal), dimension(:), allocatable :: phi, d_phi_d_dot_phi + end type tDataContainer + + integer(kind(DAMAGE_UNDEFINED_ID)), dimension(:), allocatable :: & + phase_source !< active sources mechanisms of each phase + + integer, dimension(:), allocatable :: & + phase_Nsources + + type(tDataContainer), dimension(:), allocatable :: current + + interface + + module function anisobrittle_init() result(mySources) + logical, dimension(:), allocatable :: mySources + end function anisobrittle_init + + module function anisoductile_init() result(mySources) + logical, dimension(:), allocatable :: mySources + end function anisoductile_init + + module function isobrittle_init() result(mySources) + logical, dimension(:), allocatable :: mySources + end function isobrittle_init + + module function isoductile_init() result(mySources) + logical, dimension(:), allocatable :: mySources + end function isoductile_init + + + module subroutine isobrittle_deltaState(C, Fe, ph, me) + integer, intent(in) :: ph,me + real(pReal), intent(in), dimension(3,3) :: & + Fe + real(pReal), intent(in), dimension(6,6) :: & + C + end subroutine isobrittle_deltaState + + + module subroutine anisobrittle_dotState(S, ph, me) + integer, intent(in) :: ph,me + real(pReal), intent(in), dimension(3,3) :: & + S + end subroutine anisobrittle_dotState + + module subroutine anisoductile_dotState(ph,me) + integer, intent(in) :: ph,me + end subroutine anisoductile_dotState + + module subroutine isoductile_dotState(ph,me) + integer, intent(in) :: ph,me + end subroutine isoductile_dotState + + + module subroutine anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ph, me) + integer, intent(in) :: ph,me + real(pReal), intent(in) :: & + phi !< damage parameter + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + end subroutine anisobrittle_getRateAndItsTangent + + module subroutine anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ph,me) + integer, intent(in) :: ph,me + real(pReal), intent(in) :: & + phi !< damage parameter + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + end subroutine anisoductile_getRateAndItsTangent + + module subroutine isobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ph,me) + integer, intent(in) :: ph,me + real(pReal), intent(in) :: & + phi !< damage parameter + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + end subroutine isobrittle_getRateAndItsTangent + + module subroutine isoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ph,me) + integer, intent(in) :: ph,me + real(pReal), intent(in) :: & + phi !< damage parameter + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + end subroutine isoductile_getRateAndItsTangent + + module subroutine anisobrittle_results(phase,group) + integer, intent(in) :: phase + character(len=*), intent(in) :: group + end subroutine anisobrittle_results + + module subroutine anisoductile_results(phase,group) + integer, intent(in) :: phase + character(len=*), intent(in) :: group + end subroutine anisoductile_results + + module subroutine isobrittle_results(phase,group) + integer, intent(in) :: phase + character(len=*), intent(in) :: group + end subroutine isobrittle_results + + module subroutine isoductile_results(phase,group) + integer, intent(in) :: phase + character(len=*), intent(in) :: group + end subroutine isoductile_results + + end interface + +contains + +!---------------------------------------------------------------------------------------------- +!< @brief initialize damage sources and kinematics mechanism +!---------------------------------------------------------------------------------------------- +module subroutine damage_init + + integer :: & + ph, & !< counter in phase loop + Nmembers + class(tNode), pointer :: & + phases, & + phase, & + sources + + + print'(/,a)', ' <<<+- phase:damage init -+>>>' + + phases => config_material%get('phase') + + allocate(current(phases%length)) + + allocate(damageState (phases%length)) + allocate(phase_Nsources(phases%length),source = 0) + + do ph = 1,phases%length + + Nmembers = count(material_phaseAt2 == ph) + + allocate(current(ph)%phi(Nmembers),source=1.0_pReal) + allocate(current(ph)%d_phi_d_dot_phi(Nmembers),source=0.0_pReal) + + phase => phases%get(ph) + sources => phase%get('damage',defaultVal=emptyList) + if (sources%length > 1) error stop + phase_Nsources(ph) = sources%length + + enddo + + allocate(phase_source(phases%length), source = DAMAGE_UNDEFINED_ID) + +! initialize source mechanisms + if(maxval(phase_Nsources) /= 0) then + where(isobrittle_init() ) phase_source = DAMAGE_ISOBRITTLE_ID + where(isoductile_init() ) phase_source = DAMAGE_ISODUCTILE_ID + where(anisobrittle_init()) phase_source = DAMAGE_ANISOBRITTLE_ID + where(anisoductile_init()) phase_source = DAMAGE_ANISODUCTILE_ID + endif + +end subroutine damage_init + + +!---------------------------------------------------------------------------------------------- +!< @brief returns local part of nonlocal damage driving force +!---------------------------------------------------------------------------------------------- +module subroutine phase_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi, phi, ce) + + integer, intent(in) :: ce + real(pReal), intent(in) :: & + phi !< damage parameter + real(pReal), intent(inout) :: & + phiDot, & + dPhiDot_dPhi + + real(pReal) :: & + localphiDot, & + dLocalphiDot_dPhi + integer :: & + ph, & + co, & + me + + phiDot = 0.0_pReal + dPhiDot_dPhi = 0.0_pReal + + do co = 1, homogenization_Nconstituents(material_homogenizationAt2(ce)) + ph = material_phaseAt2(co,ce) + me = material_phasememberAt2(co,ce) + + select case(phase_source(ph)) + case (DAMAGE_ISOBRITTLE_ID) + call isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, ph, me) + + case (DAMAGE_ISODUCTILE_ID) + call isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, ph, me) + + case (DAMAGE_ANISOBRITTLE_ID) + call anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ph, me) + + case (DAMAGE_ANISODUCTILE_ID) + call anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ph, me) + + case default + localphiDot = 0.0_pReal + dLocalphiDot_dPhi = 0.0_pReal + + end select + phiDot = phiDot + localphiDot + dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi + enddo + +end subroutine phase_damage_getRateAndItsTangents + + + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with adaptive 1st order explicit Euler method +!> using Fixed Point Iteration to adapt the stepsize +!-------------------------------------------------------------------------------------------------- +module function integrateDamageState(dt,co,ip,el) result(broken) + + real(pReal), intent(in) :: dt + integer, intent(in) :: & + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop + logical :: broken + + integer :: & + NiterationState, & !< number of iterations in state loop + ph, & + me, & + size_so + real(pReal) :: & + zeta + real(pReal), dimension(phase_source_maxSizeDotState) :: & + r ! state residuum + real(pReal), dimension(phase_source_maxSizeDotState,2) :: source_dotState + logical :: & + converged_ + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + if (damageState(ph)%sizeState == 0) then + broken = .false. + return + endif + + converged_ = .true. + broken = phase_damage_collectDotState(ph,me) + if(broken) return + + size_so = damageState(ph)%sizeDotState + damageState(ph)%state(1:size_so,me) = damageState(ph)%subState0(1:size_so,me) & + + damageState(ph)%dotState (1:size_so,me) * dt + source_dotState(1:size_so,2) = 0.0_pReal + + iteration: do NiterationState = 1, num%nState + + if(nIterationState > 1) source_dotState(1:size_so,2) = source_dotState(1:size_so,1) + source_dotState(1:size_so,1) = damageState(ph)%dotState(:,me) + + broken = phase_damage_collectDotState(ph,me) + if(broken) exit iteration + + + zeta = damper(damageState(ph)%dotState(:,me),source_dotState(1:size_so,1),source_dotState(1:size_so,2)) + damageState(ph)%dotState(:,me) = damageState(ph)%dotState(:,me) * zeta & + + source_dotState(1:size_so,1)* (1.0_pReal - zeta) + r(1:size_so) = damageState(ph)%state (1:size_so,me) & + - damageState(ph)%subState0(1:size_so,me) & + - damageState(ph)%dotState (1:size_so,me) * dt + damageState(ph)%state(1:size_so,me) = damageState(ph)%state(1:size_so,me) - r(1:size_so) + converged_ = converged_ .and. converged(r(1:size_so), & + damageState(ph)%state(1:size_so,me), & + damageState(ph)%atol(1:size_so)) + + + if(converged_) then + broken = phase_damage_deltaState(mechanical_F_e(ph,me),ph,me) + exit iteration + endif + + enddo iteration + + broken = broken .or. .not. converged_ + + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + +end function integrateDamageState + + +!---------------------------------------------------------------------------------------------- +!< @brief writes damage sources results to HDF5 output file +!---------------------------------------------------------------------------------------------- +module subroutine damage_results(group,ph) + + character(len=*), intent(in) :: group + integer, intent(in) :: ph + + integer :: so + + sourceLoop: do so = 1, phase_Nsources(ph) + + if (phase_source(ph) /= DAMAGE_UNDEFINED_ID) & + call results_closeGroup(results_addGroup(group//'sources/')) ! should be 'damage' + + sourceType: select case (phase_source(ph)) + + case (DAMAGE_ISOBRITTLE_ID) sourceType + call isobrittle_results(ph,group//'sources/') + + case (DAMAGE_ISODUCTILE_ID) sourceType + call isoductile_results(ph,group//'sources/') + + case (DAMAGE_ANISOBRITTLE_ID) sourceType + call anisobrittle_results(ph,group//'sources/') + + case (DAMAGE_ANISODUCTILE_ID) sourceType + call anisoductile_results(ph,group//'sources/') + + end select sourceType + + enddo SourceLoop + +end subroutine damage_results + + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +function phase_damage_collectDotState(ph,me) result(broken) + + integer, intent(in) :: & + ph, & + me !< counter in source loop + logical :: broken + + + broken = .false. + + if (damageState(ph)%sizeState > 0) then + + sourceType: select case (phase_source(ph)) + + case (DAMAGE_ISODUCTILE_ID) sourceType + call isoductile_dotState(ph,me) + + case (DAMAGE_ANISODUCTILE_ID) sourceType + call anisoductile_dotState(ph,me) + + case (DAMAGE_ANISOBRITTLE_ID) sourceType + call anisobrittle_dotState(mechanical_S(ph,me), ph,me) ! correct stress? + + end select sourceType + + broken = broken .or. any(IEEE_is_NaN(damageState(ph)%dotState(:,me))) + + endif + +end function phase_damage_collectDotState + + + +!-------------------------------------------------------------------------------------------------- +!> @brief for constitutive models having an instantaneous change of state +!> will return false if delta state is not needed/supported by the constitutive model +!-------------------------------------------------------------------------------------------------- +function phase_damage_deltaState(Fe, ph, me) result(broken) + + integer, intent(in) :: & + ph, & + me + real(pReal), intent(in), dimension(3,3) :: & + Fe !< elastic deformation gradient + integer :: & + myOffset, & + mySize + logical :: & + broken + + + broken = .false. + + if (damageState(ph)%sizeState == 0) return + + sourceType: select case (phase_source(ph)) + + case (DAMAGE_ISOBRITTLE_ID) sourceType + call isobrittle_deltaState(phase_homogenizedC(ph,me), Fe, ph,me) + broken = any(IEEE_is_NaN(damageState(ph)%deltaState(:,me))) + if(.not. broken) then + myOffset = damageState(ph)%offsetDeltaState + mySize = damageState(ph)%sizeDeltaState + damageState(ph)%state(myOffset + 1: myOffset + mySize,me) = & + damageState(ph)%state(myOffset + 1: myOffset + mySize,me) + damageState(ph)%deltaState(1:mySize,me) + endif + + end select sourceType + + +end function phase_damage_deltaState + + +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a source mechanism is active or not +!-------------------------------------------------------------------------------------------------- +function source_active(source_label) result(active_source) + + character(len=*), intent(in) :: source_label !< name of source mechanism + logical, dimension(:), allocatable :: active_source + + class(tNode), pointer :: & + phases, & + phase, & + sources, & + src + integer :: ph + + phases => config_material%get('phase') + allocate(active_source(phases%length)) + do ph = 1, phases%length + phase => phases%get(ph) + sources => phase%get('damage',defaultVal=emptyList) + src => sources%get(1) + active_source(ph) = src%get_asString('type',defaultVal = 'x') == source_label + enddo + + +end function source_active + + +!---------------------------------------------------------------------------------------------- +!< @brief Set damage parameter +!---------------------------------------------------------------------------------------------- +module subroutine phase_damage_set_phi(phi,co,ce) + + real(pReal), intent(in) :: phi + integer, intent(in) :: ce, co + + + current(material_phaseAt2(co,ce))%phi(material_phaseMemberAt2(co,ce)) = phi + +end subroutine phase_damage_set_phi + + +module function phase_damage_get_phi(co,ip,el) result(phi) + + integer, intent(in) :: co, ip, el + real(pReal) :: phi + + phi = current(material_phaseAt(co,el))%phi(material_phaseMemberAt(co,ip,el)) + +end function phase_damage_get_phi + + +module function damage_phi(ph,me) result(phi) + + integer, intent(in) :: ph, me + real(pReal) :: phi + + + phi = current(ph)%phi(me) + +end function damage_phi + + +end submodule damagee diff --git a/src/kinematics_cleavage_opening.f90 b/src/phase_damage_anisobrittle.f90 similarity index 50% rename from src/kinematics_cleavage_opening.f90 rename to src/phase_damage_anisobrittle.f90 index a29a290f8..096da6fb8 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/phase_damage_anisobrittle.f90 @@ -1,23 +1,24 @@ !-------------------------------------------------------------------------------------------------- !> @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 +!> @brief material subroutine incorporating anisotropic brittle damage source mechanism !> @details to be done !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_damage) kinematics_cleavage_opening - - integer, dimension(:), allocatable :: kinematics_cleavage_opening_instance +submodule (phase:damagee) anisobrittle type :: tParameters !< container type for internal constitutive parameters - integer :: & - sum_N_cl !< total number of cleavage planes real(pReal) :: & dot_o, & !< opening rate of cleavage planes q !< damage rate sensitivity - real(pReal), dimension(:), allocatable :: & - g_crit + real(pReal), dimension(:), allocatable :: & + s_crit, & !< critical displacement + g_crit !< critical load real(pReal), dimension(:,:,:,:), allocatable :: & cleavage_systems + integer :: & + sum_N_cl !< total number of cleavage planes + character(len=pStringLen), allocatable, dimension(:) :: & + output end type tParameters type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) @@ -30,81 +31,176 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module function kinematics_cleavage_opening_init(kinematics_length) result(myKinematics) - - integer, intent(in) :: kinematics_length - logical, dimension(:,:), allocatable :: myKinematics +module function anisobrittle_init() result(mySources) + + logical, dimension(:), allocatable :: mySources - integer :: Ninstances,p,k - integer, dimension(:), allocatable :: N_cl !< active number of cleavage systems per family - character(len=pStringLen) :: extmsg = '' class(tNode), pointer :: & phases, & phase, & - kinematics, & - kinematic_type - - print'(/,a)', ' <<<+- kinematics_cleavage_opening init -+>>>' + sources, & + src + integer :: Nmembers,p + integer, dimension(:), allocatable :: N_cl + character(len=pStringLen) :: extmsg = '' + + + mySources = source_active('anisobrittle') + if(count(mySources) == 0) return + + print'(/,a)', ' <<<+- phase:damage:anisobrittle init -+>>>' + print'(a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT) - myKinematics = kinematics_active('cleavage_opening',kinematics_length) - Ninstances = count(myKinematics) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return phases => config_material%get('phase') - allocate(param(Ninstances)) - allocate(kinematics_cleavage_opening_instance(phases%length), source=0) + allocate(param(phases%length)) + do p = 1, phases%length - if(any(myKinematics(:,p))) kinematics_cleavage_opening_instance(p) = count(myKinematics(:,1:p)) + if(mySources(p)) then phase => phases%get(p) - if(count(myKinematics(:,p)) == 0) cycle - kinematics => phase%get('kinematics') - do k = 1, kinematics%length - if(myKinematics(k,p)) then - associate(prm => param(kinematics_cleavage_opening_instance(p))) - kinematic_type => kinematics%get(k) + sources => phase%get('damage') - N_cl = kinematic_type%get_asInts('N_cl') + associate(prm => param(p)) + src => sources%get(1) + + N_cl = src%get_asInts('N_cl',defaultVal=emptyIntArray) prm%sum_N_cl = sum(abs(N_cl)) - prm%q = kinematic_type%get_asFloat('q') - prm%dot_o = kinematic_type%get_asFloat('dot_o') + prm%q = src%get_asFloat('q') + prm%dot_o = src%get_asFloat('dot_o') - prm%g_crit = kinematic_type%get_asFloats('g_crit',requiredSize=size(N_cl)) + prm%s_crit = src%get_asFloats('s_crit', requiredSize=size(N_cl)) + prm%g_crit = src%get_asFloats('g_crit', requiredSize=size(N_cl)) - prm%cleavage_systems = lattice_SchmidMatrix_cleavage(N_cl,phase%get_asString('lattice'),& - phase%get_asFloat('c/a',defaultVal=0.0_pReal)) + prm%cleavage_systems = lattice_SchmidMatrix_cleavage(N_cl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) - ! expand: family => system + ! expand: family => system + prm%s_crit = math_expand(prm%s_crit,N_cl) prm%g_crit = math_expand(prm%g_crit,N_cl) - ! sanity checks +#if defined (__GFORTRAN__) + prm%output = output_asStrings(src) +#else + prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) +#endif + + ! sanity checks if (prm%q <= 0.0_pReal) extmsg = trim(extmsg)//' q' if (prm%dot_o <= 0.0_pReal) extmsg = trim(extmsg)//' dot_o' if (any(prm%g_crit < 0.0_pReal)) extmsg = trim(extmsg)//' g_crit' + if (any(prm%s_crit < 0.0_pReal)) extmsg = trim(extmsg)//' s_crit' + + Nmembers = count(material_phaseAt==p) * discretization_nIPs + call phase_allocateState(damageState(p),Nmembers,1,1,0) + damageState(p)%atol = src%get_asFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol' + + end associate !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(cleavage_opening)') - end associate + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_anisoBrittle)') endif - enddo + enddo +end function anisobrittle_init -end function kinematics_cleavage_opening_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +module subroutine anisobrittle_dotState(S, ph,me) + + integer, intent(in) :: & + ph,me + real(pReal), intent(in), dimension(3,3) :: & + S + + integer :: & + sourceOffset, & + damageOffset, & + homog, & + i + real(pReal) :: & + traction_d, traction_t, traction_n, traction_crit + + + associate(prm => param(ph)) + damageState(ph)%dotState(1,me) = 0.0_pReal + do i = 1, prm%sum_N_cl + traction_d = math_tensordot(S,prm%cleavage_systems(1:3,1:3,1,i)) + traction_t = math_tensordot(S,prm%cleavage_systems(1:3,1:3,2,i)) + traction_n = math_tensordot(S,prm%cleavage_systems(1:3,1:3,3,i)) + + traction_crit = prm%g_crit(i)*damage_phi(ph,me)**2.0_pReal + + damageState(ph)%dotState(1,me) = damageState(ph)%dotState(1,me) & + + prm%dot_o / prm%s_crit(i) & + * ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**prm%q + & + (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**prm%q + & + (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**prm%q) + enddo + end associate + +end subroutine anisobrittle_dotState + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local part of nonlocal damage driving force +!-------------------------------------------------------------------------------------------------- +module subroutine anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ph, me) + + integer, intent(in) :: & + ph, & + me + real(pReal), intent(in) :: & + phi + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + + + dLocalphiDot_dPhi = -damageState(ph)%state(1,me) + + localphiDot = 1.0_pReal & + + dLocalphiDot_dPhi*phi + +end subroutine anisobrittle_getRateAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +module subroutine anisobrittle_results(phase,group) + + integer, intent(in) :: phase + character(len=*), intent(in) :: group + + integer :: o + + + associate(prm => param(phase), stt => damageState(phase)%state) + outputsLoop: do o = 1,size(prm%output) + select case(trim(prm%output(o))) + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') + end select + enddo outputsLoop + end associate + +end subroutine anisobrittle_results !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el) +module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ph,me) integer, intent(in) :: & - co, & !< grain number - ip, & !< integration point number - el !< element number + ph,me real(pReal), intent(in), dimension(3,3) :: & S real(pReal), intent(out), dimension(3,3) :: & @@ -113,20 +209,17 @@ module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) integer :: & - homog, damageOffset, & i, k, l, m, n real(pReal) :: & traction_d, traction_t, traction_n, traction_crit, & udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt - homog = material_homogenizationAt(el) - damageOffset = material_homogenizationMemberAt(ip,el) Ld = 0.0_pReal dLd_dTstar = 0.0_pReal - associate(prm => param(kinematics_cleavage_opening_instance(material_phaseAt(co,el)))) + associate(prm => param(ph)) do i = 1,prm%sum_N_cl - traction_crit = prm%g_crit(i)* damage(homog)%p(damageOffset)**2.0_pReal + traction_crit = prm%g_crit(i)*damage_phi(ph,me)**2.0_pReal traction_d = math_tensordot(S,prm%cleavage_systems(1:3,1:3,1,i)) if (abs(traction_d) > traction_crit + tol_math_check) then @@ -162,4 +255,4 @@ module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, end subroutine kinematics_cleavage_opening_LiAndItsTangent -end submodule kinematics_cleavage_opening +end submodule anisobrittle diff --git a/src/phase_damage_anisoductile.f90 b/src/phase_damage_anisoductile.f90 new file mode 100644 index 000000000..a687df594 --- /dev/null +++ b/src/phase_damage_anisoductile.f90 @@ -0,0 +1,161 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine incorporating anisotropic ductile damage source mechanism +!> @details to be done +!-------------------------------------------------------------------------------------------------- +submodule(phase:damagee) anisoductile + + type :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + q !< damage rate sensitivity + real(pReal), dimension(:), allocatable :: & + gamma_crit !< critical plastic strain per slip system + character(len=pStringLen), allocatable, dimension(:) :: & + output + end type tParameters + + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +module function anisoductile_init() result(mySources) + + logical, dimension(:), allocatable :: mySources + + class(tNode), pointer :: & + phases, & + phase, & + mech, & + pl, & + sources, & + src + integer :: Ninstances,Nmembers,p + integer, dimension(:), allocatable :: N_sl + character(len=pStringLen) :: extmsg = '' + + + mySources = source_active('anisoductile') + if(count(mySources) == 0) return + + print'(/,a)', ' <<<+- phase:damage:anisoductile init -+>>>' + print'(a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT) + + + phases => config_material%get('phase') + allocate(param(phases%length)) + + do p = 1, phases%length + if(mySources(p)) then + phase => phases%get(p) + mech => phase%get('mechanics') + pl => mech%get('plasticity') + sources => phase%get('damage') + + + associate(prm => param(p)) + src => sources%get(1) + + N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) + prm%q = src%get_asFloat('q') + prm%gamma_crit = src%get_asFloats('gamma_crit',requiredSize=size(N_sl)) + + ! expand: family => system + prm%gamma_crit = math_expand(prm%gamma_crit,N_sl) + +#if defined (__GFORTRAN__) + prm%output = output_asStrings(src) +#else + prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) +#endif + + ! sanity checks + if (prm%q <= 0.0_pReal) extmsg = trim(extmsg)//' q' + if (any(prm%gamma_crit < 0.0_pReal)) extmsg = trim(extmsg)//' gamma_crit' + + Nmembers=count(material_phaseAt2==p) + call phase_allocateState(damageState(p),Nmembers,1,1,0) + damageState(p)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol' + + end associate + +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_anisoDuctile)') + endif + + enddo + + +end function anisoductile_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +module subroutine anisoductile_dotState(ph,me) + + integer, intent(in) :: & + ph, & + me + + + associate(prm => param(ph)) + damageState(ph)%dotState(1,me) = sum(plasticState(ph)%slipRate(:,me)/(damage_phi(ph,me)**prm%q)/prm%gamma_crit) + end associate + +end subroutine anisoductile_dotState + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local part of nonlocal damage driving force +!-------------------------------------------------------------------------------------------------- +module subroutine anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ph,me) + + integer, intent(in) :: & + ph, & + me + real(pReal), intent(in) :: & + phi + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + + + dLocalphiDot_dPhi = -damageState(ph)%state(1,me) + + localphiDot = 1.0_pReal & + + dLocalphiDot_dPhi*phi + +end subroutine anisoductile_getRateAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +module subroutine anisoductile_results(phase,group) + + integer, intent(in) :: phase + character(len=*), intent(in) :: group + + integer :: o + + + associate(prm => param(phase), stt => damageState(phase)%state) + outputsLoop: do o = 1,size(prm%output) + select case(trim(prm%output(o))) + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') + end select + enddo outputsLoop + end associate + +end subroutine anisoductile_results + +end submodule anisoductile diff --git a/src/phase_damage_isobrittle.f90 b/src/phase_damage_isobrittle.f90 new file mode 100644 index 000000000..0cf85897a --- /dev/null +++ b/src/phase_damage_isobrittle.f90 @@ -0,0 +1,162 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine incoprorating isotropic brittle damage source mechanism +!> @details to be done +!-------------------------------------------------------------------------------------------------- +submodule(phase:damagee) isobrittle + + type :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + W_crit !< critical elastic strain energy + character(len=pStringLen), allocatable, dimension(:) :: & + output + end type tParameters + + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +module function isobrittle_init() result(mySources) + + logical, dimension(:), allocatable :: mySources + + class(tNode), pointer :: & + phases, & + phase, & + sources, & + src + integer :: Nmembers,p + character(len=pStringLen) :: extmsg = '' + + + mySources = source_active('isobrittle') + if(count(mySources) == 0) return + + print'(/,a)', ' <<<+- phase:damage:isobrittle init -+>>>' + print'(a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT) + + + phases => config_material%get('phase') + allocate(param(phases%length)) + + do p = 1, phases%length + if(mySources(p)) then + phase => phases%get(p) + sources => phase%get('damage') + + associate(prm => param(p)) + src => sources%get(1) + + prm%W_crit = src%get_asFloat('W_crit') + +#if defined (__GFORTRAN__) + prm%output = output_asStrings(src) +#else + prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) +#endif + + ! sanity checks + if (prm%W_crit <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit' + + Nmembers = count(material_phaseAt2==p) + call phase_allocateState(damageState(p),Nmembers,1,1,1) + damageState(p)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol' + + end associate + +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_isoBrittle)') + endif + + enddo + + +end function isobrittle_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +module subroutine isobrittle_deltaState(C, Fe, ph,me) + + integer, intent(in) :: ph,me + real(pReal), intent(in), dimension(3,3) :: & + Fe + real(pReal), intent(in), dimension(6,6) :: & + C + + real(pReal), dimension(6) :: & + strain + real(pReal) :: & + strainenergy + + + strain = 0.5_pReal*math_sym33to6(matmul(transpose(Fe),Fe)-math_I3) + + associate(prm => param(ph)) + strainenergy = 2.0_pReal*sum(strain*matmul(C,strain))/prm%W_crit + ! ToDo: check strainenergy = 2.0_pReal*dot_product(strain,matmul(C,strain))/prm%W_crit + + damageState(ph)%deltaState(1,me) = merge(strainenergy - damageState(ph)%state(1,me), & + damageState(ph)%subState0(1,me) - damageState(ph)%state(1,me), & + strainenergy > damageState(ph)%subState0(1,me)) + end associate + +end subroutine isobrittle_deltaState + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local part of nonlocal damage driving force +!-------------------------------------------------------------------------------------------------- +module subroutine isobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ph, me) + + integer, intent(in) :: & + ph, me + real(pReal), intent(in) :: & + phi + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + + + associate(prm => param(ph)) + localphiDot = 1.0_pReal & + - phi*damageState(ph)%state(1,me) + dLocalphiDot_dPhi = - damageState(ph)%state(1,me) + end associate + +end subroutine isobrittle_getRateAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +module subroutine isobrittle_results(phase,group) + + integer, intent(in) :: phase + character(len=*), intent(in) :: group + + integer :: o + + + associate(prm => param(phase), & + stt => damageState(phase)%state) + outputsLoop: do o = 1,size(prm%output) + select case(trim(prm%output(o))) + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') + end select + enddo outputsLoop + end associate + +end subroutine isobrittle_results + +end submodule isobrittle diff --git a/src/phase_damage_isoductile.f90 b/src/phase_damage_isoductile.f90 new file mode 100644 index 000000000..9d00bb1a7 --- /dev/null +++ b/src/phase_damage_isoductile.f90 @@ -0,0 +1,150 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine incorporating isotropic ductile damage source mechanism +!> @details to be done +!-------------------------------------------------------------------------------------------------- +submodule(phase:damagee) isoductile + + type:: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + gamma_crit, & !< critical plastic strain + q + character(len=pStringLen), allocatable, dimension(:) :: & + output + end type tParameters + + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) + + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +module function isoductile_init() result(mySources) + + logical, dimension(:), allocatable :: mySources + + class(tNode), pointer :: & + phases, & + phase, & + sources, & + src + integer :: Ninstances,Nmembers,p + character(len=pStringLen) :: extmsg = '' + + + mySources = source_active('isoductile') + if(count(mySources) == 0) return + + print'(/,a)', ' <<<+- phase:damage:isoductile init -+>>>' + print'(a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT) + + + phases => config_material%get('phase') + allocate(param(phases%length)) + + do p = 1, phases%length + if(mySources(p)) then + phase => phases%get(p) + sources => phase%get('damage') + + associate(prm => param(p)) + src => sources%get(1) + + prm%q = src%get_asFloat('q') + prm%gamma_crit = src%get_asFloat('gamma_crit') + +#if defined (__GFORTRAN__) + prm%output = output_asStrings(src) +#else + prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) +#endif + + ! sanity checks + if (prm%q <= 0.0_pReal) extmsg = trim(extmsg)//' q' + if (prm%gamma_crit <= 0.0_pReal) extmsg = trim(extmsg)//' gamma_crit' + + Nmembers=count(material_phaseAt2==p) + call phase_allocateState(damageState(p),Nmembers,1,1,0) + damageState(p)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol' + + end associate + +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_isoDuctile)') + endif + enddo + + +end function isoductile_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +module subroutine isoductile_dotState(ph, me) + + integer, intent(in) :: & + ph, & + me + + + associate(prm => param(ph)) + damageState(ph)%dotState(1,me) = sum(plasticState(ph)%slipRate(:,me)) & + / (prm%gamma_crit*damage_phi(ph,me)**prm%q) + end associate + +end subroutine isoductile_dotState + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local part of nonlocal damage driving force +!-------------------------------------------------------------------------------------------------- +module subroutine isoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, ph, me) + + integer, intent(in) :: & + ph, & + me + real(pReal), intent(in) :: & + phi + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + + + dLocalphiDot_dPhi = -damageState(ph)%state(1,me) + + localphiDot = 1.0_pReal & + + dLocalphiDot_dPhi*phi + +end subroutine isoductile_getRateAndItsTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +module subroutine isoductile_results(phase,group) + + integer, intent(in) :: phase + character(len=*), intent(in) :: group + + integer :: o + + associate(prm => param(phase), stt => damageState(phase)%state) + outputsLoop: do o = 1,size(prm%output) + select case(trim(prm%output(o))) + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') + end select + enddo outputsLoop + end associate + +end subroutine isoductile_results + +end submodule isoductile diff --git a/src/constitutive_mech.f90 b/src/phase_mechanical.f90 similarity index 50% rename from src/constitutive_mech.f90 rename to src/phase_mechanical.f90 index c48c59ec9..e642b22ef 100644 --- a/src/constitutive_mech.f90 +++ b/src/phase_mechanical.f90 @@ -1,285 +1,163 @@ !---------------------------------------------------------------------------------------------------- !> @brief internal microstructure state for all plasticity constitutive models !---------------------------------------------------------------------------------------------------- -submodule(constitutive) constitutive_mech +submodule(phase) mechanical + enum, bind(c); enumerator :: & ELASTICITY_UNDEFINED_ID, & ELASTICITY_HOOKE_ID, & STIFFNESS_DEGRADATION_UNDEFINED_ID, & - STIFFNESS_DEGRADATION_DAMAGE_ID + STIFFNESS_DEGRADATION_DAMAGE_ID, & + PLASTICITY_UNDEFINED_ID, & + PLASTICITY_NONE_ID, & + PLASTICITY_ISOTROPIC_ID, & + PLASTICITY_PHENOPOWERLAW_ID, & + PLASTICITY_KINEHARDENING_ID, & + PLASTICITY_DISLOTWIN_ID, & + PLASTICITY_DISLOTUNGSTEN_ID, & + PLASTICITY_NONLOCAL_ID, & + KINEMATICS_UNDEFINED_ID, & + KINEMATICS_CLEAVAGE_OPENING_ID, & + KINEMATICS_SLIPPLANE_OPENING_ID, & + KINEMATICS_THERMAL_EXPANSION_ID end enum - integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable :: & + integer(kind(ELASTICITY_UNDEFINED_ID)), dimension(:), allocatable :: & phase_elasticity !< elasticity of each phase - integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & + integer(kind(STIFFNESS_DEGRADATION_UNDEFINED_ID)), dimension(:,:), allocatable :: & phase_stiffnessDegradation !< active stiffness degradation mechanisms of each phase + type(tTensorContainer), dimension(:), allocatable :: & + ! current value + phase_mechanical_Fe, & + phase_mechanical_Fi, & + phase_mechanical_Fp, & + phase_mechanical_F, & + phase_mechanical_Li, & + phase_mechanical_Lp, & + phase_mechanical_S, & + phase_mechanical_P, & + ! converged value at end of last solver increment + phase_mechanical_Fi0, & + phase_mechanical_Fp0, & + phase_mechanical_F0, & + phase_mechanical_Li0, & + phase_mechanical_Lp0, & + phase_mechanical_S0 + + + integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable :: & + phase_plasticity !< plasticity of each phase + interface - module function plastic_none_init() result(myPlasticity) - logical, dimension(:), allocatable :: & - myPlasticity - end function plastic_none_init + module subroutine eigendeformation_init(phases) + class(tNode), pointer :: phases + end subroutine eigendeformation_init - module function plastic_isotropic_init() result(myPlasticity) - logical, dimension(:), allocatable :: & - myPlasticity - end function plastic_isotropic_init + module subroutine plastic_init + end subroutine plastic_init - module function plastic_phenopowerlaw_init() result(myPlasticity) - logical, dimension(:), allocatable :: & - myPlasticity - end function plastic_phenopowerlaw_init - - module function plastic_kinehardening_init() result(myPlasticity) - logical, dimension(:), allocatable :: & - myPlasticity - end function plastic_kinehardening_init - - module function plastic_dislotwin_init() result(myPlasticity) - logical, dimension(:), allocatable :: & - myPlasticity - end function plastic_dislotwin_init - - module function plastic_dislotungsten_init() result(myPlasticity) - logical, dimension(:), allocatable :: & - myPlasticity - end function plastic_dislotungsten_init - - module function plastic_nonlocal_init() result(myPlasticity) - logical, dimension(:), allocatable :: & - myPlasticity - end function plastic_nonlocal_init - - - module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,ph,me) real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient - real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress - + Li !< inleastic velocity gradient + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLi_dMi !< derivative of Li with respect to Mandel stress real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress + Mi !< Mandel stress integer, intent(in) :: & - instance, & - of - end subroutine plastic_isotropic_LpAndItsTangent + ph, & + me + end subroutine plastic_isotropic_LiAndItsTangent - pure module subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) - real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient - real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - integer, intent(in) :: & - instance, & - of - end subroutine plastic_phenopowerlaw_LpAndItsTangent + module function plastic_dotState(subdt,co,ip,el,ph,me) result(broken) - pure module subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) - real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient - real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress - - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - integer, intent(in) :: & - instance, & - of - end subroutine plastic_kinehardening_LpAndItsTangent - - module subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) - real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient - real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress - - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - real(pReal), intent(in) :: & - T - integer, intent(in) :: & - instance, & - of - end subroutine plastic_dislotwin_LpAndItsTangent - - pure module subroutine plastic_dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) - real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient - real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress - - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - real(pReal), intent(in) :: & - T - integer, intent(in) :: & - instance, & - of - end subroutine plastic_dislotungsten_LpAndItsTangent - - module subroutine plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp, & - Mp,Temperature,instance,of,ip,el) - real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient - real(pReal), dimension(3,3,3,3), intent(out) :: & - dLp_dMp !< derivative of Lp with respect to the Mandel stress - - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - real(pReal), intent(in) :: & - Temperature - integer, intent(in) :: & - instance, & - of, & - ip, & !< current integration point - el !< current element number - end subroutine plastic_nonlocal_LpAndItsTangent - - module subroutine plastic_isotropic_dotState(Mp,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - integer, intent(in) :: & - instance, & - of - end subroutine plastic_isotropic_dotState - - module subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - integer, intent(in) :: & - instance, & - of - end subroutine plastic_phenopowerlaw_dotState - - module subroutine plastic_kinehardening_dotState(Mp,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - integer, intent(in) :: & - instance, & - of - end subroutine plastic_kinehardening_dotState - - module subroutine plastic_dislotwin_dotState(Mp,T,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - real(pReal), intent(in) :: & - T - integer, intent(in) :: & - instance, & - of - end subroutine plastic_dislotwin_dotState - - module subroutine plastic_disloTungsten_dotState(Mp,T,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - real(pReal), intent(in) :: & - T - integer, intent(in) :: & - instance, & - of - end subroutine plastic_disloTungsten_dotState - - module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & - instance,of,ip,el) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< MandelStress - real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F !< deformation gradient - real(pReal), intent(in) :: & - Temperature, & !< temperature - timestep !< substepped crystallite time increment integer, intent(in) :: & - instance, & - of, & - ip, & !< current integration point - el !< current element number - end subroutine plastic_nonlocal_dotState + co, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + ph, & + me + real(pReal), intent(in) :: & + subdt !< timestep + logical :: broken + end function plastic_dotState - - module subroutine plastic_dislotwin_dependentState(T,instance,of) - integer, intent(in) :: & - instance, & - of - real(pReal), intent(in) :: & - T - end subroutine plastic_dislotwin_dependentState - - module subroutine plastic_dislotungsten_dependentState(instance,of) - integer, intent(in) :: & - instance, & - of - end subroutine plastic_dislotungsten_dependentState - - module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) - real(pReal), dimension(3,3), intent(in) :: & - F !< deformation gradient + module function plastic_deltaState(ph, me) result(broken) integer, intent(in) :: & - instance, & - of, & - ip, & !< current integration point - el !< current element number - end subroutine plastic_nonlocal_dependentState + ph, & + me + logical :: & + broken + end function plastic_deltaState - module subroutine plastic_kinehardening_deltaState(Mp,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - integer, intent(in) :: & - instance, & - of - end subroutine plastic_kinehardening_deltaState - - module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) - real(pReal), dimension(3,3), intent(in) :: & - Mp + module subroutine phase_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & + S, Fi, ph,me) integer, intent(in) :: & - instance, & - of, & - ip, & - el - end subroutine plastic_nonlocal_deltaState + ph,me + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola-Kirchhoff stress + real(pReal), intent(in), dimension(3,3) :: & + Fi !< intermediate deformation gradient + real(pReal), intent(out), dimension(3,3) :: & + Li !< intermediate velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLi_dS, & !< derivative of Li with respect to S + dLi_dFi - module subroutine plastic_isotropic_results(instance,group) - integer, intent(in) :: instance + end subroutine phase_LiAndItsTangents + + + module subroutine plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & + S, Fi, ph,me) + integer, intent(in) :: & + ph,me + real(pReal), intent(in), dimension(3,3) :: & + S, & !< 2nd Piola-Kirchhoff stress + Fi !< intermediate deformation gradient + real(pReal), intent(out), dimension(3,3) :: & + Lp !< plastic velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLp_dS, & + dLp_dFi !< derivative of Lp with respect to Fi + end subroutine plastic_LpAndItsTangents + + + module subroutine plastic_isotropic_results(ph,group) + integer, intent(in) :: ph character(len=*), intent(in) :: group end subroutine plastic_isotropic_results - module subroutine plastic_phenopowerlaw_results(instance,group) - integer, intent(in) :: instance + module subroutine plastic_phenopowerlaw_results(ph,group) + integer, intent(in) :: ph character(len=*), intent(in) :: group end subroutine plastic_phenopowerlaw_results - module subroutine plastic_kinehardening_results(instance,group) - integer, intent(in) :: instance + module subroutine plastic_kinehardening_results(ph,group) + integer, intent(in) :: ph character(len=*), intent(in) :: group end subroutine plastic_kinehardening_results - module subroutine plastic_dislotwin_results(instance,group) - integer, intent(in) :: instance + module subroutine plastic_dislotwin_results(ph,group) + integer, intent(in) :: ph character(len=*), intent(in) :: group end subroutine plastic_dislotwin_results - module subroutine plastic_dislotungsten_results(instance,group) - integer, intent(in) :: instance + module subroutine plastic_dislotungsten_results(ph,group) + integer, intent(in) :: ph character(len=*), intent(in) :: group end subroutine plastic_dislotungsten_results - module subroutine plastic_nonlocal_results(instance,group) - integer, intent(in) :: instance + module subroutine plastic_nonlocal_results(ph,group) + integer, intent(in) :: ph character(len=*), intent(in) :: group end subroutine plastic_nonlocal_results - module function plastic_dislotwin_homogenizedC(co,ip,el) result(homogenizedC) - real(pReal), dimension(6,6) :: & - homogenizedC - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element + module function plastic_dislotwin_homogenizedC(ph,me) result(homogenizedC) + real(pReal), dimension(6,6) :: homogenizedC + integer, intent(in) :: ph,me end function plastic_dislotwin_homogenizedC @@ -299,30 +177,75 @@ contains !> @brief Initialize mechanical field related constitutive models !> @details Initialize elasticity, plasticity and stiffness degradation models. !-------------------------------------------------------------------------------------------------- -module subroutine mech_init +module subroutine mechanical_init(materials,phases) + + class(tNode), pointer :: & + materials, & + phases integer :: & + el, & + ip, & + co, & + ce, & ph, & - stiffDegradationCtr + me, & + stiffDegradationCtr, & + Nmembers class(tNode), pointer :: & num_crystallite, & - phases, & + material, & + constituents, & + constituent, & phase, & mech, & elastic, & stiffDegradation - print'(/,a)', ' <<<+- constitutive_mech init -+>>>' + print'(/,a)', ' <<<+- phase:mechanical init -+>>>' !------------------------------------------------------------------------------------------------- ! initialize elasticity (hooke) !ToDO: Maybe move to elastic submodule along with function homogenizedC? - phases => config_material%get('phase') allocate(phase_elasticity(phases%length), source = ELASTICITY_undefined_ID) allocate(phase_elasticityInstance(phases%length), source = 0) allocate(phase_NstiffnessDegradations(phases%length),source=0) allocate(output_constituent(phases%length)) + allocate(phase_mechanical_Fe(phases%length)) + allocate(phase_mechanical_Fi(phases%length)) + allocate(phase_mechanical_Fi0(phases%length)) + allocate(phase_mechanical_Fp(phases%length)) + allocate(phase_mechanical_Fp0(phases%length)) + allocate(phase_mechanical_F(phases%length)) + allocate(phase_mechanical_F0(phases%length)) + allocate(phase_mechanical_Li(phases%length)) + allocate(phase_mechanical_Li0(phases%length)) + allocate(phase_mechanical_Lp0(phases%length)) + allocate(phase_mechanical_Lp(phases%length)) + allocate(phase_mechanical_S(phases%length)) + allocate(phase_mechanical_P(phases%length)) + allocate(phase_mechanical_S0(phases%length)) + + allocate(material_orientation0(homogenization_maxNconstituents,phases%length,maxVal(material_phaseMemberAt))) + do ph = 1, phases%length + Nmembers = count(material_phaseAt == ph) * discretization_nIPs + + allocate(phase_mechanical_Fi(ph)%data(3,3,Nmembers)) + allocate(phase_mechanical_Fe(ph)%data(3,3,Nmembers)) + allocate(phase_mechanical_Fi0(ph)%data(3,3,Nmembers)) + allocate(phase_mechanical_Fp(ph)%data(3,3,Nmembers)) + allocate(phase_mechanical_Fp0(ph)%data(3,3,Nmembers)) + allocate(phase_mechanical_Li(ph)%data(3,3,Nmembers)) + allocate(phase_mechanical_Li0(ph)%data(3,3,Nmembers)) + allocate(phase_mechanical_Lp0(ph)%data(3,3,Nmembers)) + allocate(phase_mechanical_Lp(ph)%data(3,3,Nmembers)) + allocate(phase_mechanical_S(ph)%data(3,3,Nmembers),source=0.0_pReal) + allocate(phase_mechanical_P(ph)%data(3,3,Nmembers),source=0.0_pReal) + allocate(phase_mechanical_S0(ph)%data(3,3,Nmembers),source=0.0_pReal) + allocate(phase_mechanical_F(ph)%data(3,3,Nmembers)) + allocate(phase_mechanical_F0(ph)%data(3,3,Nmembers)) + phase => phases%get(ph) mech => phase%get('mechanics') #if defined(__GFORTRAN__) @@ -356,23 +279,42 @@ module subroutine mech_init endif + do el = 1, size(material_phaseMemberAt,3); do ip = 1, size(material_phaseMemberAt,2) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + material => materials%get(discretization_materialAt(el)) + constituents => material%get('constituents') + constituent => constituents%get(co) + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + call material_orientation0(co,ph,me)%fromQuaternion(constituent%get_asFloats('O',requiredSize=4)) + + phase_mechanical_Fp0(ph)%data(1:3,1:3,me) = material_orientation0(co,ph,me)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) + phase_mechanical_Fp0(ph)%data(1:3,1:3,me) = phase_mechanical_Fp0(ph)%data(1:3,1:3,me) & + / math_det33(phase_mechanical_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) + phase_mechanical_Fi0(ph)%data(1:3,1:3,me) = math_I3 + phase_mechanical_F0(ph)%data(1:3,1:3,me) = math_I3 + + phase_mechanical_Fe(ph)%data(1:3,1:3,me) = math_inv33(matmul(phase_mechanical_Fi0(ph)%data(1:3,1:3,me), & + phase_mechanical_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration + phase_mechanical_Fp(ph)%data(1:3,1:3,me) = phase_mechanical_Fp0(ph)%data(1:3,1:3,me) + phase_mechanical_Fi(ph)%data(1:3,1:3,me) = phase_mechanical_Fi0(ph)%data(1:3,1:3,me) + phase_mechanical_F(ph)%data(1:3,1:3,me) = phase_mechanical_F0(ph)%data(1:3,1:3,me) + + enddo + enddo; enddo + + ! initialize plasticity allocate(plasticState(phases%length)) allocate(phase_plasticity(phases%length),source = PLASTICITY_undefined_ID) - allocate(phase_plasticityInstance(phases%length),source = 0) allocate(phase_localPlasticity(phases%length), source=.true.) - where(plastic_none_init()) phase_plasticity = PLASTICITY_NONE_ID - where(plastic_isotropic_init()) phase_plasticity = PLASTICITY_ISOTROPIC_ID - where(plastic_phenopowerlaw_init()) phase_plasticity = PLASTICITY_PHENOPOWERLAW_ID - where(plastic_kinehardening_init()) phase_plasticity = PLASTICITY_KINEHARDENING_ID - where(plastic_dislotwin_init()) phase_plasticity = PLASTICITY_DISLOTWIN_ID - where(plastic_dislotungsten_init()) phase_plasticity = PLASTICITY_DISLOTUNGSTEN_ID - where(plastic_nonlocal_init()) phase_plasticity = PLASTICITY_NONLOCAL_ID + call plastic_init() do ph = 1, phases%length phase_elasticityInstance(ph) = count(phase_elasticity(1:ph) == phase_elasticity(ph)) - phase_plasticityInstance(ph) = count(phase_plasticity(1:ph) == phase_plasticity(ph)) enddo num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) @@ -399,47 +341,23 @@ module subroutine mech_init end select -end subroutine mech_init + + call eigendeformation_init(phases) -!-------------------------------------------------------------------------------------------------- -!> @brief checks if a plastic module is active or not -!-------------------------------------------------------------------------------------------------- -function plastic_active(plastic_label) result(active_plastic) - - character(len=*), intent(in) :: plastic_label !< type of plasticity model - logical, dimension(:), allocatable :: active_plastic - - class(tNode), pointer :: & - phases, & - phase, & - mech, & - pl - integer :: ph - - phases => config_material%get('phase') - allocate(active_plastic(phases%length), source = .false. ) - do ph = 1, phases%length - phase => phases%get(ph) - mech => phase%get('mechanics') - pl => mech%get('plasticity') - if(pl%get_asString('type') == plastic_label) active_plastic(ph) = .true. - enddo - -end function plastic_active +end subroutine mechanical_init !-------------------------------------------------------------------------------------------------- !> @brief returns the 2nd Piola-Kirchhoff stress tensor and its tangent with respect to !> the elastic and intermediate deformation gradients using Hooke's law !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & - Fe, Fi, co, ip, el) +subroutine phase_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & + Fe, Fi, ph, me) integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element + ph, & + me real(pReal), intent(in), dimension(3,3) :: & Fe, & !< elastic deformation gradient Fi !< intermediate deformation gradient @@ -448,21 +366,19 @@ module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & real(pReal), intent(out), dimension(3,3,3,3) :: & dS_dFe, & !< derivative of 2nd P-K stress with respect to elastic deformation gradient dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient + real(pReal), dimension(3,3) :: E real(pReal), dimension(3,3,3,3) :: C integer :: & - ho, & !< homogenization - d !< counter in degradation loop - integer :: & + d, & !< counter in degradation loop i, j - ho = material_homogenizationAt(el) - C = math_66toSym3333(constitutive_homogenizedC(co,ip,el)) + C = math_66toSym3333(phase_homogenizedC(ph,me)) - DegradationLoop: do d = 1, phase_NstiffnessDegradations(material_phaseAt(co,el)) - degradationType: select case(phase_stiffnessDegradation(d,material_phaseAt(co,el))) + DegradationLoop: do d = 1, phase_NstiffnessDegradations(ph) + degradationType: select case(phase_stiffnessDegradation(d,ph)) case (STIFFNESS_DEGRADATION_damage_ID) degradationType - C = C * damage(ho)%p(material_homogenizationMemberAt(ip,el))**2 + C = C * damage_phi(ph,me)**2 end select degradationType enddo DegradationLoop @@ -474,227 +390,10 @@ module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & dS_dFi(i,j,1:3,1:3) = 2.0_pReal*matmul(matmul(E,Fi),C(i,j,1:3,1:3)) !< dS_ij/dFi_kl = C_ijln * E_km * Fe_mn enddo; enddo -end subroutine constitutive_hooke_SandItsTangents +end subroutine phase_hooke_SandItsTangents -!-------------------------------------------------------------------------------------------------- -!> @brief calls microstructure function of the different plasticity constitutive models -!-------------------------------------------------------------------------------------------------- -module subroutine constitutive_plastic_dependentState(F, co, ip, el) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - F !< deformation gradient - - integer :: & - ho, & !< homogenization - tme, & !< thermal member position - instance, of - - ho = material_homogenizationAt(el) - tme = material_homogenizationMemberAt(ip,el) - of = material_phasememberAt(co,ip,el) - instance = phase_plasticityInstance(material_phaseAt(co,el)) - - plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) - case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of) - case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType - call plastic_dislotungsten_dependentState(instance,of) - case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dependentState (F,instance,of,ip,el) - end select plasticityType - -end subroutine constitutive_plastic_dependentState - - -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the velocity gradient -! ToDo: Discuss whether it makes sense if crystallite handles the configuration conversion, i.e. -! Mp in, dLp_dMp out -!-------------------------------------------------------------------------------------------------- -module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & - S, Fi, co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola-Kirchhoff stress - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - Lp !< plastic velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLp_dS, & - dLp_dFi !< derivative of Lp with respect to Fi - - real(pReal), dimension(3,3,3,3) :: & - dLp_dMp !< derivative of Lp with respect to Mandel stress - real(pReal), dimension(3,3) :: & - Mp !< Mandel stress work conjugate with Lp - integer :: & - ho, & !< homogenization - tme !< thermal member position - integer :: & - i, j, instance, of - - ho = material_homogenizationAt(el) - tme = material_homogenizationMemberAt(ip,el) - - Mp = matmul(matmul(transpose(Fi),Fi),S) - of = material_phasememberAt(co,ip,el) - instance = phase_plasticityInstance(material_phaseAt(co,el)) - - plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) - - case (PLASTICITY_NONE_ID) plasticityType - Lp = 0.0_pReal - dLp_dMp = 0.0_pReal - - case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) - - case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - call plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) - - case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) - - case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp, temperature(ho)%p(tme),instance,of,ip,el) - - case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) - - case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType - call plastic_dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) - - end select plasticityType - - do i=1,3; do j=1,3 - dLp_dFi(i,j,1:3,1:3) = matmul(matmul(Fi,S),transpose(dLp_dMp(i,j,1:3,1:3))) + & - matmul(matmul(Fi,dLp_dMp(i,j,1:3,1:3)),S) - dLp_dS(i,j,1:3,1:3) = matmul(matmul(transpose(Fi),Fi),dLp_dMp(i,j,1:3,1:3)) ! ToDo: @PS: why not: dLp_dMp:(FiT Fi) - enddo; enddo - -end subroutine constitutive_plastic_LpAndItsTangents - - -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -function mech_collectDotState(subdt, co, ip, el,ph,of) result(broken) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - ph, & - of - real(pReal), intent(in) :: & - subdt !< timestep - real(pReal), dimension(3,3) :: & - Mp - integer :: & - ho, & !< homogenization - tme, & !< thermal member position - i, & !< counter in source loop - instance - logical :: broken - ho = material_homogenizationAt(el) - tme = material_homogenizationMemberAt(ip,el) - instance = phase_plasticityInstance(ph) - - Mp = matmul(matmul(transpose(constitutive_mech_Fi(ph)%data(1:3,1:3,of)),& - constitutive_mech_Fi(ph)%data(1:3,1:3,of)),crystallite_S(1:3,1:3,co,ip,el)) - - plasticityType: select case (phase_plasticity(ph)) - - case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_dotState(Mp,instance,of) - - case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - call plastic_phenopowerlaw_dotState(Mp,instance,of) - - case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_dotState(Mp,instance,of) - - case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_dotState(Mp,temperature(ho)%p(tme),instance,of) - - case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType - call plastic_disloTungsten_dotState(Mp,temperature(ho)%p(tme),instance,of) - - case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState(Mp,crystallite_partitionedF0,temperature(ho)%p(tme),subdt, & - instance,of,ip,el) - end select plasticityType - broken = any(IEEE_is_NaN(plasticState(ph)%dotState(:,of))) - - -end function mech_collectDotState - - -!-------------------------------------------------------------------------------------------------- -!> @brief for constitutive models having an instantaneous change of state -!> will return false if delta state is not needed/supported by the constitutive model -!-------------------------------------------------------------------------------------------------- -function constitutive_deltaState(S, Fi, co, ip, el, ph, of) result(broken) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - ph, & - of - real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola Kirchhoff stress - Fi !< intermediate deformation gradient - real(pReal), dimension(3,3) :: & - Mp - integer :: & - instance, & - myOffset, & - mySize - logical :: & - broken - - Mp = matmul(matmul(transpose(Fi),Fi),S) - instance = phase_plasticityInstance(ph) - - plasticityType: select case (phase_plasticity(ph)) - - case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_deltaState(Mp,instance,of) - broken = any(IEEE_is_NaN(plasticState(ph)%deltaState(:,of))) - - case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_deltaState(Mp,instance,of,ip,el) - broken = any(IEEE_is_NaN(plasticState(ph)%deltaState(:,of))) - - case default - broken = .false. - - end select plasticityType - - if(.not. broken) then - select case(phase_plasticity(ph)) - case (PLASTICITY_NONLOCAL_ID,PLASTICITY_KINEHARDENING_ID) - - myOffset = plasticState(ph)%offsetDeltaState - mySize = plasticState(ph)%sizeDeltaState - plasticState(ph)%state(myOffset + 1:myOffset + mySize,of) = & - plasticState(ph)%state(myOffset + 1:myOffset + mySize,of) + plasticState(ph)%deltaState(1:mySize,of) - end select - endif - -end function constitutive_deltaState - - -module subroutine mech_results(group,ph) +module subroutine mechanical_results(group,ph) character(len=*), intent(in) :: group integer, intent(in) :: ph @@ -705,41 +404,37 @@ module subroutine mech_results(group,ph) select case(phase_plasticity(ph)) case(PLASTICITY_ISOTROPIC_ID) - call plastic_isotropic_results(phase_plasticityInstance(ph),group//'plastic/') + call plastic_isotropic_results(ph,group//'plastic/') case(PLASTICITY_PHENOPOWERLAW_ID) - call plastic_phenopowerlaw_results(phase_plasticityInstance(ph),group//'plastic/') + call plastic_phenopowerlaw_results(ph,group//'plastic/') case(PLASTICITY_KINEHARDENING_ID) - call plastic_kinehardening_results(phase_plasticityInstance(ph),group//'plastic/') + call plastic_kinehardening_results(ph,group//'plastic/') case(PLASTICITY_DISLOTWIN_ID) - call plastic_dislotwin_results(phase_plasticityInstance(ph),group//'plastic/') + call plastic_dislotwin_results(ph,group//'plastic/') case(PLASTICITY_DISLOTUNGSTEN_ID) - call plastic_dislotungsten_results(phase_plasticityInstance(ph),group//'plastic/') + call plastic_dislotungsten_results(ph,group//'plastic/') case(PLASTICITY_NONLOCAL_ID) - call plastic_nonlocal_results(phase_plasticityInstance(ph),group//'plastic/') + call plastic_nonlocal_results(ph,group//'plastic/') end select call crystallite_results(group,ph) -end subroutine mech_results - - module subroutine mech_restart_read(fileHandle) - integer(HID_T), intent(in) :: fileHandle - end subroutine mech_restart_read +end subroutine mechanical_results !-------------------------------------------------------------------------------------------------- !> @brief calculation of stress (P) with time integration based on a residuum in Lp and !> intermediate acceleration of the Newton-Raphson correction !-------------------------------------------------------------------------------------------------- -function integrateStress(F,Delta_t,co,ip,el) result(broken) +function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) - real(pReal), dimension(3,3), intent(in) :: F + real(pReal), dimension(3,3), intent(in) :: F,subFp0,subFi0 real(pReal), intent(in) :: Delta_t integer, intent(in):: el, & ! element index ip, & ! integration point index @@ -791,26 +486,26 @@ function integrateStress(F,Delta_t,co,ip,el) result(broken) ierr, & ! error indicator for LAPACK o, & p, & - m, & ph, & me, & jacoCounterLp, & jacoCounterLi ! counters to check for Jacobian update logical :: error,broken - broken = .true. - call constitutive_plastic_dependentState(crystallite_F(1:3,1:3,co,ip,el),co,ip,el) + broken = .true. ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - Lpguess = crystallite_Lp(1:3,1:3,co,ip,el) ! take as first guess - Liguess = constitutive_mech_Li(ph)%data(1:3,1:3,me) ! take as first guess + call plastic_dependentState(co,ip,el) - call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,co,ip,el)) + Lpguess = phase_mechanical_Lp(ph)%data(1:3,1:3,me) ! take as first guess + Liguess = phase_mechanical_Li(ph)%data(1:3,1:3,me) ! take as first guess + + call math_invert33(invFp_current,devNull,error,subFp0) if (error) return ! error - call math_invert33(invFi_current,devNull,error,crystallite_subFi0(1:3,1:3,co,ip,el)) + call math_invert33(invFi_current,devNull,error,subFi0) if (error) return ! error A = matmul(F,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp @@ -840,11 +535,11 @@ function integrateStress(F,Delta_t,co,ip,el) result(broken) B = math_I3 - Delta_t*Lpguess Fe = matmul(matmul(A,B), invFi_new) - call constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & - Fe, Fi_new, co, ip, el) + call phase_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & + Fe, Fi_new, ph, me) - call constitutive_plastic_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & - S, Fi_new, co, ip, el) + call plastic_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & + S, Fi_new, ph,me) !* 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 @@ -884,8 +579,8 @@ function integrateStress(F,Delta_t,co,ip,el) result(broken) + deltaLp * steplengthLp enddo LpLoop - call constitutive_LiAndItsTangents(Li_constitutive, dLi_dS, dLi_dFi, & - S, Fi_new, co, ip, el) + call phase_LiAndItsTangents(Li_constitutive, dLi_dS, dLi_dFi, & + S, Fi_new, ph,me) !* 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 @@ -935,13 +630,13 @@ function integrateStress(F,Delta_t,co,ip,el) result(broken) call math_invert33(Fp_new,devNull,error,invFp_new) if (error) return ! error - crystallite_P (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) - crystallite_S (1:3,1:3,co,ip,el) = S - crystallite_Lp (1:3,1:3,co,ip,el) = Lpguess - constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = Fi_new - crystallite_Fe (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),invFi_new) + phase_mechanical_P(ph)%data(1:3,1:3,me) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) + phase_mechanical_S(ph)%data(1:3,1:3,me) = S + phase_mechanical_Lp(ph)%data(1:3,1:3,me) = Lpguess + phase_mechanical_Li(ph)%data(1:3,1:3,me) = Liguess + phase_mechanical_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize + phase_mechanical_Fi(ph)%data(1:3,1:3,me) = Fi_new + phase_mechanical_Fe(ph)%data(1:3,1:3,me) = matmul(matmul(F,invFp_new),invFi_new) broken = .false. end function integrateStress @@ -951,9 +646,10 @@ end function integrateStress !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop @@ -969,20 +665,20 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) sizeDotState real(pReal) :: & zeta - real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & + real(pReal), dimension(phase_plasticity_maxSizeDotState) :: & r ! state residuum - real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & + real(pReal), dimension(phase_plasticity_maxSizeDotState,2) :: & dotState ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) + broken = plastic_dotState(Delta_t, co,ip,el,ph,me) if(broken) return sizeDotState = plasticState(ph)%sizeDotState - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t dotState(1:sizeDotState,2) = 0.0_pReal @@ -991,10 +687,10 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) if(nIterationState > 1) dotState(1:sizeDotState,2) = dotState(1:sizeDotState,1) dotState(1:sizeDotState,1) = plasticState(ph)%dotState(:,me) - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) if(broken) exit iteration - broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) + broken = plastic_dotState(Delta_t, co,ip,el,ph,me) if(broken) exit iteration zeta = damper(plasticState(ph)%dotState(:,me),dotState(1:sizeDotState,1),& @@ -1002,13 +698,12 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) * zeta & + dotState(1:sizeDotState,1) * (1.0_pReal - zeta) r(1:sizeDotState) = plasticState(ph)%state (1:sizeDotState,me) & - - plasticState(ph)%subState0(1:sizeDotState,me) & + - subState0 & - plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%state(1:sizeDotState,me) & - r(1:sizeDotState) if (converged(r(1:sizeDotState),plasticState(ph)%state(1:sizeDotState,me),plasticState(ph)%atol(1:sizeDotState))) then - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = plastic_deltaState(ph,me) exit iteration endif @@ -1043,9 +738,10 @@ end function integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop @@ -1063,18 +759,17 @@ function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) + broken = plastic_dotState(Delta_t, co,ip,el,ph,me) if(broken) return sizeDotState = plasticState(ph)%sizeDotState - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & - + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + + plasticState(ph)%dotState(1:sizeDotState,me) * Delta_t - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = plastic_deltaState(ph,me) if(broken) return - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) end function integrateStateEuler @@ -1082,9 +777,10 @@ end function integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop @@ -1097,29 +793,28 @@ function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) ph, & me, & sizeDotState - real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic + real(pReal), dimension(phase_plasticity_maxSizeDotState) :: residuum_plastic ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) + broken = plastic_dotState(Delta_t, co,ip,el,ph,me) if(broken) return sizeDotState = plasticState(ph)%sizeDotState residuum_plastic(1:sizeDotState) = - plasticState(ph)%dotstate(1:sizeDotState,me) * 0.5_pReal * Delta_t - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = plastic_deltaState(ph,me) if(broken) return - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) if(broken) return - broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) + broken = plastic_dotState(Delta_t, co,ip,el,ph,me) if(broken) return broken = .not. converged(residuum_plastic(1:sizeDotState) + 0.5_pReal * plasticState(ph)%dotState(:,me) * Delta_t, & @@ -1132,9 +827,10 @@ end function integrateStateAdaptiveEuler !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the classic Runge Kutta method !--------------------------------------------------------------------------------------------------- -function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateRK4(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el logical :: broken @@ -1151,7 +847,7 @@ function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] - broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) + broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el,A,B,C) end function integrateStateRK4 @@ -1159,9 +855,10 @@ end function integrateStateRK4 !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the Cash-Carp method !--------------------------------------------------------------------------------------------------- -function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateRKCK45(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el logical :: broken @@ -1185,7 +882,7 @@ function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] - broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) + broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el,A,B,C,DB) end function integrateStateRKCK45 @@ -1194,9 +891,10 @@ end function integrateStateRKCK45 !> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an !! embedded explicit Runge-Kutta method !-------------------------------------------------------------------------------------------------- -function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) +function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el,A,B,C,DB) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t real(pReal), dimension(:,:), intent(in) :: A real(pReal), dimension(:), intent(in) :: B, C @@ -1213,13 +911,13 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) ph, & me, & sizeDotState - real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState + real(pReal), dimension(phase_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(Delta_t,co,ip,el,ph,me) + broken = plastic_dotState(Delta_t,co,ip,el,ph,me) if(broken) return sizeDotState = plasticState(ph)%sizeDotState @@ -1234,13 +932,13 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) enddo - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t - broken = integrateStress(F_0 + (F - F_0) * Delta_t * C(stage),Delta_t * C(stage),co,ip,el) + broken = integrateStress(F_0 + (F - F_0) * Delta_t * C(stage),subFp0,subFi0,Delta_t * C(stage),co,ip,el) if(broken) exit - broken = mech_collectDotState(Delta_t*C(stage),co,ip,el,ph,me) + broken = plastic_dotState(Delta_t*C(stage),co,ip,el,ph,me) if(broken) exit enddo @@ -1249,7 +947,7 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (ph)%dotState(:,me) plasticState(ph)%dotState(:,me) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t if(present(DB)) & @@ -1259,11 +957,10 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) if(broken) return - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = plastic_deltaState(ph,me) if(broken) return - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) end function integrateStateRK @@ -1277,7 +974,6 @@ subroutine crystallite_results(group,ph) integer, intent(in) :: ph integer :: ou - real(pReal), allocatable, dimension(:,:,:) :: selected_tensors real(pReal), allocatable, dimension(:,:) :: selected_rotations character(len=:), allocatable :: structureLabel @@ -1288,33 +984,28 @@ subroutine crystallite_results(group,ph) select case (output_constituent(ph)%label(ou)) case('F') - selected_tensors = select_tensors(crystallite_F,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',phase_mechanical_F(ph)%data,'F',& 'deformation gradient','1') case('F_e') - selected_tensors = select_tensors(crystallite_Fe,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',phase_mechanical_Fe(ph)%data,'F_e',& 'elastic deformation gradient','1') case('F_p') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Fp(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',phase_mechanical_Fp(ph)%data,'F_p', & 'plastic deformation gradient','1') case('F_i') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Fi(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',phase_mechanical_Fi(ph)%data,'F_i', & 'inelastic deformation gradient','1') case('L_p') - selected_tensors = select_tensors(crystallite_Lp,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',phase_mechanical_Lp(ph)%data,'L_p', & 'plastic velocity gradient','1/s') case('L_i') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Li(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',phase_mechanical_Li(ph)%data,'L_i', & 'inelastic velocity gradient','1/s') case('P') - selected_tensors = select_tensors(crystallite_P,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',phase_mechanical_P(ph)%data,'P', & 'First Piola-Kirchhoff stress','Pa') case('S') - selected_tensors = select_tensors(crystallite_S,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',phase_mechanical_S(ph)%data,'S', & 'Second Piola-Kirchhoff stress','Pa') case('O') select case(lattice_structure(ph)) @@ -1341,33 +1032,6 @@ subroutine crystallite_results(group,ph) contains - !------------------------------------------------------------------------------------------------ - !> @brief select tensors for output - !------------------------------------------------------------------------------------------------ - function select_tensors(dataset,ph) - - integer, intent(in) :: ph - real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset - real(pReal), allocatable, dimension(:,:,:) :: select_tensors - integer :: el,ip,co,j - - allocate(select_tensors(3,3,count(material_phaseAt==ph)*discretization_nIPs)) - - j=0 - do el = 1, size(material_phaseAt,2) - do ip = 1, discretization_nIPs - do co = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains - if (material_phaseAt(co,el) == ph) then - j = j + 1 - select_tensors(1:3,1:3,j) = dataset(1:3,1:3,co,ip,el) - endif - enddo - enddo - enddo - - end function select_tensors - - !-------------------------------------------------------------------------------------------------- !> @brief select rotations for output !-------------------------------------------------------------------------------------------------- @@ -1397,56 +1061,46 @@ subroutine crystallite_results(group,ph) end subroutine crystallite_results -!-------------------------------------------------------------------------------------------------- -!> @brief Backup data for homog cutback. -!-------------------------------------------------------------------------------------------------- -module subroutine mech_initializeRestorationPoints(ph,me) - - integer, intent(in) :: ph, me - - - constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) - constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) - constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) - plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state0(:,me) - -end subroutine mech_initializeRestorationPoints - - !-------------------------------------------------------------------------------------------------- !> @brief Wind homog inc forward. !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_mech_windForward(ph,me) +module subroutine mechanical_windForward(ph,me) integer, intent(in) :: ph, me - constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) - constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) + phase_mechanical_Fp0(ph)%data(1:3,1:3,me) = phase_mechanical_Fp(ph)%data(1:3,1:3,me) + phase_mechanical_Fi0(ph)%data(1:3,1:3,me) = phase_mechanical_Fi(ph)%data(1:3,1:3,me) + phase_mechanical_F0(ph)%data(1:3,1:3,me) = phase_mechanical_F(ph)%data(1:3,1:3,me) + phase_mechanical_Li0(ph)%data(1:3,1:3,me) = phase_mechanical_Li(ph)%data(1:3,1:3,me) + phase_mechanical_Lp0(ph)%data(1:3,1:3,me) = phase_mechanical_Lp(ph)%data(1:3,1:3,me) + phase_mechanical_S0(ph)%data(1:3,1:3,me) = phase_mechanical_S(ph)%data(1:3,1:3,me) - plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state(:,me) + plasticState(ph)%State0(:,me) = plasticState(ph)%state(:,me) -end subroutine constitutive_mech_windForward +end subroutine mechanical_windForward !-------------------------------------------------------------------------------------------------- !> @brief Forward data after successful increment. ! ToDo: Any guessing for the current states possible? !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_mech_forward() +module subroutine mechanical_forward() integer :: ph do ph = 1, size(plasticState) + phase_mechanical_Fi0(ph) = phase_mechanical_Fi(ph) + phase_mechanical_Fp0(ph) = phase_mechanical_Fp(ph) + phase_mechanical_F0(ph) = phase_mechanical_F(ph) + phase_mechanical_Li0(ph) = phase_mechanical_Li(ph) + phase_mechanical_Lp0(ph) = phase_mechanical_Lp(ph) + phase_mechanical_S0(ph) = phase_mechanical_S(ph) plasticState(ph)%state0 = plasticState(ph)%state - constitutive_mech_Fi0(ph) = constitutive_mech_Fi(ph) - constitutive_mech_Fp0(ph) = constitutive_mech_Fp(ph) - constitutive_mech_Li0(ph) = constitutive_mech_Li(ph) enddo -end subroutine constitutive_mech_forward +end subroutine mechanical_forward @@ -1454,22 +1108,19 @@ end subroutine constitutive_mech_forward !> @brief returns the homogenize elasticity matrix !> ToDo: homogenizedC66 would be more consistent !-------------------------------------------------------------------------------------------------- -module function constitutive_homogenizedC(co,ip,el) result(C) +module function phase_homogenizedC(ph,me) result(C) real(pReal), dimension(6,6) :: C - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element + integer, intent(in) :: ph, me - plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) - case (PLASTICITY_DISLOTWIN_ID) plasticityType - C = plastic_dislotwin_homogenizedC(co,ip,el) - case default plasticityType - C = lattice_C66(1:6,1:6,material_phaseAt(co,el)) - end select plasticityType + plasticType: select case (phase_plasticity(ph)) + case (PLASTICITY_DISLOTWIN_ID) plasticType + C = plastic_dislotwin_homogenizedC(ph,me) + case default plasticType + C = lattice_C66(1:6,1:6,ph) + end select plasticType -end function constitutive_homogenizedC +end function phase_homogenizedC !-------------------------------------------------------------------------------------------------- @@ -1487,41 +1138,41 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal) :: & formerSubStep integer :: & - NiterationCrystallite, & ! number of iterations in crystallite loop - so, ph, me + ph, me, sizeDotState logical :: todo real(pReal) :: subFrac,subStep real(pReal), dimension(3,3) :: & - subLp0, & !< plastic velocity grad at start of crystallite inc - subLi0, & !< intermediate velocity grad at start of crystallite inc + subFp0, & + subFi0, & + subLp0, & + subLi0, & subF0, & subF + real(pReal), dimension(:), allocatable :: subState0 ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - subLi0 = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) - subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + sizeDotState = plasticState(ph)%sizeDotState - plasticState(ph)%subState0(:,me) = plasticState(ph)%partitionedState0(:,me) - do so = 1, phase_Nsources(ph) - sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%partitionedState0(:,me) - enddo - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) - subF0 = crystallite_partitionedF0(1:3,1:3,co,ip,el) + subLi0 = phase_mechanical_Li0(ph)%data(1:3,1:3,me) + subLp0 = phase_mechanical_Lp0(ph)%data(1:3,1:3,me) + subState0 = plasticState(ph)%State0(:,me) + + if (damageState(ph)%sizeState > 0) & + damageState(ph)%subState0(:,me) = damageState(ph)%state0(:,me) + + subFp0 = phase_mechanical_Fp0(ph)%data(1:3,1:3,me) + subFi0 = phase_mechanical_Fi0(ph)%data(1:3,1:3,me) + subF0 = phase_mechanical_F0(ph)%data(1:3,1:3,me) subFrac = 0.0_pReal subStep = 1.0_pReal/num%subStepSizeCryst todo = .true. converged_ = .false. ! pretend failed step of 1/subStepSizeCryst todo = .true. - NiterationCrystallite = 0 cutbackLooping: do while (todo) - NiterationCrystallite = NiterationCrystallite + 1 -!-------------------------------------------------------------------------------------------------- -! wind forward if (converged_) then formerSubStep = subStep subFrac = subFrac + subStep @@ -1531,30 +1182,29 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) if (todo) then subF0 = subF - subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) - subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - plasticState(ph)%subState0(:,me) = plasticState(ph)%state(:,me) - do so = 1, phase_Nsources(ph) - sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%state(:,me) - enddo + subLp0 = phase_mechanical_Lp(ph)%data(1:3,1:3,me) + subLi0 = phase_mechanical_Li(ph)%data(1:3,1:3,me) + subFp0 = phase_mechanical_Fp(ph)%data(1:3,1:3,me) + subFi0 = phase_mechanical_Fi(ph)%data(1:3,1:3,me) + subState0 = plasticState(ph)%state(:,me) + if (damageState(ph)%sizeState > 0) & + damageState(ph)%subState0(:,me) = damageState(ph)%state(:,me) + endif !-------------------------------------------------------------------------------------------------- ! cut back (reduced time and restore) else subStep = num%subStepSizeCryst * subStep - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) - if (subStep < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 - constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 + phase_mechanical_Fp(ph)%data(1:3,1:3,me) = subFp0 + phase_mechanical_Fi(ph)%data(1:3,1:3,me) = subFi0 + phase_mechanical_S(ph)%data(1:3,1:3,me) = phase_mechanical_S0(ph)%data(1:3,1:3,me) ! why no subS0 ? is S0 of any use? + if (subStep < 1.0_pReal) then ! actual (not initial) cutback + phase_mechanical_Lp(ph)%data(1:3,1:3,me) = subLp0 + phase_mechanical_Li(ph)%data(1:3,1:3,me) = subLi0 endif - plasticState(ph)%state(:,me) = plasticState(ph)%subState0(:,me) - do so = 1, phase_Nsources(ph) - sourceState(ph)%p(so)%state(:,me) = sourceState(ph)%p(so)%subState0(:,me) - enddo + plasticState(ph)%state(:,me) = subState0 + if (damageState(ph)%sizeState > 0) & + damageState(ph)%state(:,me) = damageState(ph)%subState0(:,me) todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) endif @@ -1563,12 +1213,11 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) ! prepare for integration if (todo) then subF = subF0 & - + subStep * (crystallite_F(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el)) - crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) - crystallite_subdt(co,ip,el) = subStep * dt - converged_ = .not. integrateState(subF0,subF,subStep * dt,co,ip,el) - converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) + + subStep * (phase_mechanical_F(ph)%data(1:3,1:3,me) - phase_mechanical_F0(ph)%data(1:3,1:3,me)) + phase_mechanical_Fe(ph)%data(1:3,1:3,me) = matmul(subF,math_inv33(matmul(phase_mechanical_Fi(ph)%data(1:3,1:3,me), & + phase_mechanical_Fp(ph)%data(1:3,1:3,me)))) + converged_ = .not. integrateState(subF0,subF,subFp0,subFi0,subState0(1:sizeDotState),subStep * dt,co,ip,el) + converged_ = converged_ .and. .not. integrateDamageState(subStep * dt,co,ip,el) endif enddo cutbackLooping @@ -1579,33 +1228,275 @@ end function crystallite_stress !-------------------------------------------------------------------------------------------------- !> @brief Restore data after homog cutback. !-------------------------------------------------------------------------------------------------- -module subroutine mech_restore(ip,el,includeL) +module subroutine mechanical_restore(ce,includeL) - integer, intent(in) :: & - ip, & !< integration point number - el !< element number + integer, intent(in) :: ce logical, intent(in) :: & includeL !< protect agains fake cutback - integer :: & - co, p, m !< constituent number - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - p = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) + integer :: & + co, ph, me + + + do co = 1,homogenization_Nconstituents(material_homogenizationAt2(ce)) + ph = material_phaseAt2(co,ce) + me = material_phaseMemberAt2(co,ce) if (includeL) then - crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partitionedLi0(p)%data(1:3,1:3,m) + phase_mechanical_Lp(ph)%data(1:3,1:3,me) = phase_mechanical_Lp0(ph)%data(1:3,1:3,me) + phase_mechanical_Li(ph)%data(1:3,1:3,me) = phase_mechanical_Li0(ph)%data(1:3,1:3,me) endif ! maybe protecting everything from overwriting makes more sense - constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFp0(p)%data(1:3,1:3,m) - constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFi0(p)%data(1:3,1:3,m) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) + phase_mechanical_Fp(ph)%data(1:3,1:3,me) = phase_mechanical_Fp0(ph)%data(1:3,1:3,me) + phase_mechanical_Fi(ph)%data(1:3,1:3,me) = phase_mechanical_Fi0(ph)%data(1:3,1:3,me) + phase_mechanical_S(ph)%data(1:3,1:3,me) = phase_mechanical_S0(ph)%data(1:3,1:3,me) - plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phasememberAt(co,ip,el)) + plasticState(ph)%state(:,me) = plasticState(ph)%State0(:,me) enddo -end subroutine mech_restore +end subroutine mechanical_restore -end submodule constitutive_mech +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate tangent (dPdF). +!-------------------------------------------------------------------------------------------------- +module function phase_mechanical_dPdF(dt,co,ce) result(dPdF) + real(pReal), intent(in) :: dt + integer, intent(in) :: & + co, & !< counter in constituent loop + ce + real(pReal), dimension(3,3,3,3) :: dPdF + + integer :: & + o, & + p, ph, me + real(pReal), dimension(3,3) :: devNull, & + invSubFp0,invSubFi0,invFp,invFi, & + temp_33_1, temp_33_2, temp_33_3 + real(pReal), dimension(3,3,3,3) :: dSdFe, & + dSdF, & + dSdFi, & + dLidS, & ! tangent in lattice configuration + dLidFi, & + dLpdS, & + dLpdFi, & + dFidS, & + dFpinvdF, & + rhs_3333, & + lhs_3333, & + temp_3333 + real(pReal), dimension(9,9):: temp_99 + logical :: error + + + ph = material_phaseAt2(co,ce) + me = material_phaseMemberAt2(co,ce) + + call phase_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & + phase_mechanical_Fe(ph)%data(1:3,1:3,me), & + phase_mechanical_Fi(ph)%data(1:3,1:3,me),ph,me) + call phase_LiAndItsTangents(devNull,dLidS,dLidFi, & + phase_mechanical_S(ph)%data(1:3,1:3,me), & + phase_mechanical_Fi(ph)%data(1:3,1:3,me), & + ph,me) + + invFp = math_inv33(phase_mechanical_Fp(ph)%data(1:3,1:3,me)) + invFi = math_inv33(phase_mechanical_Fi(ph)%data(1:3,1:3,me)) + invSubFp0 = math_inv33(phase_mechanical_Fp0(ph)%data(1:3,1:3,me)) + invSubFi0 = math_inv33(phase_mechanical_Fi0(ph)%data(1:3,1:3,me)) + + if (sum(abs(dLidS)) < tol_math_check) then + dFidS = 0.0_pReal + else + lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal + do o=1,3; do p=1,3 + 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)) * dt + lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & + + invFi*invFi(p,o) + rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & + - matmul(invSubFi0,dLidS(1:3,1:3,o,p)) * dt + enddo; enddo + call math_invert(temp_99,error,math_3333to99(lhs_3333)) + if (error) then + call IO_warning(warning_ID=600, & + ext_msg='inversion error in analytic tangent calculation') + dFidS = 0.0_pReal + else + dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) + endif + dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS + endif + + call plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & + phase_mechanical_S(ph)%data(1:3,1:3,me), & + phase_mechanical_Fi(ph)%data(1:3,1:3,me),ph,me) + dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS + +!-------------------------------------------------------------------------------------------------- +! calculate dSdF + temp_33_1 = transpose(matmul(invFp,invFi)) + temp_33_2 = matmul(phase_mechanical_F(ph)%data(1:3,1:3,me),invSubFp0) + temp_33_3 = matmul(matmul(phase_mechanical_F(ph)%data(1:3,1:3,me),invFp), invSubFi0) + + do o=1,3; do p=1,3 + rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) + 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)) + enddo; enddo + lhs_3333 = math_mul3333xx3333(dSdFe,temp_3333) * dt & + + math_mul3333xx3333(dSdFi,dFidS) + + call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) + if (error) then + call IO_warning(warning_ID=600, & + ext_msg='inversion error in analytic tangent calculation') + dSdF = rhs_3333 + else + dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) + endif + +!-------------------------------------------------------------------------------------------------- +! calculate dFpinvdF + temp_3333 = math_mul3333xx3333(dLpdS,dSdF) + do o=1,3; do p=1,3 + dFpinvdF(1:3,1:3,p,o) = - matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) * dt + enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! assemble dPdF + temp_33_1 = matmul(phase_mechanical_S(ph)%data(1:3,1:3,me),transpose(invFp)) + temp_33_2 = matmul(phase_mechanical_F(ph)%data(1:3,1:3,me),invFp) + temp_33_3 = matmul(temp_33_2,phase_mechanical_S(ph)%data(1:3,1:3,me)) + + dPdF = 0.0_pReal + do p=1,3 + dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1)) + enddo + do o=1,3; do p=1,3 + dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & + + matmul(matmul(phase_mechanical_F(ph)%data(1:3,1:3,me),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)),transpose(invFp)) & + + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) + enddo; enddo + +end function phase_mechanical_dPdF + + +module subroutine mechanical_restartWrite(groupHandle,ph) + + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + + + call HDF5_write(groupHandle,plasticState(ph)%state,'omega') + call HDF5_write(groupHandle,phase_mechanical_Fi(ph)%data,'F_i') + call HDF5_write(groupHandle,phase_mechanical_Li(ph)%data,'L_i') + call HDF5_write(groupHandle,phase_mechanical_Lp(ph)%data,'L_p') + call HDF5_write(groupHandle,phase_mechanical_Fp(ph)%data,'F_p') + call HDF5_write(groupHandle,phase_mechanical_S(ph)%data,'S') + call HDF5_write(groupHandle,phase_mechanical_F(ph)%data,'F') + +end subroutine mechanical_restartWrite + + +module subroutine mechanical_restartRead(groupHandle,ph) + + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + + + call HDF5_read(groupHandle,plasticState(ph)%state0,'omega') + call HDF5_read(groupHandle,phase_mechanical_Fi0(ph)%data,'F_i') + call HDF5_read(groupHandle,phase_mechanical_Li0(ph)%data,'L_i') + call HDF5_read(groupHandle,phase_mechanical_Lp0(ph)%data,'L_p') + call HDF5_read(groupHandle,phase_mechanical_Fp0(ph)%data,'F_p') + call HDF5_read(groupHandle,phase_mechanical_S0(ph)%data,'S') + call HDF5_read(groupHandle,phase_mechanical_F0(ph)%data,'F') + +end subroutine mechanical_restartRead + + +!---------------------------------------------------------------------------------------------- +!< @brief Get first Piola-Kichhoff stress (for use by non-mech physics) +!---------------------------------------------------------------------------------------------- +module function mechanical_S(ph,me) result(S) + + integer, intent(in) :: ph,me + real(pReal), dimension(3,3) :: S + + + S = phase_mechanical_S(ph)%data(1:3,1:3,me) + +end function mechanical_S + + +!---------------------------------------------------------------------------------------------- +!< @brief Get plastic velocity gradient (for use by non-mech physics) +!---------------------------------------------------------------------------------------------- +module function mechanical_L_p(ph,me) result(L_p) + + integer, intent(in) :: ph,me + real(pReal), dimension(3,3) :: L_p + + + L_p = phase_mechanical_Lp(ph)%data(1:3,1:3,me) + +end function mechanical_L_p + + +!---------------------------------------------------------------------------------------------- +!< @brief Get deformation gradient (for use by homogenization) +!---------------------------------------------------------------------------------------------- +module function phase_mechanical_getF(co,ce) result(F) + + integer, intent(in) :: co, ce + real(pReal), dimension(3,3) :: F + + + F = phase_mechanical_F(material_phaseAt2(co,ce))%data(1:3,1:3,material_phaseMemberAt2(co,ce)) + +end function phase_mechanical_getF + + +!---------------------------------------------------------------------------------------------- +!< @brief Get elastic deformation gradient (for use by non-mech physics) +!---------------------------------------------------------------------------------------------- +module function mechanical_F_e(ph,me) result(F_e) + + integer, intent(in) :: ph,me + real(pReal), dimension(3,3) :: F_e + + + F_e = phase_mechanical_Fe(ph)%data(1:3,1:3,me) + +end function mechanical_F_e + + + +!---------------------------------------------------------------------------------------------- +!< @brief Get second Piola-Kichhoff stress (for use by homogenization) +!---------------------------------------------------------------------------------------------- +module function phase_mechanical_getP(co,ce) result(P) + + integer, intent(in) :: co, ce + real(pReal), dimension(3,3) :: P + + + P = phase_mechanical_P(material_phaseAt2(co,ce))%data(1:3,1:3,material_phaseMemberAt2(co,ce)) + +end function phase_mechanical_getP + + +! setter for homogenization +module subroutine phase_mechanical_setF(F,co,ce) + + real(pReal), dimension(3,3), intent(in) :: F + integer, intent(in) :: co, ce + + + phase_mechanical_F(material_phaseAt2(co,ce))%data(1:3,1:3,material_phaseMemberAt2(co,ce)) = F + +end subroutine phase_mechanical_setF + + +end submodule mechanical diff --git a/src/phase_mechanical_eigen.f90 b/src/phase_mechanical_eigen.f90 new file mode 100644 index 000000000..eb6d4f219 --- /dev/null +++ b/src/phase_mechanical_eigen.f90 @@ -0,0 +1,228 @@ +submodule(phase:mechanical) eigen + + integer, dimension(:), allocatable :: & + Nmodels + + integer(kind(KINEMATICS_UNDEFINED_ID)), dimension(:,:), allocatable :: & + model + integer(kind(KINEMATICS_UNDEFINED_ID)), dimension(:), allocatable :: & + model_damage + + interface + module function kinematics_cleavage_opening_init() result(myKinematics) + logical, dimension(:), allocatable :: myKinematics + end function kinematics_cleavage_opening_init + + module function kinematics_slipplane_opening_init() result(myKinematics) + logical, dimension(:), allocatable :: myKinematics + end function kinematics_slipplane_opening_init + + module function thermalexpansion_init(kinematics_length) result(myKinematics) + integer, intent(in) :: kinematics_length + logical, dimension(:,:), allocatable :: myKinematics + end function thermalexpansion_init + + module subroutine thermalexpansion_LiAndItsTangent(Li, dLi_dTstar, ph,me) + integer, intent(in) :: ph, me + real(pReal), intent(out), dimension(3,3) :: & + Li !< thermal velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero) + end subroutine thermalexpansion_LiAndItsTangent + + end interface + + +contains + + +module subroutine eigendeformation_init(phases) + + class(tNode), pointer :: & + phases + + integer :: & + ph + class(tNode), pointer :: & + phase, & + kinematics, & + damage, & + mechanics + + print'(/,a)', ' <<<+- phase:mechanical:eigen init -+>>>' + +!-------------------------------------------------------------------------------------------------- +! explicit eigen mechanisms + allocate(Nmodels(phases%length),source = 0) + + do ph = 1,phases%length + phase => phases%get(ph) + mechanics => phase%get('mechanics') + kinematics => mechanics%get('eigen',defaultVal=emptyList) + Nmodels(ph) = kinematics%length + enddo + + allocate(model(maxval(Nmodels),phases%length), source = KINEMATICS_undefined_ID) + + if(maxval(Nmodels) /= 0) then + where(thermalexpansion_init(maxval(Nmodels))) model = KINEMATICS_thermal_expansion_ID + endif + + allocate(model_damage(phases%length), source = KINEMATICS_UNDEFINED_ID) + + where(kinematics_cleavage_opening_init()) model_damage = KINEMATICS_cleavage_opening_ID + where(kinematics_slipplane_opening_init()) model_damage = KINEMATICS_slipplane_opening_ID + + +end subroutine eigendeformation_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a kinematic mechanism is active or not +!-------------------------------------------------------------------------------------------------- +function kinematics_active(kinematics_label,kinematics_length) result(active_kinematics) + + character(len=*), intent(in) :: kinematics_label !< name of kinematic mechanism + integer, intent(in) :: kinematics_length !< max. number of kinematics in system + logical, dimension(:,:), allocatable :: active_kinematics + + class(tNode), pointer :: & + phases, & + phase, & + kinematics, & + kinematics_type, & + mechanics + integer :: p,k + + phases => config_material%get('phase') + allocate(active_kinematics(kinematics_length,phases%length), source = .false. ) + do p = 1, phases%length + phase => phases%get(p) + mechanics => phase%get('mechanics') + kinematics => mechanics%get('eigen',defaultVal=emptyList) + do k = 1, kinematics%length + kinematics_type => kinematics%get(k) + active_kinematics(k,p) = kinematics_type%get_asString('type') == kinematics_label + enddo + enddo + + +end function kinematics_active + + + +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a kinematic mechanism is active or not +!-------------------------------------------------------------------------------------------------- +function kinematics_active2(kinematics_label) result(active_kinematics) + + character(len=*), intent(in) :: kinematics_label !< name of kinematic mechanism + logical, dimension(:), allocatable :: active_kinematics + + class(tNode), pointer :: & + phases, & + phase, & + kinematics, & + kinematics_type + integer :: p + + phases => config_material%get('phase') + allocate(active_kinematics(phases%length), source = .false. ) + do p = 1, phases%length + phase => phases%get(p) + kinematics => phase%get('damage',defaultVal=emptyList) + if(kinematics%length < 1) return + kinematics_type => kinematics%get(1) + if (.not. kinematics_type%contains('type')) continue + active_kinematics(p) = kinematics_type%get_asString('type',defaultVal='n/a') == kinematics_label + enddo + + +end function kinematics_active2 + + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the velocity gradient +! ToDo: MD: S is Mi? +!-------------------------------------------------------------------------------------------------- +module subroutine phase_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & + S, Fi, ph,me) + + integer, intent(in) :: & + ph,me + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola-Kirchhoff stress + real(pReal), intent(in), dimension(3,3) :: & + Fi !< intermediate deformation gradient + real(pReal), intent(out), dimension(3,3) :: & + Li !< intermediate velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLi_dS, & !< derivative of Li with respect to S + dLi_dFi + + real(pReal), dimension(3,3) :: & + my_Li, & !< intermediate velocity gradient + FiInv, & + temp_33 + real(pReal), dimension(3,3,3,3) :: & + my_dLi_dS + real(pReal) :: & + detFi + integer :: & + k, i, j + logical :: active + + active = .false. + Li = 0.0_pReal + dLi_dS = 0.0_pReal + dLi_dFi = 0.0_pReal + + + plasticType: select case (phase_plasticity(ph)) + case (PLASTICITY_isotropic_ID) plasticType + call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,ph,me) + Li = Li + my_Li + dLi_dS = dLi_dS + my_dLi_dS + active = .true. + end select plasticType + + KinematicsLoop: do k = 1, Nmodels(ph) + kinematicsType: select case (model(k,ph)) + case (KINEMATICS_thermal_expansion_ID) kinematicsType + call thermalexpansion_LiAndItsTangent(my_Li, my_dLi_dS, ph,me) + Li = Li + my_Li + dLi_dS = dLi_dS + my_dLi_dS + active = .true. + end select kinematicsType + enddo KinematicsLoop + + select case (model_damage(ph)) + case (KINEMATICS_cleavage_opening_ID) + call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, ph, me) + Li = Li + my_Li + dLi_dS = dLi_dS + my_dLi_dS + active = .true. + case (KINEMATICS_slipplane_opening_ID) + call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, ph, me) + Li = Li + my_Li + dLi_dS = dLi_dS + my_dLi_dS + active = .true. + end select + + if(.not. active) return + + FiInv = math_inv33(Fi) + detFi = math_det33(Fi) + Li = matmul(matmul(Fi,Li),FiInv)*detFi !< push forward to intermediate configuration + temp_33 = matmul(FiInv,Li) + + do i = 1,3; do j = 1,3 + dLi_dS(1:3,1:3,i,j) = matmul(matmul(Fi,dLi_dS(1:3,1:3,i,j)),FiInv)*detFi + dLi_dFi(1:3,1:3,i,j) = dLi_dFi(1:3,1:3,i,j) + Li*FiInv(j,i) + dLi_dFi(1:3,i,1:3,j) = dLi_dFi(1:3,i,1:3,j) + math_I3*temp_33(j,i) + Li*FiInv(j,i) + enddo; enddo + +end subroutine phase_LiAndItsTangents + + +end submodule eigen diff --git a/src/phase_mechanical_eigen_cleavageopening.f90 b/src/phase_mechanical_eigen_cleavageopening.f90 new file mode 100644 index 000000000..0f48be1a4 --- /dev/null +++ b/src/phase_mechanical_eigen_cleavageopening.f90 @@ -0,0 +1,32 @@ +!-------------------------------------------------------------------------------------------------- +!> @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 kinematics_cleavage_opening_init() result(myKinematics) + + logical, dimension(:), allocatable :: myKinematics + + + myKinematics = kinematics_active2('anisobrittle') + if(count(myKinematics) == 0) return + + print'(/,a)', ' <<<+- phase:mechanical:eigen:cleavageopening init -+>>>' + print'(a,i2)', ' # phases: ',count(myKinematics); flush(IO_STDOUT) + +end function kinematics_cleavage_opening_init + + + + +end submodule cleavageopening diff --git a/src/kinematics_slipplane_opening.f90 b/src/phase_mechanical_eigen_slipplaneopening.f90 similarity index 75% rename from src/kinematics_slipplane_opening.f90 rename to src/phase_mechanical_eigen_slipplaneopening.f90 index 84edab122..e8a7d65b9 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/phase_mechanical_eigen_slipplaneopening.f90 @@ -4,7 +4,7 @@ !> @brief material subroutine incorporating kinematics resulting from opening of slip planes !> @details to be done !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_damage) kinematics_slipplane_opening +submodule(phase:eigen) slipplaneopening integer, dimension(:), allocatable :: kinematics_slipplane_opening_instance @@ -32,12 +32,11 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module function kinematics_slipplane_opening_init(kinematics_length) result(myKinematics) +module function kinematics_slipplane_opening_init() result(myKinematics) - integer, intent(in) :: kinematics_length - logical, dimension(:,:), allocatable :: myKinematics + logical, dimension(:), allocatable :: myKinematics - integer :: Ninstances,p,i,k + integer :: p,i character(len=pStringLen) :: extmsg = '' integer, dimension(:), allocatable :: N_sl real(pReal), dimension(:,:), allocatable :: d,n,t @@ -47,30 +46,28 @@ module function kinematics_slipplane_opening_init(kinematics_length) result(myKi mech, & pl, & kinematics, & - kinematic_type - - print'(/,a)', ' <<<+- kinematics_slipplane init -+>>>' + kinematic_type + + + myKinematics = kinematics_active2('isoductile') + if(count(myKinematics) == 0) return + print'(/,a)', ' <<<+- phase:mechanical:eigen:slipplaneopening init -+>>>' + print'(a,i2)', ' # phases: ',count(myKinematics); flush(IO_STDOUT) - myKinematics = kinematics_active('slipplane_opening',kinematics_length) - Ninstances = count(myKinematics) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return phases => config_material%get('phase') - allocate(kinematics_slipplane_opening_instance(phases%length), source=0) - allocate(param(Ninstances)) + allocate(param(phases%length)) do p = 1, phases%length - if(any(myKinematics(:,p))) kinematics_slipplane_opening_instance(p) = count(myKinematics(:,1:p)) - phase => phases%get(p) - mech => phase%get('mechanics') - pl => mech%get('plasticity') - if(count(myKinematics(:,p)) == 0) cycle - kinematics => phase%get('kinematics') - do k = 1, kinematics%length - if(myKinematics(k,p)) then - associate(prm => param(kinematics_slipplane_opening_instance(p))) - kinematic_type => kinematics%get(k) + if(myKinematics(p)) then + phase => phases%get(p) + mech => phase%get('mechanics') + pl => mech%get('plasticity') + + kinematics => phase%get('damage') + + associate(prm => param(p)) + kinematic_type => kinematics%get(1) prm%dot_o = kinematic_type%get_asFloat('dot_o') prm%q = kinematic_type%get_asFloat('q') @@ -105,9 +102,8 @@ module function kinematics_slipplane_opening_init(kinematics_length) result(myKi ! exit if any parameter is out of range if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(slipplane_opening)') - end associate - endif - enddo + end associate + endif enddo @@ -117,12 +113,10 @@ end function kinematics_slipplane_opening_init !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el) +module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ph,me) integer, intent(in) :: & - co, & !< grain number - ip, & !< integration point number - el !< element number + ph, me real(pReal), intent(in), dimension(3,3) :: & S real(pReal), intent(out), dimension(3,3) :: & @@ -131,19 +125,13 @@ module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) integer :: & - instance, phase, & - homog, damageOffset, & i, k, l, m, n real(pReal) :: & traction_d, traction_t, traction_n, traction_crit, & udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt - phase = material_phaseAt(co,el) - instance = kinematics_slipplane_opening_instance(phase) - homog = material_homogenizationAt(el) - damageOffset = material_homogenizationMemberAt(ip,el) - associate(prm => param(instance)) + associate(prm => param(ph)) Ld = 0.0_pReal dLd_dTstar = 0.0_pReal do i = 1, prm%sum_N_sl @@ -152,7 +140,7 @@ module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S traction_t = math_tensordot(S,prm%P_t(1:3,1:3,i)) traction_n = math_tensordot(S,prm%P_n(1:3,1:3,i)) - traction_crit = prm%g_crit(i)* damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage + traction_crit = prm%g_crit(i)* damage_phi(ph,me) udotd = sign(1.0_pReal,traction_d)* prm%dot_o* ( abs(traction_d)/traction_crit & - abs(traction_d)/prm%g_crit(i))**prm%q @@ -193,4 +181,4 @@ module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S end subroutine kinematics_slipplane_opening_LiAndItsTangent -end submodule kinematics_slipplane_opening +end submodule slipplaneopening diff --git a/src/kinematics_thermal_expansion.f90 b/src/phase_mechanical_eigen_thermalexpansion.f90 similarity index 67% rename from src/kinematics_thermal_expansion.f90 rename to src/phase_mechanical_eigen_thermalexpansion.f90 index 6d4a39632..86e7fa907 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/phase_mechanical_eigen_thermalexpansion.f90 @@ -3,7 +3,7 @@ !> @brief material subroutine incorporating kinematics resulting from thermal expansion !> @details to be done !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_thermal) kinematics_thermal_expansion +submodule(phase:eigen) thermalexpansion integer, dimension(:), allocatable :: kinematics_thermal_expansion_instance @@ -16,7 +16,6 @@ submodule(constitutive:constitutive_thermal) kinematics_thermal_expansion type(tParameters), dimension(:), allocatable :: param - contains @@ -24,7 +23,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module function kinematics_thermal_expansion_init(kinematics_length) result(myKinematics) +module function thermalexpansion_init(kinematics_length) result(myKinematics) integer, intent(in) :: kinematics_length logical, dimension(:,:), allocatable :: myKinematics @@ -37,7 +36,7 @@ module function kinematics_thermal_expansion_init(kinematics_length) result(myKi kinematics, & kinematic_type - print'(/,a)', ' <<<+- kinematics_thermal_expansion init -+>>>' + print'(/,a)', ' <<<+- phase:mechanical:eigen:thermalexpansion init -+>>>' myKinematics = kinematics_active('thermal_expansion',kinematics_length) Ninstances = count(myKinematics) @@ -78,48 +77,39 @@ module function kinematics_thermal_expansion_init(kinematics_length) result(myKi enddo -end function kinematics_thermal_expansion_init +end function thermalexpansion_init !-------------------------------------------------------------------------------------------------- !> @brief constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, co, ip, el) +module subroutine thermalexpansion_LiAndItsTangent(Li, dLi_dTstar, ph,me) - integer, intent(in) :: & - co, & !< grain number - ip, & !< integration point number - el !< element number + integer, intent(in) :: ph, me real(pReal), intent(out), dimension(3,3) :: & Li !< thermal velocity gradient real(pReal), intent(out), dimension(3,3,3,3) :: & dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero) - integer :: & - phase, & - homog - real(pReal) :: & - T, TDot + real(pReal) :: T, dot_T - phase = material_phaseAt(co,el) - homog = material_homogenizationAt(el) - T = temperature(homog)%p(material_homogenizationMemberAt(ip,el)) - TDot = temperatureRate(homog)%p(material_homogenizationMemberAt(ip,el)) + T = thermal_T(ph,me) + dot_T = thermal_dot_T(ph,me) - associate(prm => param(kinematics_thermal_expansion_instance(phase))) - Li = TDot * ( & - prm%A(1:3,1:3,1)*(T - prm%T_ref)**0 & ! constant coefficient - + prm%A(1:3,1:3,2)*(T - prm%T_ref)**1 & ! linear coefficient - + prm%A(1:3,1:3,3)*(T - prm%T_ref)**2 & ! quadratic coefficient - ) / & - (1.0_pReal & - + prm%A(1:3,1:3,1)*(T - prm%T_ref)**1 / 1. & - + prm%A(1:3,1:3,2)*(T - prm%T_ref)**2 / 2. & - + prm%A(1:3,1:3,3)*(T - prm%T_ref)**3 / 3. & - ) - end associate + associate(prm => param(kinematics_thermal_expansion_instance(ph))) + Li = dot_T * ( & + prm%A(1:3,1:3,1)*(T - prm%T_ref)**0 & ! constant coefficient + + prm%A(1:3,1:3,2)*(T - prm%T_ref)**1 & ! linear coefficient + + prm%A(1:3,1:3,3)*(T - prm%T_ref)**2 & ! quadratic coefficient + ) / & + (1.0_pReal & + + prm%A(1:3,1:3,1)*(T - prm%T_ref)**1 / 1. & + + prm%A(1:3,1:3,2)*(T - prm%T_ref)**2 / 2. & + + prm%A(1:3,1:3,3)*(T - prm%T_ref)**3 / 3. & + ) + end associate dLi_dTstar = 0.0_pReal -end subroutine kinematics_thermal_expansion_LiAndItsTangent +end subroutine thermalexpansion_LiAndItsTangent -end submodule kinematics_thermal_expansion +end submodule thermalexpansion diff --git a/src/phase_mechanical_plastic.f90 b/src/phase_mechanical_plastic.f90 new file mode 100644 index 000000000..136f0884c --- /dev/null +++ b/src/phase_mechanical_plastic.f90 @@ -0,0 +1,459 @@ +submodule(phase:mechanical) plastic + + interface + + module function plastic_none_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_none_init + + module function plastic_isotropic_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_isotropic_init + + module function plastic_phenopowerlaw_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_phenopowerlaw_init + + module function plastic_kinehardening_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_kinehardening_init + + module function plastic_dislotwin_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_dislotwin_init + + module function plastic_dislotungsten_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_dislotungsten_init + + module function plastic_nonlocal_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_nonlocal_init + + module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,me) + real(pReal), dimension(3,3), intent(out) :: & + Lp + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp + real(pReal), dimension(3,3), intent(in) :: & + Mp + integer, intent(in) :: & + ph, & + me + end subroutine isotropic_LpAndItsTangent + + pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,me) + real(pReal), dimension(3,3), intent(out) :: & + Lp + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp + real(pReal), dimension(3,3), intent(in) :: & + Mp + integer, intent(in) :: & + ph, & + me + end subroutine phenopowerlaw_LpAndItsTangent + + pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,me) + real(pReal), dimension(3,3), intent(out) :: & + Lp + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp + real(pReal), dimension(3,3), intent(in) :: & + Mp + integer, intent(in) :: & + ph, & + me + end subroutine kinehardening_LpAndItsTangent + + module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,ph,me) + real(pReal), dimension(3,3), intent(out) :: & + Lp + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp + + real(pReal), dimension(3,3), intent(in) :: & + Mp + real(pReal), intent(in) :: & + T + integer, intent(in) :: & + ph, & + me + end subroutine dislotwin_LpAndItsTangent + + pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,T,ph,me) + real(pReal), dimension(3,3), intent(out) :: & + Lp + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp + + real(pReal), dimension(3,3), intent(in) :: & + Mp + real(pReal), intent(in) :: & + T + integer, intent(in) :: & + ph, & + me + end subroutine dislotungsten_LpAndItsTangent + + module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, & + Mp,Temperature,ph,me) + real(pReal), dimension(3,3), intent(out) :: & + Lp + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp + + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + Temperature + integer, intent(in) :: & + ph, & + me + end subroutine nonlocal_LpAndItsTangent + + + module subroutine isotropic_dotState(Mp,ph,me) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer, intent(in) :: & + ph, & + me + end subroutine isotropic_dotState + + module subroutine phenopowerlaw_dotState(Mp,ph,me) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer, intent(in) :: & + ph, & + me + end subroutine phenopowerlaw_dotState + + module subroutine plastic_kinehardening_dotState(Mp,ph,me) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer, intent(in) :: & + ph, & + me + end subroutine plastic_kinehardening_dotState + + module subroutine dislotwin_dotState(Mp,T,ph,me) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + T + integer, intent(in) :: & + ph, & + me + end subroutine dislotwin_dotState + + module subroutine dislotungsten_dotState(Mp,T,ph,me) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + T + integer, intent(in) :: & + ph, & + me + end subroutine dislotungsten_dotState + + module subroutine nonlocal_dotState(Mp,Temperature,timestep,ph,me,ip,el) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< MandelStress + real(pReal), intent(in) :: & + Temperature, & !< temperature + timestep !< substepped crystallite time increment + integer, intent(in) :: & + ph, & + me, & + ip, & !< current integration point + el !< current element number + end subroutine nonlocal_dotState + + module subroutine dislotwin_dependentState(T,ph,me) + integer, intent(in) :: & + ph, & + me + real(pReal), intent(in) :: & + T + end subroutine dislotwin_dependentState + + module subroutine dislotungsten_dependentState(ph,me) + integer, intent(in) :: & + ph, & + me + end subroutine dislotungsten_dependentState + + module subroutine nonlocal_dependentState(ph, me, ip, el) + integer, intent(in) :: & + ph, & + me, & + ip, & !< current integration point + el !< current element number + end subroutine nonlocal_dependentState + + module subroutine plastic_kinehardening_deltaState(Mp,ph,me) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer, intent(in) :: & + ph, & + me + end subroutine plastic_kinehardening_deltaState + + module subroutine plastic_nonlocal_deltaState(Mp,ph,me) + real(pReal), dimension(3,3), intent(in) :: & + Mp + integer, intent(in) :: & + ph, & + me + end subroutine plastic_nonlocal_deltaState + + end interface + +contains + +module subroutine plastic_init + + + print'(/,a)', ' <<<+- phase:mechanical:plastic init -+>>>' + + where(plastic_none_init()) phase_plasticity = PLASTICITY_NONE_ID + where(plastic_isotropic_init()) phase_plasticity = PLASTICITY_ISOTROPIC_ID + where(plastic_phenopowerlaw_init()) phase_plasticity = PLASTICITY_PHENOPOWERLAW_ID + where(plastic_kinehardening_init()) phase_plasticity = PLASTICITY_KINEHARDENING_ID + where(plastic_dislotwin_init()) phase_plasticity = PLASTICITY_DISLOTWIN_ID + where(plastic_dislotungsten_init()) phase_plasticity = PLASTICITY_DISLOTUNGSTEN_ID + where(plastic_nonlocal_init()) phase_plasticity = PLASTICITY_NONLOCAL_ID + +end subroutine plastic_init + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the velocity gradient +! ToDo: Discuss whether it makes sense if crystallite handles the configuration conversion, i.e. +! Mp in, dLp_dMp out +!-------------------------------------------------------------------------------------------------- +module subroutine plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & + S, Fi, ph,me) + integer, intent(in) :: & + ph,me + real(pReal), intent(in), dimension(3,3) :: & + S, & !< 2nd Piola-Kirchhoff stress + Fi !< intermediate deformation gradient + real(pReal), intent(out), dimension(3,3) :: & + Lp !< plastic velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLp_dS, & + dLp_dFi !< derivative me Lp with respect to Fi + + real(pReal), dimension(3,3,3,3) :: & + dLp_dMp !< derivative of Lp with respect to Mandel stress + real(pReal), dimension(3,3) :: & + Mp !< Mandel stress work conjugate with Lp + integer :: & + i, j + + + Mp = matmul(matmul(transpose(Fi),Fi),S) + + + plasticType: select case (phase_plasticity(ph)) + + case (PLASTICITY_NONE_ID) plasticType + Lp = 0.0_pReal + dLp_dMp = 0.0_pReal + + case (PLASTICITY_ISOTROPIC_ID) plasticType + call isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,me) + + case (PLASTICITY_PHENOPOWERLAW_ID) plasticType + call phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,me) + + case (PLASTICITY_KINEHARDENING_ID) plasticType + call kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,me) + + case (PLASTICITY_NONLOCAL_ID) plasticType + call nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp, thermal_T(ph,me),ph,me) + + case (PLASTICITY_DISLOTWIN_ID) plasticType + call dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp, thermal_T(ph,me),ph,me) + + case (PLASTICITY_DISLOTUNGSTEN_ID) plasticType + call dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp, thermal_T(ph,me),ph,me) + + end select plasticType + + do i=1,3; do j=1,3 + dLp_dFi(i,j,1:3,1:3) = matmul(matmul(Fi,S),transpose(dLp_dMp(i,j,1:3,1:3))) + & + matmul(matmul(Fi,dLp_dMp(i,j,1:3,1:3)),S) + dLp_dS(i,j,1:3,1:3) = matmul(matmul(transpose(Fi),Fi),dLp_dMp(i,j,1:3,1:3)) ! ToDo: @PS: why not: dLp_dMp:(FiT Fi) + enddo; enddo + +end subroutine plastic_LpAndItsTangents + + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +module function plastic_dotState(subdt,co,ip,el,ph,me) result(broken) + + integer, intent(in) :: & + co, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + ph, & + me + real(pReal), intent(in) :: & + subdt !< timestep + real(pReal), dimension(3,3) :: & + Mp + logical :: broken + + + Mp = matmul(matmul(transpose(phase_mechanical_Fi(ph)%data(1:3,1:3,me)),& + phase_mechanical_Fi(ph)%data(1:3,1:3,me)),phase_mechanical_S(ph)%data(1:3,1:3,me)) + + plasticType: select case (phase_plasticity(ph)) + + case (PLASTICITY_ISOTROPIC_ID) plasticType + call isotropic_dotState(Mp,ph,me) + + case (PLASTICITY_PHENOPOWERLAW_ID) plasticType + call phenopowerlaw_dotState(Mp,ph,me) + + case (PLASTICITY_KINEHARDENING_ID) plasticType + call plastic_kinehardening_dotState(Mp,ph,me) + + case (PLASTICITY_DISLOTWIN_ID) plasticType + call dislotwin_dotState(Mp,thermal_T(ph,me),ph,me) + + case (PLASTICITY_DISLOTUNGSTEN_ID) plasticType + call dislotungsten_dotState(Mp,thermal_T(ph,me),ph,me) + + case (PLASTICITY_NONLOCAL_ID) plasticType + call nonlocal_dotState(Mp,thermal_T(ph,me),subdt,ph,me,ip,el) + end select plasticType + broken = any(IEEE_is_NaN(plasticState(ph)%dotState(:,me))) + + +end function plastic_dotState + + +!-------------------------------------------------------------------------------------------------- +!> @brief calls microstructure function of the different plasticity constitutive models +!-------------------------------------------------------------------------------------------------- +module subroutine plastic_dependentState(co, ip, el) + + integer, intent(in) :: & + co, & !< component-ID of integration point + ip, & !< integration point + el !< element + + integer :: & + ph, & + me + + + ph = material_phaseAt(co,el) + me = material_phasememberAt(co,ip,el) + + plasticType: select case (phase_plasticity(material_phaseAt(co,el))) + + case (PLASTICITY_DISLOTWIN_ID) plasticType + call dislotwin_dependentState(thermal_T(ph,me),ph,me) + + case (PLASTICITY_DISLOTUNGSTEN_ID) plasticType + call dislotungsten_dependentState(ph,me) + + case (PLASTICITY_NONLOCAL_ID) plasticType + call nonlocal_dependentState(ph,me,ip,el) + + end select plasticType + +end subroutine plastic_dependentState + + +!-------------------------------------------------------------------------------------------------- +!> @brief for constitutive models having an instantaneous change of state +!> will return false if delta state is not needed/supported by the constitutive model +!-------------------------------------------------------------------------------------------------- +module function plastic_deltaState(ph, me) result(broken) + + integer, intent(in) :: & + ph, & + me + logical :: & + broken + + real(pReal), dimension(3,3) :: & + Mp + integer :: & + myOffset, & + mySize + + + Mp = matmul(matmul(transpose(phase_mechanical_Fi(ph)%data(1:3,1:3,me)),& + phase_mechanical_Fi(ph)%data(1:3,1:3,me)),phase_mechanical_S(ph)%data(1:3,1:3,me)) + + plasticType: select case (phase_plasticity(ph)) + + case (PLASTICITY_KINEHARDENING_ID) plasticType + call plastic_kinehardening_deltaState(Mp,ph,me) + broken = any(IEEE_is_NaN(plasticState(ph)%deltaState(:,me))) + + case (PLASTICITY_NONLOCAL_ID) plasticType + call plastic_nonlocal_deltaState(Mp,ph,me) + broken = any(IEEE_is_NaN(plasticState(ph)%deltaState(:,me))) + + case default + broken = .false. + + end select plasticType + + if(.not. broken) then + select case(phase_plasticity(ph)) + case (PLASTICITY_NONLOCAL_ID,PLASTICITY_KINEHARDENING_ID) + + myOffset = plasticState(ph)%offsetDeltaState + mySize = plasticState(ph)%sizeDeltaState + plasticState(ph)%state(myOffset + 1:myOffset + mySize,me) = & + plasticState(ph)%state(myOffset + 1:myOffset + mySize,me) + plasticState(ph)%deltaState(1:mySize,me) + end select + endif + +end function plastic_deltaState + + +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a plastic module is active or not +!-------------------------------------------------------------------------------------------------- +function plastic_active(plastic_label) result(active_plastic) + + character(len=*), intent(in) :: plastic_label !< type of plasticity model + logical, dimension(:), allocatable :: active_plastic + + class(tNode), pointer :: & + phases, & + phase, & + mech, & + pl + integer :: ph + + phases => config_material%get('phase') + allocate(active_plastic(phases%length), source = .false. ) + do ph = 1, phases%length + phase => phases%get(ph) + mech => phase%get('mechanics') + pl => mech%get('plasticity') + if(pl%get_asString('type') == plastic_label) active_plastic(ph) = .true. + enddo + +end function plastic_active + +end submodule plastic diff --git a/src/constitutive_plastic_disloTungsten.f90 b/src/phase_mechanical_plastic_dislotungsten.f90 similarity index 82% rename from src/constitutive_plastic_disloTungsten.f90 rename to src/phase_mechanical_plastic_dislotungsten.f90 index c39ae5c2b..1fda51a58 100644 --- a/src/constitutive_plastic_disloTungsten.f90 +++ b/src/phase_mechanical_plastic_dislotungsten.f90 @@ -5,7 +5,7 @@ !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief crystal plasticity model for bcc metals, especially Tungsten !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_mech) plastic_dislotungsten +submodule(phase:plastic) dislotungsten real(pReal), parameter :: & kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin @@ -17,7 +17,7 @@ submodule(constitutive:constitutive_mech) plastic_dislotungsten D_0 = 1.0_pReal, & !< prefactor for self-diffusion coefficient Q_cl = 1.0_pReal !< activation energy for dislocation climb real(pReal), allocatable, dimension(:) :: & - b_sl, & !< magnitude of Burgers vector [m] + b_sl, & !< magnitude me Burgers vector [m] D_a, & i_sl, & !< Adj. parameter for distance between 2 forest dislocations f_at, & !< factor to calculate atomic volume @@ -78,9 +78,8 @@ module function plastic_dislotungsten_init() result(myPlasticity) logical, dimension(:), allocatable :: myPlasticity integer :: & - Ninstances, & - p, i, & - Nconstituents, & + ph, i, & + Nmembers, & sizeState, sizeDotState, & startIndex, endIndex integer, dimension(:), allocatable :: & @@ -97,32 +96,31 @@ module function plastic_dislotungsten_init() result(myPlasticity) mech, & pl - print'(/,a)', ' <<<+- plastic_dislotungsten init -+>>>' myPlasticity = plastic_active('dislotungsten') - Ninstances = count(myPlasticity) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return - + if(count(myPlasticity) == 0) return + + print'(/,a)', ' <<<+- phase:mechanical:plastic:dislotungsten init -+>>>' + print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT) + print*, 'Cereceda et al., International Journal of Plasticity 78:242–256, 2016' print*, 'https://dx.doi.org/10.1016/j.ijplas.2015.09.002' - allocate(param(Ninstances)) - allocate(state(Ninstances)) - allocate(dotState(Ninstances)) - allocate(dependentState(Ninstances)) phases => config_material%get('phase') - i = 0 - do p = 1, phases%length - phase => phases%get(p) + allocate(param(phases%length)) + allocate(state(phases%length)) + allocate(dotState(phases%length)) + allocate(dependentState(phases%length)) + + + do ph = 1, phases%length + if(.not. myPlasticity(ph)) cycle + + associate(prm => param(ph), dot => dotState(ph), stt => state(ph), dst => dependentState(ph)) + + phase => phases%get(ph) mech => phase%get('mechanics') - if(.not. myPlasticity(p)) cycle - i = i + 1 - associate(prm => param(i), & - dot => dotState(i), & - stt => state(i), & - dst => dependentState(i)) pl => mech%get('plasticity') #if defined (__GFORTRAN__) @@ -132,7 +130,7 @@ module function plastic_dislotungsten_init() result(myPlasticity) #endif ! This data is read in already in lattice - prm%mu = lattice_mu(p) + prm%mu = lattice_mu(ph) !-------------------------------------------------------------------------------------------------- ! slip related parameters @@ -222,41 +220,41 @@ module function plastic_dislotungsten_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nconstituents = count(material_phaseAt == p) * discretization_nIPs + Nmembers = count(material_phaseAt2 == ph) sizeDotState = size(['rho_mob ','rho_dip ','gamma_sl']) * prm%sum_N_sl sizeState = sizeDotState - call constitutive_allocateState(plasticState(p),Nconstituents,sizeState,sizeDotState,0) + call phase_allocateState(plasticState(ph),Nmembers,sizeState,sizeDotState,0) !-------------------------------------------------------------------------------------------------- ! state aliases and initialization startIndex = 1 endIndex = prm%sum_N_sl - stt%rho_mob => plasticState(p)%state(startIndex:endIndex,:) - stt%rho_mob = spread(rho_mob_0,2,Nconstituents) - dot%rho_mob => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) - if (any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_rho' + stt%rho_mob => plasticState(ph)%state(startIndex:endIndex,:) + stt%rho_mob = spread(rho_mob_0,2,Nmembers) + dot%rho_mob => plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) + if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_rho' startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl - stt%rho_dip => plasticState(p)%state(startIndex:endIndex,:) - stt%rho_dip = spread(rho_dip_0,2,Nconstituents) - dot%rho_dip => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) + stt%rho_dip => plasticState(ph)%state(startIndex:endIndex,:) + stt%rho_dip = spread(rho_dip_0,2,Nmembers) + dot%rho_dip => plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl - stt%gamma_sl => plasticState(p)%state(startIndex:endIndex,:) - dot%gamma_sl => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = 1.0e-2_pReal + stt%gamma_sl => plasticState(ph)%state(startIndex:endIndex,:) + dot%gamma_sl => plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = 1.0e-2_pReal ! global alias - plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(ph)%slipRate => plasticState(ph)%dotState(startIndex:endIndex,:) - allocate(dst%Lambda_sl(prm%sum_N_sl,Nconstituents), source=0.0_pReal) - allocate(dst%threshold_stress(prm%sum_N_sl,Nconstituents), source=0.0_pReal) + allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers), source=0.0_pReal) + allocate(dst%threshold_stress(prm%sum_N_sl,Nmembers), source=0.0_pReal) - plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally + plasticState(ph)%state0 = plasticState(ph)%state ! ToDo: this could be done centrally end associate @@ -272,8 +270,8 @@ end function plastic_dislotungsten_init !-------------------------------------------------------------------------------------------------- !> @brief Calculate plastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -pure module subroutine plastic_dislotungsten_LpAndItsTangent(Lp,dLp_dMp, & - Mp,T,instance,of) +pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, & + Mp,T,ph,me) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -284,21 +282,21 @@ pure module subroutine plastic_dislotungsten_LpAndItsTangent(Lp,dLp_dMp, & real(pReal), intent(in) :: & T !< temperature integer, intent(in) :: & - instance, & - of + ph, & + me integer :: & i,k,l,m,n - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & dot_gamma_pos,dot_gamma_neg, & ddot_gamma_dtau_pos,ddot_gamma_dtau_neg Lp = 0.0_pReal dLp_dMp = 0.0_pReal - associate(prm => param(instance)) + associate(prm => param(ph)) - call kinetics(Mp,T,instance,of,dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg) + call kinetics(Mp,T,ph,me,dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg) 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) forall (k=1:3,l=1:3,m=1:3,n=1:3) & @@ -309,25 +307,25 @@ pure module subroutine plastic_dislotungsten_LpAndItsTangent(Lp,dLp_dMp, & end associate -end subroutine plastic_dislotungsten_LpAndItsTangent +end subroutine dislotungsten_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotungsten_dotState(Mp,T,instance,of) +module subroutine dislotungsten_dotState(Mp,T,ph,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & T !< temperature integer, intent(in) :: & - instance, & - of + ph, & + me real(pReal) :: & VacancyDiffusion - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & gdot_pos, gdot_neg,& tau_pos,& tau_neg, & @@ -336,13 +334,14 @@ module subroutine plastic_dislotungsten_dotState(Mp,T,instance,of) dot_rho_dip_climb, & dip_distance - associate(prm => param(instance), stt => state(instance),dot => dotState(instance), dst => dependentState(instance)) + associate(prm => param(ph), stt => state(ph),& + dot => dotState(ph), dst => dependentState(ph)) - call kinetics(Mp,T,instance,of,& + call kinetics(Mp,T,ph,me,& gdot_pos,gdot_neg, & tau_pos_out = tau_pos,tau_neg_out = tau_neg) - dot%gamma_sl(:,of) = (gdot_pos+gdot_neg) ! ToDo: needs to be abs + dot%gamma_sl(:,me) = (gdot_pos+gdot_neg) ! ToDo: needs to be abs VacancyDiffusion = prm%D_0*exp(-prm%Q_cl/(kB*T)) where(dEq0(tau_pos)) ! ToDo: use avg of pos and neg @@ -351,63 +350,63 @@ module subroutine plastic_dislotungsten_dotState(Mp,T,instance,of) else where dip_distance = math_clip(3.0_pReal*prm%mu*prm%b_sl/(16.0_pReal*PI*abs(tau_pos)), & prm%D_a, & ! lower limit - dst%Lambda_sl(:,of)) ! upper limit - dot_rho_dip_formation = merge(2.0_pReal*dip_distance* stt%rho_mob(:,of)*abs(dot%gamma_sl(:,of))/prm%b_sl, & ! ToDo: ignore region of spontaneous annihilation + dst%Lambda_sl(:,me)) ! upper limit + dot_rho_dip_formation = merge(2.0_pReal*dip_distance* stt%rho_mob(:,me)*abs(dot%gamma_sl(:,me))/prm%b_sl, & ! ToDo: ignore region of spontaneous annihilation 0.0_pReal, & prm%dipoleformation) v_cl = (3.0_pReal*prm%mu*VacancyDiffusion*prm%f_at/(2.0_pReal*pi*kB*T)) & * (1.0_pReal/(dip_distance+prm%D_a)) - dot_rho_dip_climb = (4.0_pReal*v_cl*stt%rho_dip(:,of))/(dip_distance-prm%D_a) ! ToDo: Discuss with Franz: Stress dependency? + dot_rho_dip_climb = (4.0_pReal*v_cl*stt%rho_dip(:,me))/(dip_distance-prm%D_a) ! ToDo: Discuss with Franz: Stress dependency? end where - dot%rho_mob(:,of) = abs(dot%gamma_sl(:,of))/(prm%b_sl*dst%Lambda_sl(:,of)) & ! multiplication + dot%rho_mob(:,me) = abs(dot%gamma_sl(:,me))/(prm%b_sl*dst%Lambda_sl(:,me)) & ! multiplication - dot_rho_dip_formation & - - (2.0_pReal*prm%D_a)/prm%b_sl*stt%rho_mob(:,of)*abs(dot%gamma_sl(:,of)) ! Spontaneous annihilation of 2 single edge dislocations - dot%rho_dip(:,of) = dot_rho_dip_formation & - - (2.0_pReal*prm%D_a)/prm%b_sl*stt%rho_dip(:,of)*abs(dot%gamma_sl(:,of)) & ! Spontaneous annihilation of a single edge dislocation with a dipole constituent + - (2.0_pReal*prm%D_a)/prm%b_sl*stt%rho_mob(:,me)*abs(dot%gamma_sl(:,me)) ! Spontaneous annihilation of 2 single edge dislocations + dot%rho_dip(:,me) = dot_rho_dip_formation & + - (2.0_pReal*prm%D_a)/prm%b_sl*stt%rho_dip(:,me)*abs(dot%gamma_sl(:,me)) & ! Spontaneous annihilation of a single edge dislocation with a dipole constituent - dot_rho_dip_climb end associate -end subroutine plastic_dislotungsten_dotState +end subroutine dislotungsten_dotState !-------------------------------------------------------------------------------------------------- !> @brief Calculate derived quantities from state. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotungsten_dependentState(instance,of) +module subroutine dislotungsten_dependentState(ph,me) integer, intent(in) :: & - instance, & - of + ph, & + me - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & dislocationSpacing - associate(prm => param(instance), stt => state(instance),dst => dependentState(instance)) + associate(prm => param(ph), stt => state(ph),dst => dependentState(ph)) - dislocationSpacing = sqrt(matmul(prm%forestProjection,stt%rho_mob(:,of)+stt%rho_dip(:,of))) - dst%threshold_stress(:,of) = prm%mu*prm%b_sl & - * sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,of)+stt%rho_dip(:,of))) + dislocationSpacing = sqrt(matmul(prm%forestProjection,stt%rho_mob(:,me)+stt%rho_dip(:,me))) + dst%threshold_stress(:,me) = prm%mu*prm%b_sl & + * sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,me)+stt%rho_dip(:,me))) - dst%Lambda_sl(:,of) = prm%D/(1.0_pReal+prm%D*dislocationSpacing/prm%i_sl) + dst%Lambda_sl(:,me) = prm%D/(1.0_pReal+prm%D*dislocationSpacing/prm%i_sl) end associate -end subroutine plastic_dislotungsten_dependentState +end subroutine dislotungsten_dependentState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotungsten_results(instance,group) +module subroutine plastic_dislotungsten_results(ph,group) - integer, intent(in) :: instance + integer, intent(in) :: ph character(len=*), intent(in) :: group integer :: o - associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) + associate(prm => param(ph), stt => state(ph), dst => dependentState(ph)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case('rho_mob') @@ -439,7 +438,7 @@ end subroutine plastic_dislotungsten_results ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics(Mp,T,instance,of, & +pure subroutine kinetics(Mp,T,ph,me, & dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg,tau_pos_out,tau_neg_out) real(pReal), dimension(3,3), intent(in) :: & @@ -447,18 +446,18 @@ pure subroutine kinetics(Mp,T,instance,of, & real(pReal), intent(in) :: & T !< temperature integer, intent(in) :: & - instance, & - of + ph, & + me - real(pReal), intent(out), dimension(param(instance)%sum_N_sl) :: & + real(pReal), intent(out), dimension(param(ph)%sum_N_sl) :: & dot_gamma_pos, & dot_gamma_neg - real(pReal), intent(out), optional, dimension(param(instance)%sum_N_sl) :: & + real(pReal), intent(out), optional, dimension(param(ph)%sum_N_sl) :: & ddot_gamma_dtau_pos, & ddot_gamma_dtau_neg, & tau_pos_out, & tau_neg_out - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & StressRatio, & StressRatio_p,StressRatio_pminus1, & dvel, vel, & @@ -467,7 +466,7 @@ pure subroutine kinetics(Mp,T,instance,of, & needsGoodName ! ToDo: @Karo: any idea? integer :: j - associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) + associate(prm => param(ph), stt => state(ph), dst => dependentState(ph)) do j = 1, prm%sum_N_sl tau_pos(j) = math_tensordot(Mp,prm%nonSchmid_pos(1:3,1:3,j)) @@ -479,11 +478,11 @@ pure subroutine kinetics(Mp,T,instance,of, & if (present(tau_neg_out)) tau_neg_out = tau_neg associate(BoltzmannRatio => prm%Q_s/(kB*T), & - dot_gamma_0 => stt%rho_mob(:,of)*prm%b_sl*prm%v_0, & - effectiveLength => dst%Lambda_sl(:,of) - prm%w) + dot_gamma_0 => stt%rho_mob(:,me)*prm%b_sl*prm%v_0, & + effectiveLength => dst%Lambda_sl(:,me) - prm%w) - significantPositiveTau: where(abs(tau_pos)-dst%threshold_stress(:,of) > tol_math_check) - StressRatio = (abs(tau_pos)-dst%threshold_stress(:,of))/prm%tau_Peierls + significantPositiveTau: where(abs(tau_pos)-dst%threshold_stress(:,me) > tol_math_check) + StressRatio = (abs(tau_pos)-dst%threshold_stress(:,me))/prm%tau_Peierls StressRatio_p = StressRatio** prm%p StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal) needsGoodName = exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) @@ -499,7 +498,7 @@ pure subroutine kinetics(Mp,T,instance,of, & end where significantPositiveTau if (present(ddot_gamma_dtau_pos)) then - significantPositiveTau2: where(abs(tau_pos)-dst%threshold_stress(:,of) > tol_math_check) + significantPositiveTau2: where(abs(tau_pos)-dst%threshold_stress(:,me) > tol_math_check) dtn = -1.0_pReal * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pReal-StressRatio_p)**(prm%q - 1.0_pReal) & * (StressRatio)**(prm%p - 1.0_pReal) / prm%tau_Peierls dtk = -1.0_pReal * t_k / tau_pos @@ -512,8 +511,8 @@ pure subroutine kinetics(Mp,T,instance,of, & end where significantPositiveTau2 endif - significantNegativeTau: where(abs(tau_neg)-dst%threshold_stress(:,of) > tol_math_check) - StressRatio = (abs(tau_neg)-dst%threshold_stress(:,of))/prm%tau_Peierls + significantNegativeTau: where(abs(tau_neg)-dst%threshold_stress(:,me) > tol_math_check) + StressRatio = (abs(tau_neg)-dst%threshold_stress(:,me))/prm%tau_Peierls StressRatio_p = StressRatio** prm%p StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal) needsGoodName = exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) @@ -529,7 +528,7 @@ pure subroutine kinetics(Mp,T,instance,of, & end where significantNegativeTau if (present(ddot_gamma_dtau_neg)) then - significantNegativeTau2: where(abs(tau_neg)-dst%threshold_stress(:,of) > tol_math_check) + significantNegativeTau2: where(abs(tau_neg)-dst%threshold_stress(:,me) > tol_math_check) dtn = -1.0_pReal * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pReal-StressRatio_p)**(prm%q - 1.0_pReal) & * (StressRatio)**(prm%p - 1.0_pReal) / prm%tau_Peierls dtk = -1.0_pReal * t_k / tau_neg @@ -547,4 +546,4 @@ pure subroutine kinetics(Mp,T,instance,of, & end subroutine kinetics -end submodule plastic_dislotungsten +end submodule dislotungsten diff --git a/src/constitutive_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 similarity index 76% rename from src/constitutive_plastic_dislotwin.f90 rename to src/phase_mechanical_plastic_dislotwin.f90 index 0474427fe..5500ae731 100644 --- a/src/constitutive_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -7,7 +7,7 @@ !> @brief material subroutine incoprorating dislocation and twinning physics !> @details to be done !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_mech) plastic_dislotwin +submodule(phase:plastic) dislotwin real(pReal), parameter :: & kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin @@ -24,7 +24,6 @@ submodule(constitutive:constitutive_mech) plastic_dislotwin q_sb = 1.0_pReal, & !< q-exponent in shear band velocity D_a = 1.0_pReal, & !< adjustment parameter to calculate minimum dipole distance i_tw = 1.0_pReal, & !< adjustment parameter to calculate MFP for twinning - tau_0 = 1.0_pReal, & !< strength due to elements in solid solution L_tw = 1.0_pReal, & !< Length of twin nuclei in Burgers vectors L_tr = 1.0_pReal, & !< Length of trans nuclei in Burgers vectors x_c_tw = 1.0_pReal, & !< critical distance for formation of twin nucleus @@ -48,11 +47,12 @@ submodule(constitutive:constitutive_mech) plastic_dislotwin dot_N_0_tr, & !< trans nucleation rate [1/m³s] for each trans system t_tw, & !< twin thickness [m] for each twin system i_sl, & !< Adj. parameter for distance between 2 forest dislocations for each slip system - t_tr, & !< martensite lamellar thickness [m] for each trans system and instance + t_tr, & !< martensite lamellar thickness [m] for each trans system p, & !< p-exponent in glide velocity q, & !< q-exponent in glide velocity r, & !< r-exponent in twin nucleation rate s, & !< s-exponent in trans nucleation rate + tau_0, & !< strength due to elements in solid solution gamma_char, & !< characteristic shear for twins B !< drag coefficient real(pReal), allocatable, dimension(:,:) :: & @@ -81,7 +81,7 @@ submodule(constitutive:constitutive_mech) plastic_dislotwin logical :: & ExtendedDislocations, & !< consider split into partials for climb calculation fccTwinTransNucleation, & !< twinning and transformation models are for fcc - dipoleFormation !< flag indicating consideration of dipole formation + omitDipoles !< flag controlling consideration of dipole formation end type !< container type for internal constitutive parameters type :: tDislotwinState @@ -126,9 +126,8 @@ module function plastic_dislotwin_init() result(myPlasticity) logical, dimension(:), allocatable :: myPlasticity integer :: & - Ninstances, & - p, i, & - Nconstituents, & + ph, i, & + Nmembers, & sizeState, sizeDotState, & startIndex, endIndex integer, dimension(:), allocatable :: & @@ -144,13 +143,13 @@ module function plastic_dislotwin_init() result(myPlasticity) mech, & pl - print'(/,a)', ' <<<+- plastic_dislotwin init -+>>>' myPlasticity = plastic_active('dislotwin') - Ninstances = count(myPlasticity) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return - + if(count(myPlasticity) == 0) return + + print'(/,a)', ' <<<+- phase:mechanical:plastic:dislotwin init -+>>>' + print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT) + print*, 'Ma and Roters, Acta Materialia 52(12):3603–3612, 2004' print*, 'https://doi.org/10.1016/j.actamat.2004.04.012'//IO_EOL @@ -160,22 +159,21 @@ module function plastic_dislotwin_init() result(myPlasticity) print*, 'Wong et al., Acta Materialia 118:140–151, 2016' print*, 'https://doi.org/10.1016/j.actamat.2016.07.032' - allocate(param(Ninstances)) - allocate(state(Ninstances)) - allocate(dotState(Ninstances)) - allocate(dependentState(Ninstances)) phases => config_material%get('phase') - i = 0 - do p = 1, phases%length - phase => phases%get(p) + allocate(param(phases%length)) + allocate(state(phases%length)) + allocate(dotState(phases%length)) + allocate(dependentState(phases%length)) + + + do ph = 1, phases%length + if(.not. myPlasticity(ph)) cycle + + associate(prm => param(ph), dot => dotState(ph), stt => state(ph), dst => dependentState(ph)) + + phase => phases%get(ph) mech => phase%get('mechanics') - if(.not. myPlasticity(p)) cycle - i = i + 1 - associate(prm => param(i), & - dot => dotState(i), & - stt => state(i), & - dst => dependentState(i)) pl => mech%get('plasticity') #if defined (__GFORTRAN__) @@ -185,9 +183,9 @@ module function plastic_dislotwin_init() result(myPlasticity) #endif ! This data is read in already in lattice - prm%mu = lattice_mu(p) - prm%nu = lattice_nu(p) - prm%C66 = lattice_C66(1:6,1:6,p) + prm%mu = lattice_mu(ph) + prm%nu = lattice_nu(ph) + prm%C66 = lattice_C66(1:6,1:6,ph) !-------------------------------------------------------------------------------------------------- ! slip related parameters @@ -204,8 +202,7 @@ module function plastic_dislotwin_init() result(myPlasticity) prm%n0_sl = lattice_slip_normal(N_sl,phase%get_asString('lattice'),& phase%get_asFloat('c/a',defaultVal=0.0_pReal)) - prm%fccTwinTransNucleation = merge(.true., .false., lattice_structure(p) == lattice_FCC_ID) & - .and. (N_sl(1) == 12) + prm%fccTwinTransNucleation = lattice_structure(ph) == lattice_FCC_ID .and. (N_sl(1) == 12) if(prm%fccTwinTransNucleation) prm%fcc_twinNucleationSlipPair = lattice_FCC_TWINNUCLEATIONSLIPPAIR rho_mob_0 = pl%get_asFloats('rho_mob_0', requiredSize=size(N_sl)) @@ -216,10 +213,10 @@ module function plastic_dislotwin_init() result(myPlasticity) prm%i_sl = pl%get_asFloats('i_sl', requiredSize=size(N_sl)) prm%p = pl%get_asFloats('p_sl', requiredSize=size(N_sl)) prm%q = pl%get_asFloats('q_sl', requiredSize=size(N_sl)) + prm%tau_0 = pl%get_asFloats('tau_0', requiredSize=size(N_sl)) prm%B = pl%get_asFloats('B', requiredSize=size(N_sl), & defaultVal=[(0.0_pReal, i=1,size(N_sl))]) - prm%tau_0 = pl%get_asFloat('tau_0') prm%D_a = pl%get_asFloat('D_a') prm%D_0 = pl%get_asFloat('D_0') prm%Q_cl = pl%get_asFloat('Q_cl') @@ -229,12 +226,12 @@ module function plastic_dislotwin_init() result(myPlasticity) prm%dGamma_sf_dT = pl%get_asFloat('dGamma_sf_dT') endif - prm%dipoleformation = .not. pl%get_asBool('no_dipole_formation',defaultVal = .false.) + prm%omitDipoles = pl%get_asBool('omit_dipoles',defaultVal = .false.) ! multiplication factor according to crystal structure (nearest neighbors bcc vs fcc/hex) ! details: Argon & Moffat, Acta Metallurgica, Vol. 29, pg 293 to 299, 1981 prm%omega = pl%get_asFloat('omega', defaultVal = 1000.0_pReal) & - * merge(12.0_pReal,8.0_pReal,any(lattice_structure(p) == [lattice_FCC_ID,lattice_HEX_ID])) + * merge(12.0_pReal,8.0_pReal,any(lattice_structure(ph) == [lattice_FCC_ID,lattice_HEX_ID])) ! expand: family => system rho_mob_0 = math_expand(rho_mob_0, N_sl) @@ -245,6 +242,7 @@ module function plastic_dislotwin_init() result(myPlasticity) prm%i_sl = math_expand(prm%i_sl, N_sl) prm%p = math_expand(prm%p, N_sl) prm%q = math_expand(prm%q, N_sl) + prm%tau_0 = math_expand(prm%tau_0, N_sl) prm%B = math_expand(prm%B, N_sl) ! sanity checks @@ -342,7 +340,7 @@ module function plastic_dislotwin_init() result(myPlasticity) pl%get_asFloat('a_cI', defaultVal=0.0_pReal), & pl%get_asFloat('a_cF', defaultVal=0.0_pReal)) - if (lattice_structure(p) /= lattice_FCC_ID) then + if (lattice_structure(ph) /= lattice_FCC_ID) then prm%dot_N_0_tr = pl%get_asFloats('dot_N_0_tr') prm%dot_N_0_tr = math_expand(prm%dot_N_0_tr,N_tr) endif @@ -357,7 +355,7 @@ module function plastic_dislotwin_init() result(myPlasticity) if ( prm%i_tr < 0.0_pReal) extmsg = trim(extmsg)//' i_tr' if (any(prm%t_tr < 0.0_pReal)) extmsg = trim(extmsg)//' t_tr' if (any(prm%s < 0.0_pReal)) extmsg = trim(extmsg)//' p_tr' - if (lattice_structure(p) /= lattice_FCC_ID) then + if (lattice_structure(ph) /= lattice_FCC_ID) then if (any(prm%dot_N_0_tr < 0.0_pReal)) extmsg = trim(extmsg)//' dot_N_0_tr' endif else transActive @@ -408,68 +406,68 @@ module function plastic_dislotwin_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nconstituents = count(material_phaseAt == p) * discretization_nIPs + Nmembers = count(material_phaseAt2 == ph) sizeDotState = size(['rho_mob ','rho_dip ','gamma_sl']) * prm%sum_N_sl & + size(['f_tw']) * prm%sum_N_tw & + size(['f_tr']) * prm%sum_N_tr sizeState = sizeDotState - call constitutive_allocateState(plasticState(p),Nconstituents,sizeState,sizeDotState,0) + call phase_allocateState(plasticState(ph),Nmembers,sizeState,sizeDotState,0) !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and atol startIndex = 1 endIndex = prm%sum_N_sl - stt%rho_mob=>plasticState(p)%state(startIndex:endIndex,:) - stt%rho_mob= spread(rho_mob_0,2,Nconstituents) - dot%rho_mob=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) - if (any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_rho' + stt%rho_mob=>plasticState(ph)%state(startIndex:endIndex,:) + stt%rho_mob= spread(rho_mob_0,2,Nmembers) + dot%rho_mob=>plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) + if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_rho' startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl - stt%rho_dip=>plasticState(p)%state(startIndex:endIndex,:) - stt%rho_dip= spread(rho_dip_0,2,Nconstituents) - dot%rho_dip=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) + stt%rho_dip=>plasticState(ph)%state(startIndex:endIndex,:) + stt%rho_dip= spread(rho_dip_0,2,Nmembers) + dot%rho_dip=>plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl - stt%gamma_sl=>plasticState(p)%state(startIndex:endIndex,:) - dot%gamma_sl=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = 1.0e-2_pReal + stt%gamma_sl=>plasticState(ph)%state(startIndex:endIndex,:) + dot%gamma_sl=>plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = 1.0e-2_pReal ! global alias - plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(ph)%slipRate => plasticState(ph)%dotState(startIndex:endIndex,:) startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_tw - stt%f_tw=>plasticState(p)%state(startIndex:endIndex,:) - dot%f_tw=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('f_twin',defaultVal=1.0e-7_pReal) - if (any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' f_twin' + stt%f_tw=>plasticState(ph)%state(startIndex:endIndex,:) + dot%f_tw=>plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_f_tw',defaultVal=1.0e-7_pReal) + if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_f_tw' startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_tr - stt%f_tr=>plasticState(p)%state(startIndex:endIndex,:) - dot%f_tr=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('f_trans',defaultVal=1.0e-6_pReal) - if (any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' f_trans' + stt%f_tr=>plasticState(ph)%state(startIndex:endIndex,:) + dot%f_tr=>plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_f_tr',defaultVal=1.0e-6_pReal) + if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_f_tr' - allocate(dst%Lambda_sl (prm%sum_N_sl,Nconstituents),source=0.0_pReal) - allocate(dst%tau_pass (prm%sum_N_sl,Nconstituents),source=0.0_pReal) + allocate(dst%Lambda_sl (prm%sum_N_sl,Nmembers),source=0.0_pReal) + allocate(dst%tau_pass (prm%sum_N_sl,Nmembers),source=0.0_pReal) - allocate(dst%Lambda_tw (prm%sum_N_tw,Nconstituents),source=0.0_pReal) - allocate(dst%tau_hat_tw (prm%sum_N_tw,Nconstituents),source=0.0_pReal) - allocate(dst%tau_r_tw (prm%sum_N_tw,Nconstituents),source=0.0_pReal) - allocate(dst%V_tw (prm%sum_N_tw,Nconstituents),source=0.0_pReal) + allocate(dst%Lambda_tw (prm%sum_N_tw,Nmembers),source=0.0_pReal) + allocate(dst%tau_hat_tw (prm%sum_N_tw,Nmembers),source=0.0_pReal) + allocate(dst%tau_r_tw (prm%sum_N_tw,Nmembers),source=0.0_pReal) + allocate(dst%V_tw (prm%sum_N_tw,Nmembers),source=0.0_pReal) - allocate(dst%Lambda_tr (prm%sum_N_tr,Nconstituents),source=0.0_pReal) - allocate(dst%tau_hat_tr (prm%sum_N_tr,Nconstituents),source=0.0_pReal) - allocate(dst%tau_r_tr (prm%sum_N_tr,Nconstituents),source=0.0_pReal) - allocate(dst%V_tr (prm%sum_N_tr,Nconstituents),source=0.0_pReal) + allocate(dst%Lambda_tr (prm%sum_N_tr,Nmembers),source=0.0_pReal) + allocate(dst%tau_hat_tr (prm%sum_N_tr,Nmembers),source=0.0_pReal) + allocate(dst%tau_r_tr (prm%sum_N_tr,Nmembers),source=0.0_pReal) + allocate(dst%V_tr (prm%sum_N_tr,Nmembers),source=0.0_pReal) - plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally + plasticState(ph)%state0 = plasticState(ph)%state ! ToDo: this could be done centrally end associate @@ -485,35 +483,32 @@ end function plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- !> @brief Return the homogenized elasticity matrix. !-------------------------------------------------------------------------------------------------- -module function plastic_dislotwin_homogenizedC(co,ip,el) result(homogenizedC) +module function plastic_dislotwin_homogenizedC(ph,me) result(homogenizedC) + integer, intent(in) :: & + ph, me real(pReal), dimension(6,6) :: & homogenizedC - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - integer :: i, & - of + integer :: i real(pReal) :: f_unrotated - of = material_phasememberAt(co,ip,el) - associate(prm => param(phase_plasticityInstance(material_phaseAt(co,el))),& - stt => state(phase_plasticityInstance(material_phaseAT(co,el)))) + + associate(prm => param(ph),& + stt => state(ph)) f_unrotated = 1.0_pReal & - - sum(stt%f_tw(1:prm%sum_N_tw,of)) & - - sum(stt%f_tr(1:prm%sum_N_tr,of)) + - sum(stt%f_tw(1:prm%sum_N_tw,me)) & + - sum(stt%f_tr(1:prm%sum_N_tr,me)) homogenizedC = f_unrotated * prm%C66 do i=1,prm%sum_N_tw homogenizedC = homogenizedC & - + stt%f_tw(i,of)*prm%C66_tw(1:6,1:6,i) + + stt%f_tw(i,me)*prm%C66_tw(1:6,1:6,i) enddo do i=1,prm%sum_N_tr homogenizedC = homogenizedC & - + stt%f_tr(i,of)*prm%C66_tr(1:6,1:6,i) + + stt%f_tr(i,me)*prm%C66_tr(1:6,1:6,i) enddo end associate @@ -524,12 +519,12 @@ end function plastic_dislotwin_homogenizedC !-------------------------------------------------------------------------------------------------- !> @brief Calculate plastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) +module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,ph,me) real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp real(pReal), dimension(3,3), intent(in) :: Mp - integer, intent(in) :: instance,of + integer, intent(in) :: ph,me real(pReal), intent(in) :: T integer :: i,k,l,m,n @@ -538,12 +533,12 @@ module subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) BoltzmannRatio, & ddot_gamma_dtau, & tau - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & dot_gamma_sl,ddot_gamma_dtau_slip - real(pReal), dimension(param(instance)%sum_N_tw) :: & - dot_gamma_twin,ddot_gamma_dtau_twin - real(pReal), dimension(param(instance)%sum_N_tr) :: & - dot_gamma_tr,ddot_gamma_dtau_trans + real(pReal), dimension(param(ph)%sum_N_tw) :: & + dot_gamma_tw,ddot_gamma_dtau_tw + real(pReal), dimension(param(ph)%sum_N_tr) :: & + dot_gamma_tr,ddot_gamma_dtau_tr real(pReal):: dot_gamma_sb real(pReal), dimension(3,3) :: eigVectors, P_sb real(pReal), dimension(3) :: eigValues @@ -567,16 +562,16 @@ module subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) 0, 1, 1 & ],pReal),[ 3,6]) - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(ph), stt => state(ph)) f_unrotated = 1.0_pReal & - - sum(stt%f_tw(1:prm%sum_N_tw,of)) & - - sum(stt%f_tr(1:prm%sum_N_tr,of)) + - sum(stt%f_tw(1:prm%sum_N_tw,me)) & + - sum(stt%f_tr(1:prm%sum_N_tr,me)) Lp = 0.0_pReal dLp_dMp = 0.0_pReal - call kinetics_slip(Mp,T,instance,of,dot_gamma_sl,ddot_gamma_dtau_slip) + call kinetics_slip(Mp,T,ph,me,dot_gamma_sl,ddot_gamma_dtau_slip) slipContribution: do i = 1, prm%sum_N_sl Lp = Lp + dot_gamma_sl(i)*prm%P_sl(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & @@ -584,20 +579,20 @@ module subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) + ddot_gamma_dtau_slip(i) * prm%P_sl(k,l,i) * prm%P_sl(m,n,i) enddo slipContribution - call kinetics_twin(Mp,T,dot_gamma_sl,instance,of,dot_gamma_twin,ddot_gamma_dtau_twin) + call kinetics_twin(Mp,T,dot_gamma_sl,ph,me,dot_gamma_tw,ddot_gamma_dtau_tw) twinContibution: do i = 1, prm%sum_N_tw - Lp = Lp + dot_gamma_twin(i)*prm%P_tw(1:3,1:3,i) + Lp = Lp + dot_gamma_tw(i)*prm%P_tw(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & - + ddot_gamma_dtau_twin(i)* prm%P_tw(k,l,i)*prm%P_tw(m,n,i) + + ddot_gamma_dtau_tw(i)* prm%P_tw(k,l,i)*prm%P_tw(m,n,i) enddo twinContibution - call kinetics_trans(Mp,T,dot_gamma_sl,instance,of,dot_gamma_tr,ddot_gamma_dtau_trans) + call kinetics_trans(Mp,T,dot_gamma_sl,ph,me,dot_gamma_tr,ddot_gamma_dtau_tr) transContibution: do i = 1, prm%sum_N_tr Lp = Lp + dot_gamma_tr(i)*prm%P_tr(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & - + ddot_gamma_dtau_trans(i)* prm%P_tr(k,l,i)*prm%P_tr(m,n,i) + + ddot_gamma_dtau_tr(i)* prm%P_tr(k,l,i)*prm%P_tr(m,n,i) enddo transContibution Lp = Lp * f_unrotated @@ -631,213 +626,193 @@ module subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) end associate -end subroutine plastic_dislotwin_LpAndItsTangent +end subroutine dislotwin_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotwin_dotState(Mp,T,instance,of) +module subroutine dislotwin_dotState(Mp,T,ph,me) real(pReal), dimension(3,3), intent(in):: & Mp !< Mandel stress real(pReal), intent(in) :: & T !< temperature at integration point integer, intent(in) :: & - instance, & - of + ph, & + me integer :: i real(pReal) :: & f_unrotated, & rho_dip_distance, & v_cl, & !< climb velocity - Gamma, & !< stacking fault energy tau, & sigma_cl, & !< climb stress b_d !< ratio of Burgers vector to stacking fault width - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & dot_rho_dip_formation, & dot_rho_dip_climb, & rho_dip_distance_min, & dot_gamma_sl - real(pReal), dimension(param(instance)%sum_N_tw) :: & - dot_gamma_twin - real(pReal), dimension(param(instance)%sum_N_tr) :: & + real(pReal), dimension(param(ph)%sum_N_tw) :: & + dot_gamma_tw + real(pReal), dimension(param(ph)%sum_N_tr) :: & dot_gamma_tr - associate(prm => param(instance), stt => state(instance), & - dot => dotState(instance), dst => dependentState(instance)) + associate(prm => param(ph), stt => state(ph), & + dot => dotState(ph), dst => dependentState(ph)) f_unrotated = 1.0_pReal & - - sum(stt%f_tw(1:prm%sum_N_tw,of)) & - - sum(stt%f_tr(1:prm%sum_N_tr,of)) + - sum(stt%f_tw(1:prm%sum_N_tw,me)) & + - sum(stt%f_tr(1:prm%sum_N_tr,me)) - call kinetics_slip(Mp,T,instance,of,dot_gamma_sl) - dot%gamma_sl(:,of) = abs(dot_gamma_sl) + call kinetics_slip(Mp,T,ph,me,dot_gamma_sl) + dot%gamma_sl(:,me) = abs(dot_gamma_sl) rho_dip_distance_min = prm%D_a*prm%b_sl slipState: do i = 1, prm%sum_N_sl tau = math_tensordot(Mp,prm%P_sl(1:3,1:3,i)) - significantSlipStress: if (dEq0(tau)) then + significantSlipStress: if (dEq0(tau) .or. prm%omitDipoles) then dot_rho_dip_formation(i) = 0.0_pReal dot_rho_dip_climb(i) = 0.0_pReal else significantSlipStress rho_dip_distance = 3.0_pReal*prm%mu*prm%b_sl(i)/(16.0_pReal*PI*abs(tau)) - rho_dip_distance = math_clip(rho_dip_distance, right = dst%Lambda_sl(i,of)) + rho_dip_distance = math_clip(rho_dip_distance, right = dst%Lambda_sl(i,me)) rho_dip_distance = math_clip(rho_dip_distance, left = rho_dip_distance_min(i)) - if (prm%dipoleFormation) then - dot_rho_dip_formation(i) = 2.0_pReal*(rho_dip_distance-rho_dip_distance_min(i))/prm%b_sl(i) & - * stt%rho_mob(i,of)*abs(dot_gamma_sl(i)) - else - dot_rho_dip_formation(i) = 0.0_pReal - endif + dot_rho_dip_formation(i) = 2.0_pReal*(rho_dip_distance-rho_dip_distance_min(i))/prm%b_sl(i) & + * stt%rho_mob(i,me)*abs(dot_gamma_sl(i)) if (dEq(rho_dip_distance,rho_dip_distance_min(i))) then dot_rho_dip_climb(i) = 0.0_pReal else - !@details: Refer: Argon & Moffat, Acta Metallurgica, Vol. 29, pg 293 to 299, 1981 + ! Argon & Moffat, Acta Metallurgica, Vol. 29, pg 293 to 299, 1981 sigma_cl = dot_product(prm%n0_sl(1:3,i),matmul(Mp,prm%n0_sl(1:3,i))) - if (prm%ExtendedDislocations) then - Gamma = prm%Gamma_sf_0K + prm%dGamma_sf_dT * T - b_d = 24.0_pReal*PI*(1.0_pReal - prm%nu)/(2.0_pReal + prm%nu)* Gamma/(prm%mu*prm%b_sl(i)) - else - b_d = 1.0_pReal - endif + b_d = merge(24.0_pReal*PI*(1.0_pReal - prm%nu)/(2.0_pReal + prm%nu) & + * (prm%Gamma_sf_0K + prm%dGamma_sf_dT * T) / (prm%mu*prm%b_sl(i)), & + 1.0_pReal, & + prm%ExtendedDislocations) v_cl = 2.0_pReal*prm%omega*b_d**2.0_pReal*exp(-prm%Q_cl/(kB*T)) & * (exp(abs(sigma_cl)*prm%b_sl(i)**3.0_pReal/(kB*T)) - 1.0_pReal) - dot_rho_dip_climb(i) = 4.0_pReal*v_cl*stt%rho_dip(i,of) & + dot_rho_dip_climb(i) = 4.0_pReal*v_cl*stt%rho_dip(i,me) & / (rho_dip_distance-rho_dip_distance_min(i)) endif endif significantSlipStress enddo slipState - dot%rho_mob(:,of) = abs(dot_gamma_sl)/(prm%b_sl*dst%Lambda_sl(:,of)) & + dot%rho_mob(:,me) = abs(dot_gamma_sl)/(prm%b_sl*dst%Lambda_sl(:,me)) & - dot_rho_dip_formation & - - 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_mob(:,of)*abs(dot_gamma_sl) + - 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_mob(:,me)*abs(dot_gamma_sl) - dot%rho_dip(:,of) = dot_rho_dip_formation & - - 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_dip(:,of)*abs(dot_gamma_sl) & + dot%rho_dip(:,me) = dot_rho_dip_formation & + - 2.0_pReal*rho_dip_distance_min/prm%b_sl * stt%rho_dip(:,me)*abs(dot_gamma_sl) & - dot_rho_dip_climb - call kinetics_twin(Mp,T,dot_gamma_sl,instance,of,dot_gamma_twin) - dot%f_tw(:,of) = f_unrotated*dot_gamma_twin/prm%gamma_char + call kinetics_twin(Mp,T,dot_gamma_sl,ph,me,dot_gamma_tw) + dot%f_tw(:,me) = f_unrotated*dot_gamma_tw/prm%gamma_char - call kinetics_trans(Mp,T,dot_gamma_sl,instance,of,dot_gamma_tr) - dot%f_tr(:,of) = f_unrotated*dot_gamma_tr + call kinetics_trans(Mp,T,dot_gamma_sl,ph,me,dot_gamma_tr) + dot%f_tr(:,me) = f_unrotated*dot_gamma_tr end associate -end subroutine plastic_dislotwin_dotState +end subroutine dislotwin_dotState !-------------------------------------------------------------------------------------------------- !> @brief Calculate derived quantities from state. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotwin_dependentState(T,instance,of) +module subroutine dislotwin_dependentState(T,ph,me) integer, intent(in) :: & - instance, & - of + ph, & + me real(pReal), intent(in) :: & T real(pReal) :: & - sumf_twin,Gamma,sumf_trans - real(pReal), dimension(param(instance)%sum_N_sl) :: & - inv_lambda_sl_sl, & !< 1/mean free distance between 2 forest dislocations seen by a moving dislocation - inv_lambda_sl_tw, & !< 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation - inv_lambda_sl_tr !< 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation - real(pReal), dimension(param(instance)%sum_N_tw) :: & + sumf_tw,Gamma,sumf_tr + real(pReal), dimension(param(ph)%sum_N_sl) :: & + inv_lambda_sl + real(pReal), dimension(param(ph)%sum_N_tw) :: & inv_lambda_tw_tw, & !< 1/mean free distance between 2 twin stacks from different systems seen by a growing twin f_over_t_tw - real(pReal), dimension(param(instance)%sum_N_tr) :: & + real(pReal), dimension(param(ph)%sum_N_tr) :: & inv_lambda_tr_tr, & !< 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite f_over_t_tr real(pReal), dimension(:), allocatable :: & x0 - associate(prm => param(instance),& - stt => state(instance),& - dst => dependentState(instance)) + associate(prm => param(ph),& + stt => state(ph),& + dst => dependentState(ph)) - sumf_twin = sum(stt%f_tw(1:prm%sum_N_tw,of)) - sumf_trans = sum(stt%f_tr(1:prm%sum_N_tr,of)) + sumf_tw = sum(stt%f_tw(1:prm%sum_N_tw,me)) + sumf_tr = sum(stt%f_tr(1:prm%sum_N_tr,me)) Gamma = prm%Gamma_sf_0K + prm%dGamma_sf_dT * T !* rescaled volume fraction for topology - f_over_t_tw = stt%f_tw(1:prm%sum_N_tw,of)/prm%t_tw ! this is per system ... - f_over_t_tr = sumf_trans/prm%t_tr ! but this not + f_over_t_tw = stt%f_tw(1:prm%sum_N_tw,me)/prm%t_tw ! this is per system ... + f_over_t_tr = sumf_tr/prm%t_tr ! but this not ! ToDo ...Physically correct, but naming could be adjusted - inv_lambda_sl_sl = sqrt(matmul(prm%forestProjection, & - stt%rho_mob(:,of)+stt%rho_dip(:,of)))/prm%i_sl - + inv_lambda_sl = sqrt(matmul(prm%forestProjection,stt%rho_mob(:,me)+stt%rho_dip(:,me)))/prm%i_sl if (prm%sum_N_tw > 0 .and. prm%sum_N_sl > 0) & - inv_lambda_sl_tw = matmul(prm%h_sl_tw,f_over_t_tw)/(1.0_pReal-sumf_twin) - - inv_lambda_tw_tw = matmul(prm%h_tw_tw,f_over_t_tw)/(1.0_pReal-sumf_twin) - + inv_lambda_sl = inv_lambda_sl + matmul(prm%h_sl_tw,f_over_t_tw)/(1.0_pReal-sumf_tw) if (prm%sum_N_tr > 0 .and. prm%sum_N_sl > 0) & - inv_lambda_sl_tr = matmul(prm%h_sl_tr,f_over_t_tr)/(1.0_pReal-sumf_trans) + inv_lambda_sl = inv_lambda_sl + matmul(prm%h_sl_tr,f_over_t_tr)/(1.0_pReal-sumf_tr) + dst%Lambda_sl(:,me) = prm%D / (1.0_pReal+prm%D*inv_lambda_sl) - inv_lambda_tr_tr = matmul(prm%h_tr_tr,f_over_t_tr)/(1.0_pReal-sumf_trans) + inv_lambda_tw_tw = matmul(prm%h_tw_tw,f_over_t_tw)/(1.0_pReal-sumf_tw) + dst%Lambda_tw(:,me) = prm%i_tw*prm%D/(1.0_pReal+prm%D*inv_lambda_tw_tw) - if ((prm%sum_N_tw > 0) .or. (prm%sum_N_tr > 0)) then ! ToDo: better logic needed here - dst%Lambda_sl(:,of) = prm%D & - / (1.0_pReal+prm%D*(inv_lambda_sl_sl + inv_lambda_sl_tw + inv_lambda_sl_tr)) - else - dst%Lambda_sl(:,of) = prm%D & - / (1.0_pReal+prm%D*inv_lambda_sl_sl) !!!!!! correct? - endif - - dst%Lambda_tw(:,of) = prm%i_tw*prm%D/(1.0_pReal+prm%D*inv_lambda_tw_tw) - dst%Lambda_tr(:,of) = prm%i_tr*prm%D/(1.0_pReal+prm%D*inv_lambda_tr_tr) + inv_lambda_tr_tr = matmul(prm%h_tr_tr,f_over_t_tr)/(1.0_pReal-sumf_tr) + dst%Lambda_tr(:,me) = prm%i_tr*prm%D/(1.0_pReal+prm%D*inv_lambda_tr_tr) !* threshold stress for dislocation motion - dst%tau_pass(:,of) = prm%mu*prm%b_sl* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,of)+stt%rho_dip(:,of))) + dst%tau_pass(:,me) = prm%mu*prm%b_sl* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,me)+stt%rho_dip(:,me))) !* threshold stress for growing twin/martensite if(prm%sum_N_tw == prm%sum_N_sl) & - dst%tau_hat_tw(:,of) = Gamma/(3.0_pReal*prm%b_tw) & + dst%tau_hat_tw(:,me) = Gamma/(3.0_pReal*prm%b_tw) & + 3.0_pReal*prm%b_tw*prm%mu/(prm%L_tw*prm%b_sl) ! slip Burgers here correct? if(prm%sum_N_tr == prm%sum_N_sl) & - dst%tau_hat_tr(:,of) = Gamma/(3.0_pReal*prm%b_tr) & + dst%tau_hat_tr(:,me) = Gamma/(3.0_pReal*prm%b_tr) & + 3.0_pReal*prm%b_tr*prm%mu/(prm%L_tr*prm%b_sl) & ! slip Burgers here correct? + prm%h*prm%delta_G/ (3.0_pReal*prm%b_tr) - dst%V_tw(:,of) = (PI/4.0_pReal)*prm%t_tw*dst%Lambda_tw(:,of)**2.0_pReal - dst%V_tr(:,of) = (PI/4.0_pReal)*prm%t_tr*dst%Lambda_tr(:,of)**2.0_pReal + dst%V_tw(:,me) = (PI/4.0_pReal)*prm%t_tw*dst%Lambda_tw(:,me)**2.0_pReal + dst%V_tr(:,me) = (PI/4.0_pReal)*prm%t_tr*dst%Lambda_tr(:,me)**2.0_pReal x0 = prm%mu*prm%b_tw**2.0_pReal/(Gamma*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) ! ToDo: In the paper, this is the Burgers vector for slip and is the same for twin and trans - dst%tau_r_tw(:,of) = prm%mu*prm%b_tw/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tw)+cos(pi/3.0_pReal)/x0) + dst%tau_r_tw(:,me) = prm%mu*prm%b_tw/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tw)+cos(pi/3.0_pReal)/x0) x0 = prm%mu*prm%b_tr**2.0_pReal/(Gamma*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) ! ToDo: In the paper, this is the Burgers vector for slip - dst%tau_r_tr(:,of) = prm%mu*prm%b_tr/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tr)+cos(pi/3.0_pReal)/x0) + dst%tau_r_tr(:,me) = prm%mu*prm%b_tr/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tr)+cos(pi/3.0_pReal)/x0) end associate -end subroutine plastic_dislotwin_dependentState +end subroutine dislotwin_dependentState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotwin_results(instance,group) +module subroutine plastic_dislotwin_results(ph,group) - integer, intent(in) :: instance + integer, intent(in) :: ph character(len=*), intent(in) :: group integer :: o - associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) + associate(prm => param(ph), stt => state(ph), dst => dependentState(ph)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) @@ -885,7 +860,7 @@ end subroutine plastic_dislotwin_results ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_slip(Mp,T,instance,of, & +pure subroutine kinetics_slip(Mp,T,ph,me, & dot_gamma_sl,ddot_gamma_dtau_slip,tau_slip) real(pReal), dimension(3,3), intent(in) :: & @@ -893,18 +868,18 @@ pure subroutine kinetics_slip(Mp,T,instance,of, & real(pReal), intent(in) :: & T !< temperature integer, intent(in) :: & - instance, & - of + ph, & + me - real(pReal), dimension(param(instance)%sum_N_sl), intent(out) :: & + real(pReal), dimension(param(ph)%sum_N_sl), intent(out) :: & dot_gamma_sl - real(pReal), dimension(param(instance)%sum_N_sl), optional, intent(out) :: & + real(pReal), dimension(param(ph)%sum_N_sl), optional, intent(out) :: & ddot_gamma_dtau_slip, & tau_slip - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & ddot_gamma_dtau - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & tau, & stressRatio, & StressRatio_p, & @@ -917,13 +892,13 @@ pure subroutine kinetics_slip(Mp,T,instance,of, & tau_eff !< effective resolved stress integer :: i - associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) + associate(prm => param(ph), stt => state(ph), dst => dependentState(ph)) do i = 1, prm%sum_N_sl tau(i) = math_tensordot(Mp,prm%P_sl(1:3,1:3,i)) enddo - tau_eff = abs(tau)-dst%tau_pass(:,of) + tau_eff = abs(tau)-dst%tau_pass(:,me) significantStress: where(tau_eff > tol_math_check) stressRatio = tau_eff/prm%tau_0 @@ -932,7 +907,7 @@ pure subroutine kinetics_slip(Mp,T,instance,of, & v_wait_inverse = prm%v_0**(-1.0_pReal) * exp(BoltzmannRatio*(1.0_pReal-StressRatio_p)** prm%q) v_run_inverse = prm%B/(tau_eff*prm%b_sl) - dot_gamma_sl = sign(stt%rho_mob(:,of)*prm%b_sl/(v_wait_inverse+v_run_inverse),tau) + dot_gamma_sl = sign(stt%rho_mob(:,me)*prm%b_sl/(v_wait_inverse+v_run_inverse),tau) dV_wait_inverse_dTau = -1.0_pReal * v_wait_inverse * prm%p * prm%q * BoltzmannRatio & * (stressRatio**(prm%p-1.0_pReal)) & @@ -941,7 +916,7 @@ pure subroutine kinetics_slip(Mp,T,instance,of, & dV_run_inverse_dTau = -1.0_pReal * v_run_inverse/tau_eff dV_dTau = -1.0_pReal * (dV_wait_inverse_dTau+dV_run_inverse_dTau) & / (v_wait_inverse+v_run_inverse)**2.0_pReal - ddot_gamma_dtau = dV_dTau*stt%rho_mob(:,of)*prm%b_sl + ddot_gamma_dtau = dV_dTau*stt%rho_mob(:,me)*prm%b_sl else where significantStress dot_gamma_sl = 0.0_pReal ddot_gamma_dtau = 0.0_pReal @@ -962,25 +937,25 @@ end subroutine kinetics_slip ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end. !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& - dot_gamma_twin,ddot_gamma_dtau_twin) +pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,ph,me,& + dot_gamma_tw,ddot_gamma_dtau_tw) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & T !< temperature integer, intent(in) :: & - instance, & - of - real(pReal), dimension(param(instance)%sum_N_sl), intent(in) :: & + ph, & + me + real(pReal), dimension(param(ph)%sum_N_sl), intent(in) :: & dot_gamma_sl - real(pReal), dimension(param(instance)%sum_N_tw), intent(out) :: & - dot_gamma_twin - real(pReal), dimension(param(instance)%sum_N_tw), optional, intent(out) :: & - ddot_gamma_dtau_twin + real(pReal), dimension(param(ph)%sum_N_tw), intent(out) :: & + dot_gamma_tw + real(pReal), dimension(param(ph)%sum_N_tw), optional, intent(out) :: & + ddot_gamma_dtau_tw - real, dimension(param(instance)%sum_N_tw) :: & + real, dimension(param(ph)%sum_N_tw) :: & tau, & Ndot0, & stressRatio_r, & @@ -988,18 +963,18 @@ pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& integer :: i,s1,s2 - associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) + associate(prm => param(ph), stt => state(ph), dst => dependentState(ph)) do i = 1, prm%sum_N_tw tau(i) = math_tensordot(Mp,prm%P_tw(1:3,1:3,i)) isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) - if (tau(i) < dst%tau_r_tw(i,of)) then ! ToDo: correct? - Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,of)+stt%rho_dip(s2,of))+& - abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,of)+stt%rho_dip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state + if (tau(i) < dst%tau_r_tw(i,me)) then ! ToDo: correct? + Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,me)+stt%rho_dip(s2,me))+& + abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,me)+stt%rho_dip(s1,me)))/& ! ToDo: MD: it would be more consistent to use shearrates from state (prm%L_tw*prm%b_sl(i))*& - (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tw(i,of)-tau(i)))) ! P_ncs + (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tw(i,me)-tau(i)))) ! P_ncs else Ndot0=0.0_pReal end if @@ -1009,17 +984,17 @@ pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& enddo significantStress: where(tau > tol_math_check) - StressRatio_r = (dst%tau_hat_tw(:,of)/tau)**prm%r - dot_gamma_twin = prm%gamma_char * dst%V_tw(:,of) * Ndot0*exp(-StressRatio_r) - ddot_gamma_dtau = (dot_gamma_twin*prm%r/tau)*StressRatio_r + StressRatio_r = (dst%tau_hat_tw(:,me)/tau)**prm%r + dot_gamma_tw = prm%gamma_char * dst%V_tw(:,me) * Ndot0*exp(-StressRatio_r) + ddot_gamma_dtau = (dot_gamma_tw*prm%r/tau)*StressRatio_r else where significantStress - dot_gamma_twin = 0.0_pReal + dot_gamma_tw = 0.0_pReal ddot_gamma_dtau = 0.0_pReal end where significantStress end associate - if(present(ddot_gamma_dtau_twin)) ddot_gamma_dtau_twin = ddot_gamma_dtau + if(present(ddot_gamma_dtau_tw)) ddot_gamma_dtau_tw = ddot_gamma_dtau end subroutine kinetics_twin @@ -1031,43 +1006,43 @@ end subroutine kinetics_twin ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end. !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& - dot_gamma_tr,ddot_gamma_dtau_trans) +pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,ph,me,& + dot_gamma_tr,ddot_gamma_dtau_tr) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & T !< temperature integer, intent(in) :: & - instance, & - of - real(pReal), dimension(param(instance)%sum_N_sl), intent(in) :: & + ph, & + me + real(pReal), dimension(param(ph)%sum_N_sl), intent(in) :: & dot_gamma_sl - real(pReal), dimension(param(instance)%sum_N_tr), intent(out) :: & + real(pReal), dimension(param(ph)%sum_N_tr), intent(out) :: & dot_gamma_tr - real(pReal), dimension(param(instance)%sum_N_tr), optional, intent(out) :: & - ddot_gamma_dtau_trans + real(pReal), dimension(param(ph)%sum_N_tr), optional, intent(out) :: & + ddot_gamma_dtau_tr - real, dimension(param(instance)%sum_N_tr) :: & + real, dimension(param(ph)%sum_N_tr) :: & tau, & Ndot0, & stressRatio_s, & ddot_gamma_dtau integer :: i,s1,s2 - associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) + associate(prm => param(ph), stt => state(ph), dst => dependentState(ph)) do i = 1, prm%sum_N_tr tau(i) = math_tensordot(Mp,prm%P_tr(1:3,1:3,i)) isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) - if (tau(i) < dst%tau_r_tr(i,of)) then ! ToDo: correct? - Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,of)+stt%rho_dip(s2,of))+& - abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,of)+stt%rho_dip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state + if (tau(i) < dst%tau_r_tr(i,me)) then ! ToDo: correct? + Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,me)+stt%rho_dip(s2,me))+& + abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,me)+stt%rho_dip(s1,me)))/& ! ToDo: MD: it would be more consistent to use shearrates from state (prm%L_tr*prm%b_sl(i))*& - (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tr(i,of)-tau(i)))) ! P_ncs + (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tr(i,me)-tau(i)))) ! P_ncs else Ndot0=0.0_pReal end if @@ -1077,8 +1052,8 @@ pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& enddo significantStress: where(tau > tol_math_check) - StressRatio_s = (dst%tau_hat_tr(:,of)/tau)**prm%s - dot_gamma_tr = dst%V_tr(:,of) * Ndot0*exp(-StressRatio_s) + StressRatio_s = (dst%tau_hat_tr(:,me)/tau)**prm%s + dot_gamma_tr = dst%V_tr(:,me) * Ndot0*exp(-StressRatio_s) ddot_gamma_dtau = (dot_gamma_tr*prm%s/tau)*StressRatio_s else where significantStress dot_gamma_tr = 0.0_pReal @@ -1087,8 +1062,8 @@ pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& end associate - if(present(ddot_gamma_dtau_trans)) ddot_gamma_dtau_trans = ddot_gamma_dtau + if(present(ddot_gamma_dtau_tr)) ddot_gamma_dtau_tr = ddot_gamma_dtau end subroutine kinetics_trans -end submodule plastic_dislotwin +end submodule dislotwin diff --git a/src/constitutive_plastic_isotropic.f90 b/src/phase_mechanical_plastic_isotropic.f90 similarity index 73% rename from src/constitutive_plastic_isotropic.f90 rename to src/phase_mechanical_plastic_isotropic.f90 index b7c5f67c1..d02436fba 100644 --- a/src/constitutive_plastic_isotropic.f90 +++ b/src/phase_mechanical_plastic_isotropic.f90 @@ -7,7 +7,7 @@ !! resolving the stress on the slip systems. Will give the response of phenopowerlaw for an !! untextured polycrystal !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_mech) plastic_isotropic +submodule(phase:plastic) isotropic type :: tParameters real(pReal) :: & @@ -22,8 +22,6 @@ submodule(constitutive:constitutive_mech) plastic_isotropic c_4, & c_3, & c_2 - integer :: & - of_debug = 0 logical :: & dilatation character(len=pStringLen), allocatable, dimension(:) :: & @@ -53,10 +51,8 @@ module function plastic_isotropic_init() result(myPlasticity) logical, dimension(:), allocatable :: myPlasticity integer :: & - Ninstances, & - p, & - i, & - Nconstituents, & + ph, & + Nmembers, & sizeState, sizeDotState real(pReal) :: & xi_0 !< initial critical stress @@ -68,32 +64,29 @@ module function plastic_isotropic_init() result(myPlasticity) mech, & pl - print'(/,a)', ' <<<+- plastic_isotropic init -+>>>' myPlasticity = plastic_active('isotropic') - Ninstances = count(myPlasticity) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return + if(count(myPlasticity) == 0) return + + print'(/,a)', ' <<<+- phase:mechanical:plastic:isotropic init -+>>>' + print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT) print*, 'Maiti and Eisenlohr, Scripta Materialia 145:37–40, 2018' print*, 'https://doi.org/10.1016/j.scriptamat.2017.09.047' - allocate(param(Ninstances)) - allocate(state(Ninstances)) - allocate(dotState(Ninstances)) - phases => config_material%get('phase') - i = 0 - do p = 1, phases%length - phase => phases%get(p) - mech => phase%get('mechanics') - if(.not. myPlasticity(p)) cycle - i = i + 1 - associate(prm => param(i), & - dot => dotState(i), & - stt => state(i)) - pl => mech%get('plasticity') + allocate(param(phases%length)) + allocate(state(phases%length)) + allocate(dotState(phases%length)) + do ph = 1, phases%length + if(.not. myPlasticity(ph)) cycle + + associate(prm => param(ph), dot => dotState(ph), stt => state(ph)) + + phase => phases%get(ph) + mech => phase%get('mechanics') + pl => mech%get('plasticity') #if defined (__GFORTRAN__) prm%output = output_asStrings(pl) @@ -101,11 +94,6 @@ module function plastic_isotropic_init() result(myPlasticity) prm%output = pl%get_asStrings('output',defaultVal=emptyStringArray) #endif -#ifdef DEBUG - if (p==material_phaseAt(debugConstitutive%grain,debugConstitutive%element)) & - prm%of_debug = material_phasememberAt(debugConstitutive%grain,debugConstitutive%ip,debugConstitutive%element) -#endif - xi_0 = pl%get_asFloat('xi_0') prm%xi_inf = pl%get_asFloat('xi_inf') prm%dot_gamma_0 = pl%get_asFloat('dot_gamma_0') @@ -131,28 +119,28 @@ module function plastic_isotropic_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nconstituents = count(material_phaseAt == p) * discretization_nIPs + Nmembers = count(material_phaseAt2 == ph) sizeDotState = size(['xi ','gamma']) sizeState = sizeDotState - call constitutive_allocateState(plasticState(p),Nconstituents,sizeState,sizeDotState,0) + call phase_allocateState(plasticState(ph),Nmembers,sizeState,sizeDotState,0) !-------------------------------------------------------------------------------------------------- ! state aliases and initialization - stt%xi => plasticState(p)%state (1,:) + stt%xi => plasticState(ph)%state (1,:) stt%xi = xi_0 - dot%xi => plasticState(p)%dotState(1,:) - plasticState(p)%atol(1) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) - if (plasticState(p)%atol(1) < 0.0_pReal) extmsg = trim(extmsg)//' atol_xi' + dot%xi => plasticState(ph)%dotState(1,:) + plasticState(ph)%atol(1) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) + if (plasticState(ph)%atol(1) < 0.0_pReal) extmsg = trim(extmsg)//' atol_xi' - stt%gamma => plasticState(p)%state (2,:) - dot%gamma => plasticState(p)%dotState(2,:) - plasticState(p)%atol(2) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) - if (plasticState(p)%atol(2) < 0.0_pReal) extmsg = trim(extmsg)//' atol_gamma' + stt%gamma => plasticState(ph)%state (2,:) + dot%gamma => plasticState(ph)%dotState(2,:) + plasticState(ph)%atol(2) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) + if (plasticState(ph)%atol(2) < 0.0_pReal) extmsg = trim(extmsg)//' atol_gamma' ! global alias - plasticState(p)%slipRate => plasticState(p)%dotState(2:2,:) + plasticState(ph)%slipRate => plasticState(ph)%dotState(2:2,:) - plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally + plasticState(ph)%state0 = plasticState(ph)%state ! ToDo: this could be done centrally end associate @@ -168,7 +156,7 @@ end function plastic_isotropic_init !-------------------------------------------------------------------------------------------------- !> @brief Calculate plastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) +module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,me) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient @@ -178,8 +166,8 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & - instance, & - of + ph, & + me real(pReal), dimension(3,3) :: & Mp_dev !< deviatoric part of the Mandel stress @@ -190,24 +178,16 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) integer :: & k, l, m, n - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(ph), stt => state(ph)) Mp_dev = math_deviatoric33(Mp) squarenorm_Mp_dev = math_tensordot(Mp_dev,Mp_dev) norm_Mp_dev = sqrt(squarenorm_Mp_dev) if (norm_Mp_dev > 0.0_pReal) then - dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp_dev/(prm%M*stt%xi(of))) **prm%n + dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp_dev/(prm%M*stt%xi(me))) **prm%n Lp = dot_gamma/prm%M * Mp_dev/norm_Mp_dev -#ifdef DEBUG - if (debugConstitutive%extensive .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then - print'(/,a,/,3(12x,3(f12.4,1x)/))', '<< CONST isotropic >> Tstar (dev) / MPa', & - transpose(Mp_dev)*1.0e-6_pReal - print'(/,a,/,f12.5)', '<< CONST isotropic >> norm Tstar / MPa', norm_Mp_dev*1.0e-6_pReal - print'(/,a,/,f12.5)', '<< CONST isotropic >> gdot', dot_gamma - end if -#endif forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLp_dMp(k,l,m,n) = (prm%n-1.0_pReal) * Mp_dev(k,l)*Mp_dev(m,n) / squarenorm_Mp_dev forall (k=1:3,l=1:3) & @@ -222,13 +202,13 @@ module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) end associate -end subroutine plastic_isotropic_LpAndItsTangent +end subroutine isotropic_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate inelastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) +module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,ph,me) real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient @@ -238,34 +218,23 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) real(pReal), dimension(3,3), intent(in) :: & Mi !< Mandel stress integer, intent(in) :: & - instance, & - of + ph, & + me real(pReal) :: & tr !< trace of spherical part of Mandel stress (= 3 x pressure) integer :: & k, l, m, n - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(ph), stt => state(ph)) tr=math_trace33(math_spherical33(Mi)) - if (prm%dilatation .and. abs(tr) > 0.0_pReal) then ! no stress or J2 plasticity --> Li and its derivative are zero + if (prm%dilatation .and. abs(tr) > 0.0_pReal) then ! no stress or J2 plasticity --> Li and its derivative are zero Li = math_I3 & - * prm%dot_gamma_0/prm%M * (3.0_pReal*prm%M*stt%xi(of))**(-prm%n) & + * prm%dot_gamma_0/prm%M * (3.0_pReal*prm%M*stt%xi(me))**(-prm%n) & * tr * abs(tr)**(prm%n-1.0_pReal) - -#ifdef DEBUG - if (debugConstitutive%extensive .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then - print'(/,a,/,f12.5)', '<< CONST isotropic >> pressure / MPa', tr/3.0_pReal*1.0e-6_pReal - print'(/,a,/,f12.5)', '<< CONST isotropic >> gdot', prm%dot_gamma_0 * (3.0_pReal*prm%M*stt%xi(of))**(-prm%n) & - * tr * abs(tr)**(prm%n-1.0_pReal) - end if -#endif - - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLi_dMi(k,l,m,n) = prm%n / tr * Li(k,l) * math_I3(m,n) - + forall (k=1:3,l=1:3,m=1:3,n=1:3) dLi_dMi(k,l,m,n) = prm%n / tr * Li(k,l) * math_I3(m,n) else Li = 0.0_pReal dLi_dMi = 0.0_pReal @@ -279,20 +248,21 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) !-------------------------------------------------------------------------------------------------- !> @brief Calculate the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_dotState(Mp,instance,of) +module subroutine isotropic_dotState(Mp,ph,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & - instance, & - of + ph, & + me real(pReal) :: & dot_gamma, & !< strainrate xi_inf_star, & !< saturation xi norm_Mp !< norm of the (deviatoric) Mandel stress - associate(prm => param(instance), stt => state(instance), dot => dotState(instance)) + associate(prm => param(ph), stt => state(ph), & + dot => dotState(ph)) if (prm%dilatation) then norm_Mp = sqrt(math_tensordot(Mp,Mp)) @@ -300,7 +270,7 @@ module subroutine plastic_isotropic_dotState(Mp,instance,of) norm_Mp = sqrt(math_tensordot(math_deviatoric33(Mp),math_deviatoric33(Mp))) endif - dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp /(prm%M*stt%xi(of))) **prm%n + dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp /(prm%M*stt%xi(me))) **prm%n if (dot_gamma > 1e-12_pReal) then if (dEq0(prm%c_1)) then @@ -310,32 +280,32 @@ module subroutine plastic_isotropic_dotState(Mp,instance,of) + asinh( (dot_gamma / prm%c_1)**(1.0_pReal / prm%c_2))**(1.0_pReal / prm%c_3) & / prm%c_4 * (dot_gamma / prm%dot_gamma_0)**(1.0_pReal / prm%n) endif - dot%xi(of) = dot_gamma & + dot%xi(me) = dot_gamma & * ( prm%h_0 + prm%h_ln * log(dot_gamma) ) & - * abs( 1.0_pReal - stt%xi(of)/xi_inf_star )**prm%a & - * sign(1.0_pReal, 1.0_pReal - stt%xi(of)/xi_inf_star) + * abs( 1.0_pReal - stt%xi(me)/xi_inf_star )**prm%a & + * sign(1.0_pReal, 1.0_pReal - stt%xi(me)/xi_inf_star) else - dot%xi(of) = 0.0_pReal + dot%xi(me) = 0.0_pReal endif - dot%gamma(of) = dot_gamma ! ToDo: not really used + dot%gamma(me) = dot_gamma ! ToDo: not really used end associate -end subroutine plastic_isotropic_dotState +end subroutine isotropic_dotState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_results(instance,group) +module subroutine plastic_isotropic_results(ph,group) - integer, intent(in) :: instance + integer, intent(in) :: ph character(len=*), intent(in) :: group integer :: o - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(ph), stt => state(ph)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('xi') @@ -348,4 +318,4 @@ module subroutine plastic_isotropic_results(instance,group) end subroutine plastic_isotropic_results -end submodule plastic_isotropic +end submodule isotropic diff --git a/src/constitutive_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90 similarity index 74% rename from src/constitutive_plastic_kinehardening.f90 rename to src/phase_mechanical_plastic_kinehardening.f90 index 8454b28f8..75e8d9e59 100644 --- a/src/constitutive_plastic_kinehardening.f90 +++ b/src/phase_mechanical_plastic_kinehardening.f90 @@ -5,7 +5,7 @@ !> @brief Phenomenological crystal plasticity using a power law formulation for the shear rates !! and a Voce-type kinematic hardening rule !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_mech) plastic_kinehardening +submodule(phase:plastic) kinehardening type :: tParameters real(pReal) :: & @@ -25,8 +25,7 @@ submodule(constitutive:constitutive_mech) plastic_kinehardening nonSchmid_pos, & nonSchmid_neg integer :: & - sum_N_sl, & !< total number of active slip system - of_debug = 0 + sum_N_sl logical :: & nonSchmidActive = .false. character(len=pStringLen), allocatable, dimension(:) :: & @@ -62,9 +61,8 @@ module function plastic_kinehardening_init() result(myPlasticity) logical, dimension(:), allocatable :: myPlasticity integer :: & - Ninstances, & - p, i, o, & - Nconstituents, & + ph, o, & + Nmembers, & sizeState, sizeDeltaState, sizeDotState, & startIndex, endIndex integer, dimension(:), allocatable :: & @@ -80,29 +78,27 @@ module function plastic_kinehardening_init() result(myPlasticity) mech, & pl - print'(/,a)', ' <<<+- plastic_kinehardening init -+>>>' - myPlasticity = plastic_active('kinehardening') - Ninstances = count(myPlasticity) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return + if(count(myPlasticity) == 0) return + + print'(/,a)', ' <<<+- phase:mechanical:plastic:kinehardening init -+>>>' + print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT) - allocate(param(Ninstances)) - allocate(state(Ninstances)) - allocate(dotState(Ninstances)) - allocate(deltaState(Ninstances)) phases => config_material%get('phase') - i = 0 - do p = 1, phases%length - phase => phases%get(p) + allocate(param(phases%length)) + allocate(state(phases%length)) + allocate(dotState(phases%length)) + allocate(deltaState(phases%length)) + + + do ph = 1, phases%length + if(.not. myPlasticity(ph)) cycle + + associate(prm => param(ph), dot => dotState(ph), dlt => deltaState(ph), stt => state(ph)) + + phase => phases%get(ph) mech => phase%get('mechanics') - if(.not. myPlasticity(p)) cycle - i = i + 1 - associate(prm => param(i), & - dot => dotState(i), & - dlt => deltaState(i), & - stt => state(i)) pl => mech%get('plasticity') #if defined (__GFORTRAN__) @@ -111,12 +107,6 @@ module function plastic_kinehardening_init() result(myPlasticity) prm%output = pl%get_asStrings('output',defaultVal=emptyStringArray) #endif -#ifdef DEBUG - if (p==material_phaseAt(debugConstitutive%grain,debugConstitutive%element)) then - prm%of_debug = material_phasememberAt(debugConstitutive%grain,debugConstitutive%ip,debugConstitutive%element) - endif -#endif - !-------------------------------------------------------------------------------------------------- ! slip related parameters N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) @@ -175,55 +165,55 @@ module function plastic_kinehardening_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nconstituents = count(material_phaseAt == p) * discretization_nIPs - sizeDotState = size(['crss ','crss_back', 'accshear ']) * prm%sum_N_sl!ToDo: adjust names, ask Philip - sizeDeltaState = size(['sense ', 'chi0 ', 'gamma0' ]) * prm%sum_N_sl !ToDo: adjust names + Nmembers = count(material_phaseAt2 == ph) + sizeDotState = size(['crss ','crss_back', 'accshear ']) * prm%sum_N_sl !ToDo: adjust names like in material.yaml + sizeDeltaState = size(['sense ', 'chi0 ', 'gamma0' ]) * prm%sum_N_sl !ToDo: adjust names like in material.yaml sizeState = sizeDotState + sizeDeltaState - call constitutive_allocateState(plasticState(p),Nconstituents,sizeState,sizeDotState,sizeDeltaState) + call phase_allocateState(plasticState(ph),Nmembers,sizeState,sizeDotState,sizeDeltaState) !-------------------------------------------------------------------------------------------------- ! state aliases and initialization startIndex = 1 endIndex = prm%sum_N_sl - stt%crss => plasticState(p)%state (startIndex:endIndex,:) - stt%crss = spread(xi_0, 2, Nconstituents) - dot%crss => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) - if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi' + stt%crss => plasticState(ph)%state (startIndex:endIndex,:) + stt%crss = spread(xi_0, 2, Nmembers) + dot%crss => plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) + if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi' startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl - stt%crss_back => plasticState(p)%state (startIndex:endIndex,:) - dot%crss_back => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) + stt%crss_back => plasticState(ph)%state (startIndex:endIndex,:) + dot%crss_back => plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl - stt%accshear => plasticState(p)%state (startIndex:endIndex,:) - dot%accshear => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) - if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma' + stt%accshear => plasticState(ph)%state (startIndex:endIndex,:) + dot%accshear => plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) + if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma' ! global alias - plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(ph)%slipRate => plasticState(ph)%dotState(startIndex:endIndex,:) - o = plasticState(p)%offsetDeltaState + o = plasticState(ph)%offsetDeltaState startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl - stt%sense => plasticState(p)%state (startIndex :endIndex ,:) - dlt%sense => plasticState(p)%deltaState(startIndex-o:endIndex-o,:) + stt%sense => plasticState(ph)%state (startIndex :endIndex ,:) + dlt%sense => plasticState(ph)%deltaState(startIndex-o:endIndex-o,:) startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl - stt%chi0 => plasticState(p)%state (startIndex :endIndex ,:) - dlt%chi0 => plasticState(p)%deltaState(startIndex-o:endIndex-o,:) + stt%chi0 => plasticState(ph)%state (startIndex :endIndex ,:) + dlt%chi0 => plasticState(ph)%deltaState(startIndex-o:endIndex-o,:) startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl - stt%gamma0 => plasticState(p)%state (startIndex :endIndex ,:) - dlt%gamma0 => plasticState(p)%deltaState(startIndex-o:endIndex-o,:) + stt%gamma0 => plasticState(ph)%state (startIndex :endIndex ,:) + dlt%gamma0 => plasticState(ph)%deltaState(startIndex-o:endIndex-o,:) - plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally + plasticState(ph)%state0 = plasticState(ph)%state ! ToDo: this could be done centrally end associate @@ -240,7 +230,7 @@ end function plastic_kinehardening_init !-------------------------------------------------------------------------------------------------- !> @brief Calculate plastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -pure module subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) +pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,me) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient @@ -250,21 +240,21 @@ pure module subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,insta real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & - instance, & - of + ph, & + me integer :: & i,k,l,m,n - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & gdot_pos,gdot_neg, & dgdot_dtau_pos,dgdot_dtau_neg Lp = 0.0_pReal dLp_dMp = 0.0_pReal - associate(prm => param(instance)) + associate(prm => param(ph)) - call kinetics(Mp,instance,of,gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg) + call kinetics(Mp,ph,me,gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg) do i = 1, prm%sum_N_sl Lp = Lp + (gdot_pos(i)+gdot_neg(i))*prm%P(1:3,1:3,i) @@ -276,44 +266,45 @@ pure module subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,insta end associate -end subroutine plastic_kinehardening_LpAndItsTangent +end subroutine kinehardening_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_kinehardening_dotState(Mp,instance,of) +module subroutine plastic_kinehardening_dotState(Mp,ph,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & - instance, & - of + ph, & + me real(pReal) :: & sumGamma - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & gdot_pos,gdot_neg - associate(prm => param(instance), stt => state(instance), dot => dotState(instance)) + associate(prm => param(ph), stt => state(ph),& + dot => dotState(ph)) - call kinetics(Mp,instance,of,gdot_pos,gdot_neg) - dot%accshear(:,of) = abs(gdot_pos+gdot_neg) - sumGamma = sum(stt%accshear(:,of)) + call kinetics(Mp,ph,me,gdot_pos,gdot_neg) + dot%accshear(:,me) = abs(gdot_pos+gdot_neg) + sumGamma = sum(stt%accshear(:,me)) - dot%crss(:,of) = matmul(prm%interaction_SlipSlip,dot%accshear(:,of)) & + dot%crss(:,me) = matmul(prm%interaction_SlipSlip,dot%accshear(:,me)) & * ( prm%h_inf_f & + (prm%h_0_f - prm%h_inf_f + prm%h_0_f*prm%h_inf_f*sumGamma/prm%xi_inf_f) & * exp(-sumGamma*prm%h_0_f/prm%xi_inf_f) & ) - dot%crss_back(:,of) = stt%sense(:,of)*dot%accshear(:,of) * & + dot%crss_back(:,me) = stt%sense(:,me)*dot%accshear(:,me) * & ( prm%h_inf_b + & (prm%h_0_b - prm%h_inf_b & - + prm%h_0_b*prm%h_inf_b/(prm%xi_inf_b+stt%chi0(:,of))*(stt%accshear(:,of)-stt%gamma0(:,of))& - ) *exp(-(stt%accshear(:,of)-stt%gamma0(:,of)) *prm%h_0_b/(prm%xi_inf_b+stt%chi0(:,of))) & + + prm%h_0_b*prm%h_inf_b/(prm%xi_inf_b+stt%chi0(:,me))*(stt%accshear(:,me)-stt%gamma0(:,me))& + ) *exp(-(stt%accshear(:,me)-stt%gamma0(:,me)) *prm%h_0_b/(prm%xi_inf_b+stt%chi0(:,me))) & ) end associate @@ -324,43 +315,36 @@ end subroutine plastic_kinehardening_dotState !-------------------------------------------------------------------------------------------------- !> @brief Calculate (instantaneous) incremental change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_kinehardening_deltaState(Mp,instance,of) +module subroutine plastic_kinehardening_deltaState(Mp,ph,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & - instance, & - of + ph, & + me - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & gdot_pos,gdot_neg, & sense - associate(prm => param(instance), stt => state(instance), dlt => deltaState(instance)) + associate(prm => param(ph), stt => state(ph), dlt => deltaState(ph)) - call kinetics(Mp,instance,of,gdot_pos,gdot_neg) - sense = merge(state(instance)%sense(:,of), & ! keep existing... + call kinetics(Mp,ph,me,gdot_pos,gdot_neg) + sense = merge(state(ph)%sense(:,me), & ! keep existing... sign(1.0_pReal,gdot_pos+gdot_neg), & ! ...or have a defined dEq0(gdot_pos+gdot_neg,1e-10_pReal)) ! current sense of shear direction -#ifdef DEBUG - if (debugConstitutive%extensive & - .and. (of == prm%of_debug .or. .not. debugConstitutive%selective)) then - print*, '======= kinehardening delta state =======' - print*, sense,state(instance)%sense(:,of) - endif -#endif !-------------------------------------------------------------------------------------------------- -! switch in sense of shear? - where(dNeq(sense,stt%sense(:,of),0.1_pReal)) - dlt%sense (:,of) = sense - stt%sense(:,of) ! switch sense - dlt%chi0 (:,of) = abs(stt%crss_back(:,of)) - stt%chi0(:,of) ! remember current backstress magnitude - dlt%gamma0(:,of) = stt%accshear(:,of) - stt%gamma0(:,of) ! remember current accumulated shear +! switch in sense me shear? + where(dNeq(sense,stt%sense(:,me),0.1_pReal)) + dlt%sense (:,me) = sense - stt%sense(:,me) ! switch sense + dlt%chi0 (:,me) = abs(stt%crss_back(:,me)) - stt%chi0(:,me) ! remember current backstress magnitude + dlt%gamma0(:,me) = stt%accshear(:,me) - stt%gamma0(:,me) ! remember current accumulated shear else where - dlt%sense (:,of) = 0.0_pReal - dlt%chi0 (:,of) = 0.0_pReal - dlt%gamma0(:,of) = 0.0_pReal + dlt%sense (:,me) = 0.0_pReal + dlt%chi0 (:,me) = 0.0_pReal + dlt%gamma0(:,me) = 0.0_pReal end where end associate @@ -371,14 +355,14 @@ end subroutine plastic_kinehardening_deltaState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_kinehardening_results(instance,group) +module subroutine plastic_kinehardening_results(ph,group) - integer, intent(in) :: instance + integer, intent(in) :: ph character(len=*), intent(in) :: group integer :: o - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(ph), stt => state(ph)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case('xi') @@ -413,45 +397,45 @@ end subroutine plastic_kinehardening_results ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end. !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics(Mp,instance,of, & +pure subroutine kinetics(Mp,ph,me, & gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & - instance, & - of + ph, & + me - real(pReal), intent(out), dimension(param(instance)%sum_N_sl) :: & + real(pReal), intent(out), dimension(param(ph)%sum_N_sl) :: & gdot_pos, & gdot_neg - real(pReal), intent(out), optional, dimension(param(instance)%sum_N_sl) :: & + real(pReal), intent(out), optional, dimension(param(ph)%sum_N_sl) :: & dgdot_dtau_pos, & dgdot_dtau_neg - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & tau_pos, & tau_neg integer :: i - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(ph), stt => state(ph)) do i = 1, prm%sum_N_sl - tau_pos(i) = math_tensordot(Mp,prm%nonSchmid_pos(1:3,1:3,i)) - stt%crss_back(i,of) - tau_neg(i) = merge(math_tensordot(Mp,prm%nonSchmid_neg(1:3,1:3,i)) - stt%crss_back(i,of), & + tau_pos(i) = math_tensordot(Mp,prm%nonSchmid_pos(1:3,1:3,i)) - stt%crss_back(i,me) + tau_neg(i) = merge(math_tensordot(Mp,prm%nonSchmid_neg(1:3,1:3,i)) - stt%crss_back(i,me), & 0.0_pReal, prm%nonSchmidActive) enddo where(dNeq0(tau_pos)) gdot_pos = prm%dot_gamma_0 * merge(0.5_pReal,1.0_pReal, prm%nonSchmidActive) & ! 1/2 if non-Schmid active - * sign(abs(tau_pos/stt%crss(:,of))**prm%n, tau_pos) + * sign(abs(tau_pos/stt%crss(:,me))**prm%n, tau_pos) else where gdot_pos = 0.0_pReal end where where(dNeq0(tau_neg)) gdot_neg = prm%dot_gamma_0 * 0.5_pReal & ! only used if non-Schmid active, always 1/2 - * sign(abs(tau_neg/stt%crss(:,of))**prm%n, tau_neg) + * sign(abs(tau_neg/stt%crss(:,me))**prm%n, tau_neg) else where gdot_neg = 0.0_pReal end where @@ -474,4 +458,4 @@ pure subroutine kinetics(Mp,instance,of, & end subroutine kinetics -end submodule plastic_kinehardening +end submodule kinehardening diff --git a/src/constitutive_plastic_none.f90 b/src/phase_mechanical_plastic_none.f90 similarity index 55% rename from src/constitutive_plastic_none.f90 rename to src/phase_mechanical_plastic_none.f90 index 27a01fb93..28e9fbc7c 100644 --- a/src/constitutive_plastic_none.f90 +++ b/src/phase_mechanical_plastic_none.f90 @@ -4,7 +4,7 @@ !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief Dummy plasticity for purely elastic material !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_mech) plastic_none +submodule(phase:plastic) none contains @@ -16,38 +16,24 @@ module function plastic_none_init() result(myPlasticity) logical, dimension(:), allocatable :: myPlasticity integer :: & - Ninstances, & - p, & - Nconstituents + ph class(tNode), pointer :: & - phases, & - phase, & - mech, & - pl + phases - print'(/,a)', ' <<<+- plastic_none init -+>>>' + + myPlasticity = plastic_active('none') + if(count(myPlasticity) == 0) return + + print'(/,a)', ' <<<+- phase:mechanical:plastic:none init -+>>>' + print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT) phases => config_material%get('phase') - allocate(myPlasticity(phases%length), source = .false.) - do p = 1, phases%length - phase => phases%get(p) - mech => phase%get('mechanics') - pl => mech%get ('plasticity') - if(pl%get_asString('type') == 'none') myPlasticity(p) = .true. - enddo - - Ninstances = count(myPlasticity) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return - - do p = 1, phases%length - phase => phases%get(p) - if(.not. myPlasticity(p)) cycle - Nconstituents = count(material_phaseAt == p) * discretization_nIPs - call constitutive_allocateState(plasticState(p),Nconstituents,0,0,0) + do ph = 1, phases%length + if(.not. myPlasticity(ph)) cycle + call phase_allocateState(plasticState(ph),count(material_phaseAt2 == ph),0,0,0) enddo end function plastic_none_init -end submodule plastic_none +end submodule none diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 similarity index 83% rename from src/constitutive_plastic_nonlocal.f90 rename to src/phase_mechanical_plastic_nonlocal.f90 index 0d7875291..d0007075b 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -4,7 +4,7 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @brief material subroutine for plasticity including dislocation flux !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_mech) plastic_nonlocal +submodule(phase:plastic) nonlocal use geometry_plastic_nonlocal, only: & nIPneighbors => geometry_plastic_nonlocal_nIPneighbors, & IPneighborhood => geometry_plastic_nonlocal_IPneighborhood, & @@ -13,6 +13,12 @@ submodule(constitutive:constitutive_mech) plastic_nonlocal IPareaNormal => geometry_plastic_nonlocal_IPareaNormal0, & geometry_plastic_nonlocal_disable + type :: tGeometry + real(pReal), dimension(:), allocatable :: V_0 + end type tGeometry + + type(tGeometry), dimension(:), allocatable :: geom + real(pReal), parameter :: & kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin @@ -154,7 +160,7 @@ submodule(constitutive:constitutive_mech) plastic_nonlocal state, & state0 - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters type(tNonlocalMicrostructure), dimension(:), allocatable :: microstructure @@ -170,8 +176,8 @@ module function plastic_nonlocal_init() result(myPlasticity) logical, dimension(:), allocatable :: myPlasticity integer :: & Ninstances, & - p, i, & - Nconstituents, & + ph, & + Nmembers, & sizeState, sizeDotState, sizeDependentState, sizeDeltaState, & s1, s2, & s, t, l @@ -187,45 +193,44 @@ module function plastic_nonlocal_init() result(myPlasticity) mech, & pl - print'(/,a)', ' <<<+- plastic_nonlocal init -+>>>' - myPlasticity = plastic_active('nonlocal') Ninstances = count(myPlasticity) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) if(Ninstances == 0) then call geometry_plastic_nonlocal_disable return endif + print'(/,a)', ' <<<+- phase:mechanical:plastic:nonlocal init -+>>>' + print'(a,i0)', ' # phases: ',Ninstances; flush(IO_STDOUT) + print*, 'Reuber et al., Acta Materialia 71:333–348, 2014' print*, 'https://doi.org/10.1016/j.actamat.2014.03.012'//IO_EOL print*, 'Kords, Dissertation RWTH Aachen, 2014' print*, 'http://publications.rwth-aachen.de/record/229993' - allocate(param(Ninstances)) - allocate(state(Ninstances)) - allocate(state0(Ninstances)) - allocate(dotState(Ninstances)) - allocate(deltaState(Ninstances)) - allocate(microstructure(Ninstances)) phases => config_material%get('phase') - i = 0 - do p = 1, phases%length - phase => phases%get(p) + allocate(geom(phases%length)) + + allocate(param(phases%length)) + allocate(state(phases%length)) + allocate(state0(phases%length)) + allocate(dotState(phases%length)) + allocate(deltaState(phases%length)) + allocate(microstructure(phases%length)) + + do ph = 1, phases%length + if(.not. myPlasticity(ph)) cycle + + associate(prm => param(ph), dot => dotState(ph), stt => state(ph), & + st0 => state0(ph), del => deltaState(ph), dst => microstructure(ph)) + + phase => phases%get(ph) mech => phase%get('mechanics') - if(.not. myPlasticity(p)) cycle - i = i + 1 - associate(prm => param(i), & - dot => dotState(i), & - stt => state(i), & - st0 => state0(i), & - del => deltaState(i), & - dst => microstructure(i)) pl => mech%get('plasticity') - phase_localPlasticity(p) = .not. pl%contains('nonlocal') + phase_localPlasticity(ph) = .not. pl%contains('nonlocal') #if defined (__GFORTRAN__) prm%output = output_asStrings(pl) @@ -236,8 +241,8 @@ module function plastic_nonlocal_init() result(myPlasticity) prm%atol_rho = pl%get_asFloat('atol_rho',defaultVal=1.0e4_pReal) ! This data is read in already in lattice - prm%mu = lattice_mu(p) - prm%nu = lattice_nu(p) + prm%mu = lattice_mu(ph) + prm%nu = lattice_nu(ph) ini%N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(ini%N_sl)) @@ -393,7 +398,7 @@ module function plastic_nonlocal_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nconstituents = count(material_phaseAt==p) * discretization_nIPs + Nmembers = count(material_phaseAt2 == ph) sizeDotState = size([ 'rhoSglEdgePosMobile ','rhoSglEdgeNegMobile ', & 'rhoSglScrewPosMobile ','rhoSglScrewNegMobile ', & 'rhoSglEdgePosImmobile ','rhoSglEdgeNegImmobile ', & @@ -407,98 +412,101 @@ module function plastic_nonlocal_init() result(myPlasticity) 'maxDipoleHeightEdge ','maxDipoleHeightScrew' ]) * prm%sum_N_sl !< other dependent state variables that are not updated by microstructure sizeDeltaState = sizeDotState - call constitutive_allocateState(plasticState(p),Nconstituents,sizeState,sizeDotState,sizeDeltaState) + call phase_allocateState(plasticState(ph),Nmembers,sizeState,sizeDotState,sizeDeltaState) - plasticState(p)%nonlocal = pl%get_asBool('nonlocal') - if(plasticState(p)%nonlocal .and. .not. allocated(IPneighborhood)) & + allocate(geom(ph)%V_0(Nmembers)) + call storeGeometry(ph) + + plasticState(ph)%nonlocal = pl%get_asBool('nonlocal') + if(plasticState(ph)%nonlocal .and. .not. allocated(IPneighborhood)) & call IO_error(212,ext_msg='IPneighborhood does not exist') - plasticState(p)%offsetDeltaState = 0 ! ToDo: state structure does not follow convention + plasticState(ph)%offsetDeltaState = 0 ! ToDo: state structure does not follow convention - st0%rho => plasticState(p)%state0 (0*prm%sum_N_sl+1:10*prm%sum_N_sl,:) - stt%rho => plasticState(p)%state (0*prm%sum_N_sl+1:10*prm%sum_N_sl,:) - dot%rho => plasticState(p)%dotState (0*prm%sum_N_sl+1:10*prm%sum_N_sl,:) - del%rho => plasticState(p)%deltaState (0*prm%sum_N_sl+1:10*prm%sum_N_sl,:) - plasticState(p)%atol(1:10*prm%sum_N_sl) = prm%atol_rho + st0%rho => plasticState(ph)%state0 (0*prm%sum_N_sl+1:10*prm%sum_N_sl,:) + stt%rho => plasticState(ph)%state (0*prm%sum_N_sl+1:10*prm%sum_N_sl,:) + dot%rho => plasticState(ph)%dotState (0*prm%sum_N_sl+1:10*prm%sum_N_sl,:) + del%rho => plasticState(ph)%deltaState (0*prm%sum_N_sl+1:10*prm%sum_N_sl,:) + plasticState(ph)%atol(1:10*prm%sum_N_sl) = prm%atol_rho - stt%rhoSgl => plasticState(p)%state (0*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) - dot%rhoSgl => plasticState(p)%dotState (0*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) - del%rhoSgl => plasticState(p)%deltaState (0*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) + stt%rhoSgl => plasticState(ph)%state (0*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) + dot%rhoSgl => plasticState(ph)%dotState (0*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) + del%rhoSgl => plasticState(ph)%deltaState (0*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) - stt%rhoSglMobile => plasticState(p)%state (0*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) - dot%rhoSglMobile => plasticState(p)%dotState (0*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) - del%rhoSglMobile => plasticState(p)%deltaState (0*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) + stt%rhoSglMobile => plasticState(ph)%state (0*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) + dot%rhoSglMobile => plasticState(ph)%dotState (0*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) + del%rhoSglMobile => plasticState(ph)%deltaState (0*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) - stt%rho_sgl_mob_edg_pos => plasticState(p)%state (0*prm%sum_N_sl+1: 1*prm%sum_N_sl,:) - dot%rho_sgl_mob_edg_pos => plasticState(p)%dotState (0*prm%sum_N_sl+1: 1*prm%sum_N_sl,:) - del%rho_sgl_mob_edg_pos => plasticState(p)%deltaState (0*prm%sum_N_sl+1: 1*prm%sum_N_sl,:) + stt%rho_sgl_mob_edg_pos => plasticState(ph)%state (0*prm%sum_N_sl+1: 1*prm%sum_N_sl,:) + dot%rho_sgl_mob_edg_pos => plasticState(ph)%dotState (0*prm%sum_N_sl+1: 1*prm%sum_N_sl,:) + del%rho_sgl_mob_edg_pos => plasticState(ph)%deltaState (0*prm%sum_N_sl+1: 1*prm%sum_N_sl,:) - stt%rho_sgl_mob_edg_neg => plasticState(p)%state (1*prm%sum_N_sl+1: 2*prm%sum_N_sl,:) - dot%rho_sgl_mob_edg_neg => plasticState(p)%dotState (1*prm%sum_N_sl+1: 2*prm%sum_N_sl,:) - del%rho_sgl_mob_edg_neg => plasticState(p)%deltaState (1*prm%sum_N_sl+1: 2*prm%sum_N_sl,:) + stt%rho_sgl_mob_edg_neg => plasticState(ph)%state (1*prm%sum_N_sl+1: 2*prm%sum_N_sl,:) + dot%rho_sgl_mob_edg_neg => plasticState(ph)%dotState (1*prm%sum_N_sl+1: 2*prm%sum_N_sl,:) + del%rho_sgl_mob_edg_neg => plasticState(ph)%deltaState (1*prm%sum_N_sl+1: 2*prm%sum_N_sl,:) - stt%rho_sgl_mob_scr_pos => plasticState(p)%state (2*prm%sum_N_sl+1: 3*prm%sum_N_sl,:) - dot%rho_sgl_mob_scr_pos => plasticState(p)%dotState (2*prm%sum_N_sl+1: 3*prm%sum_N_sl,:) - del%rho_sgl_mob_scr_pos => plasticState(p)%deltaState (2*prm%sum_N_sl+1: 3*prm%sum_N_sl,:) + stt%rho_sgl_mob_scr_pos => plasticState(ph)%state (2*prm%sum_N_sl+1: 3*prm%sum_N_sl,:) + dot%rho_sgl_mob_scr_pos => plasticState(ph)%dotState (2*prm%sum_N_sl+1: 3*prm%sum_N_sl,:) + del%rho_sgl_mob_scr_pos => plasticState(ph)%deltaState (2*prm%sum_N_sl+1: 3*prm%sum_N_sl,:) - stt%rho_sgl_mob_scr_neg => plasticState(p)%state (3*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) - dot%rho_sgl_mob_scr_neg => plasticState(p)%dotState (3*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) - del%rho_sgl_mob_scr_neg => plasticState(p)%deltaState (3*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) + stt%rho_sgl_mob_scr_neg => plasticState(ph)%state (3*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) + dot%rho_sgl_mob_scr_neg => plasticState(ph)%dotState (3*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) + del%rho_sgl_mob_scr_neg => plasticState(ph)%deltaState (3*prm%sum_N_sl+1: 4*prm%sum_N_sl,:) - stt%rhoSglImmobile => plasticState(p)%state (4*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) - dot%rhoSglImmobile => plasticState(p)%dotState (4*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) - del%rhoSglImmobile => plasticState(p)%deltaState (4*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) + stt%rhoSglImmobile => plasticState(ph)%state (4*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) + dot%rhoSglImmobile => plasticState(ph)%dotState (4*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) + del%rhoSglImmobile => plasticState(ph)%deltaState (4*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) - stt%rho_sgl_imm_edg_pos => plasticState(p)%state (4*prm%sum_N_sl+1: 5*prm%sum_N_sl,:) - dot%rho_sgl_imm_edg_pos => plasticState(p)%dotState (4*prm%sum_N_sl+1: 5*prm%sum_N_sl,:) - del%rho_sgl_imm_edg_pos => plasticState(p)%deltaState (4*prm%sum_N_sl+1: 5*prm%sum_N_sl,:) + stt%rho_sgl_imm_edg_pos => plasticState(ph)%state (4*prm%sum_N_sl+1: 5*prm%sum_N_sl,:) + dot%rho_sgl_imm_edg_pos => plasticState(ph)%dotState (4*prm%sum_N_sl+1: 5*prm%sum_N_sl,:) + del%rho_sgl_imm_edg_pos => plasticState(ph)%deltaState (4*prm%sum_N_sl+1: 5*prm%sum_N_sl,:) - stt%rho_sgl_imm_edg_neg => plasticState(p)%state (5*prm%sum_N_sl+1: 6*prm%sum_N_sl,:) - dot%rho_sgl_imm_edg_neg => plasticState(p)%dotState (5*prm%sum_N_sl+1: 6*prm%sum_N_sl,:) - del%rho_sgl_imm_edg_neg => plasticState(p)%deltaState (5*prm%sum_N_sl+1: 6*prm%sum_N_sl,:) + stt%rho_sgl_imm_edg_neg => plasticState(ph)%state (5*prm%sum_N_sl+1: 6*prm%sum_N_sl,:) + dot%rho_sgl_imm_edg_neg => plasticState(ph)%dotState (5*prm%sum_N_sl+1: 6*prm%sum_N_sl,:) + del%rho_sgl_imm_edg_neg => plasticState(ph)%deltaState (5*prm%sum_N_sl+1: 6*prm%sum_N_sl,:) - stt%rho_sgl_imm_scr_pos => plasticState(p)%state (6*prm%sum_N_sl+1: 7*prm%sum_N_sl,:) - dot%rho_sgl_imm_scr_pos => plasticState(p)%dotState (6*prm%sum_N_sl+1: 7*prm%sum_N_sl,:) - del%rho_sgl_imm_scr_pos => plasticState(p)%deltaState (6*prm%sum_N_sl+1: 7*prm%sum_N_sl,:) + stt%rho_sgl_imm_scr_pos => plasticState(ph)%state (6*prm%sum_N_sl+1: 7*prm%sum_N_sl,:) + dot%rho_sgl_imm_scr_pos => plasticState(ph)%dotState (6*prm%sum_N_sl+1: 7*prm%sum_N_sl,:) + del%rho_sgl_imm_scr_pos => plasticState(ph)%deltaState (6*prm%sum_N_sl+1: 7*prm%sum_N_sl,:) - stt%rho_sgl_imm_scr_neg => plasticState(p)%state (7*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) - dot%rho_sgl_imm_scr_neg => plasticState(p)%dotState (7*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) - del%rho_sgl_imm_scr_neg => plasticState(p)%deltaState (7*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) + stt%rho_sgl_imm_scr_neg => plasticState(ph)%state (7*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) + dot%rho_sgl_imm_scr_neg => plasticState(ph)%dotState (7*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) + del%rho_sgl_imm_scr_neg => plasticState(ph)%deltaState (7*prm%sum_N_sl+1: 8*prm%sum_N_sl,:) - stt%rhoDip => plasticState(p)%state (8*prm%sum_N_sl+1:10*prm%sum_N_sl,:) - dot%rhoDip => plasticState(p)%dotState (8*prm%sum_N_sl+1:10*prm%sum_N_sl,:) - del%rhoDip => plasticState(p)%deltaState (8*prm%sum_N_sl+1:10*prm%sum_N_sl,:) + stt%rhoDip => plasticState(ph)%state (8*prm%sum_N_sl+1:10*prm%sum_N_sl,:) + dot%rhoDip => plasticState(ph)%dotState (8*prm%sum_N_sl+1:10*prm%sum_N_sl,:) + del%rhoDip => plasticState(ph)%deltaState (8*prm%sum_N_sl+1:10*prm%sum_N_sl,:) - stt%rho_dip_edg => plasticState(p)%state (8*prm%sum_N_sl+1: 9*prm%sum_N_sl,:) - dot%rho_dip_edg => plasticState(p)%dotState (8*prm%sum_N_sl+1: 9*prm%sum_N_sl,:) - del%rho_dip_edg => plasticState(p)%deltaState (8*prm%sum_N_sl+1: 9*prm%sum_N_sl,:) + stt%rho_dip_edg => plasticState(ph)%state (8*prm%sum_N_sl+1: 9*prm%sum_N_sl,:) + dot%rho_dip_edg => plasticState(ph)%dotState (8*prm%sum_N_sl+1: 9*prm%sum_N_sl,:) + del%rho_dip_edg => plasticState(ph)%deltaState (8*prm%sum_N_sl+1: 9*prm%sum_N_sl,:) - stt%rho_dip_scr => plasticState(p)%state (9*prm%sum_N_sl+1:10*prm%sum_N_sl,:) - dot%rho_dip_scr => plasticState(p)%dotState (9*prm%sum_N_sl+1:10*prm%sum_N_sl,:) - del%rho_dip_scr => plasticState(p)%deltaState (9*prm%sum_N_sl+1:10*prm%sum_N_sl,:) + stt%rho_dip_scr => plasticState(ph)%state (9*prm%sum_N_sl+1:10*prm%sum_N_sl,:) + dot%rho_dip_scr => plasticState(ph)%dotState (9*prm%sum_N_sl+1:10*prm%sum_N_sl,:) + del%rho_dip_scr => plasticState(ph)%deltaState (9*prm%sum_N_sl+1:10*prm%sum_N_sl,:) - stt%gamma => plasticState(p)%state (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nconstituents) - dot%gamma => plasticState(p)%dotState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nconstituents) - del%gamma => plasticState(p)%deltaState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nconstituents) - plasticState(p)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl ) = pl%get_asFloat('atol_gamma', defaultVal = 1.0e-2_pReal) - if(any(plasticState(p)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl) < 0.0_pReal)) & + stt%gamma => plasticState(ph)%state (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nmembers) + dot%gamma => plasticState(ph)%dotState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nmembers) + del%gamma => plasticState(ph)%deltaState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nmembers) + plasticState(ph)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl ) = pl%get_asFloat('atol_gamma', defaultVal = 1.0e-2_pReal) + if(any(plasticState(ph)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl) < 0.0_pReal)) & extmsg = trim(extmsg)//' atol_gamma' - plasticState(p)%slipRate => plasticState(p)%dotState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nconstituents) + plasticState(ph)%slipRate => plasticState(ph)%dotState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nmembers) - stt%rho_forest => plasticState(p)%state (11*prm%sum_N_sl + 1:12*prm%sum_N_sl,1:Nconstituents) - stt%v => plasticState(p)%state (12*prm%sum_N_sl + 1:16*prm%sum_N_sl,1:Nconstituents) - stt%v_edg_pos => plasticState(p)%state (12*prm%sum_N_sl + 1:13*prm%sum_N_sl,1:Nconstituents) - stt%v_edg_neg => plasticState(p)%state (13*prm%sum_N_sl + 1:14*prm%sum_N_sl,1:Nconstituents) - stt%v_scr_pos => plasticState(p)%state (14*prm%sum_N_sl + 1:15*prm%sum_N_sl,1:Nconstituents) - stt%v_scr_neg => plasticState(p)%state (15*prm%sum_N_sl + 1:16*prm%sum_N_sl,1:Nconstituents) + stt%rho_forest => plasticState(ph)%state (11*prm%sum_N_sl + 1:12*prm%sum_N_sl,1:Nmembers) + stt%v => plasticState(ph)%state (12*prm%sum_N_sl + 1:16*prm%sum_N_sl,1:Nmembers) + stt%v_edg_pos => plasticState(ph)%state (12*prm%sum_N_sl + 1:13*prm%sum_N_sl,1:Nmembers) + stt%v_edg_neg => plasticState(ph)%state (13*prm%sum_N_sl + 1:14*prm%sum_N_sl,1:Nmembers) + stt%v_scr_pos => plasticState(ph)%state (14*prm%sum_N_sl + 1:15*prm%sum_N_sl,1:Nmembers) + stt%v_scr_neg => plasticState(ph)%state (15*prm%sum_N_sl + 1:16*prm%sum_N_sl,1:Nmembers) - allocate(dst%tau_pass(prm%sum_N_sl,Nconstituents),source=0.0_pReal) - allocate(dst%tau_back(prm%sum_N_sl,Nconstituents),source=0.0_pReal) + allocate(dst%tau_pass(prm%sum_N_sl,Nmembers),source=0.0_pReal) + allocate(dst%tau_back(prm%sum_N_sl,Nmembers),source=0.0_pReal) end associate - if (Nconstituents > 0) call stateInit(ini,p,Nconstituents,i) - plasticState(p)%state0 = plasticState(p)%state + if (Nmembers > 0) call stateInit(ini,ph,Nmembers) + plasticState(ph)%state0 = plasticState(ph)%state !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range @@ -510,40 +518,38 @@ module function plastic_nonlocal_init() result(myPlasticity) discretization_nIPs,discretization_Nelems), source=0.0_pReal) ! BEGIN DEPRECATED---------------------------------------------------------------------------------- - allocate(iRhoU(maxval(param%sum_N_sl),4,Ninstances), source=0) - allocate(iV(maxval(param%sum_N_sl),4,Ninstances), source=0) - allocate(iD(maxval(param%sum_N_sl),2,Ninstances), source=0) + allocate(iRhoU(maxval(param%sum_N_sl),4,phases%length), source=0) + allocate(iV(maxval(param%sum_N_sl),4,phases%length), source=0) + allocate(iD(maxval(param%sum_N_sl),2,phases%length), source=0) - i = 0 - do p = 1, phases%length - phase => phases%get(p) + do ph = 1, phases%length - if(.not. myPlasticity(p)) cycle - i = i + 1 + if(.not. myPlasticity(ph)) cycle - Nconstituents = count(material_phaseAt==p) * discretization_nIPs + phase => phases%get(ph) + Nmembers = count(material_phaseAt2 == ph) l = 0 do t = 1,4 - do s = 1,param(i)%sum_N_sl + do s = 1,param(ph)%sum_N_sl l = l + 1 - iRhoU(s,t,i) = l + iRhoU(s,t,ph) = l enddo enddo - l = l + (4+2+1+1)*param(i)%sum_N_sl ! immobile(4), dipole(2), shear, forest + l = l + (4+2+1+1)*param(ph)%sum_N_sl ! immobile(4), dipole(2), shear, forest do t = 1,4 - do s = 1,param(i)%sum_N_sl + do s = 1,param(ph)%sum_N_sl l = l + 1 - iV(s,t,i) = l + iV(s,t,ph) = l enddo enddo do t = 1,2 - do s = 1,param(i)%sum_N_sl + do s = 1,param(ph)%sum_N_sl l = l + 1 - iD(s,t,i) = l + iD(s,t,ph) = l enddo enddo - if (iD(param(i)%sum_N_sl,2,i) /= plasticState(p)%sizeState) & - call IO_error(0, ext_msg = 'state indices not properly set (nonlocal)') + if (iD(param(ph)%sum_N_sl,2,ph) /= plasticState(ph)%sizeState) & + error stop 'state indices not properly set (nonlocal)' enddo end function plastic_nonlocal_init @@ -552,23 +558,18 @@ end function plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) +module subroutine nonlocal_dependentState(ph, me, ip, el) - real(pReal), dimension(3,3), intent(in) :: & - F integer, intent(in) :: & - instance, & - of, & + ph, & + me, & ip, & el integer :: & - ph, & - me, & no, & !< neighbor offset neighbor_el, & ! element number of neighboring material point neighbor_ip, & ! integration point of neighboring material point - neighbor_instance, & ! instance of this plasticity of neighboring material point c, & ! index of dilsocation character (edge, screw) s, & ! slip system index dir, & @@ -592,31 +593,31 @@ module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) invConnections real(pReal), dimension(3,nIPneighbors) :: & connection_latticeConf - real(pReal), dimension(2,param(instance)%sum_N_sl) :: & + real(pReal), dimension(2,param(ph)%sum_N_sl) :: & rhoExcess - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & rho_edg_delta, & rho_scr_delta - real(pReal), dimension(param(instance)%sum_N_sl,10) :: & + real(pReal), dimension(param(ph)%sum_N_sl,10) :: & rho, & rho0, & rho_neighbor0 - real(pReal), dimension(param(instance)%sum_N_sl,param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl,param(ph)%sum_N_sl) :: & myInteractionMatrix ! corrected slip interaction matrix - real(pReal), dimension(param(instance)%sum_N_sl,nIPneighbors) :: & + real(pReal), dimension(param(ph)%sum_N_sl,nIPneighbors) :: & rho_edg_delta_neighbor, & rho_scr_delta_neighbor real(pReal), dimension(2,maxval(param%sum_N_sl),nIPneighbors) :: & neighbor_rhoExcess, & ! excess density at neighboring material point neighbor_rhoTotal ! total density at neighboring material point - real(pReal), dimension(3,param(instance)%sum_N_sl,2) :: & + real(pReal), dimension(3,param(ph)%sum_N_sl,2) :: & m ! direction of dislocation motion - associate(prm => param(instance),dst => microstructure(instance), stt => state(instance)) + associate(prm => param(ph),dst => microstructure(ph), stt => state(ph)) - rho = getRho(instance,of,ip,el) + rho = getRho(ph,me) - stt%rho_forest(:,of) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) & + stt%rho_forest(:,me) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) & + matmul(prm%forestProjection_Screw,sum(abs(rho(:,scr)),2)) @@ -626,13 +627,13 @@ module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) myInteractionMatrix = prm%h_sl_sl & * spread(( 1.0_pReal - prm%f_F & + prm%f_F & - * log(0.35_pReal * prm%b_sl * sqrt(max(stt%rho_forest(:,of),prm%rho_significant))) & + * log(0.35_pReal * prm%b_sl * sqrt(max(stt%rho_forest(:,me),prm%rho_significant))) & / log(0.35_pReal * prm%b_sl * 1e6_pReal))** 2.0_pReal,2,prm%sum_N_sl) else myInteractionMatrix = prm%h_sl_sl endif - dst%tau_pass(:,of) = prm%mu * prm%b_sl & + dst%tau_pass(:,me) = prm%mu * prm%b_sl & * sqrt(matmul(myInteractionMatrix,sum(abs(rho),2))) !*** calculate the dislocation stress of the neighboring excess dislocation densities @@ -642,12 +643,10 @@ module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) ! ToDo: MD: this is most likely only correct for F_i = I !################################################################################################# - rho0 = getRho0(instance,of,ip,el) + rho0 = getRho0(ph,me) if (.not. phase_localPlasticity(material_phaseAt(1,el)) .and. prm%shortRangeStressCorrection) then - ph = material_phaseAt(1,el) - me = material_phaseMemberAt(1,ip,el) - invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) - invFe = matmul(constitutive_mech_Fp(ph)%data(1:3,1:3,me),math_inv33(F)) + invFp = math_inv33(phase_mechanical_Fp(ph)%data(1:3,1:3,me)) + invFe = math_inv33(phase_mechanical_Fe(ph)%data(1:3,1:3,me)) rho_edg_delta = rho0(:,mob_edg_pos) - rho0(:,mob_edg_neg) rho_scr_delta = rho0(:,mob_scr_pos) - rho0(:,mob_scr_neg) @@ -655,7 +654,7 @@ module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) rhoExcess(1,:) = rho_edg_delta rhoExcess(2,:) = rho_scr_delta - FVsize = IPvolume(ip,el) ** (1.0_pReal/3.0_pReal) + FVsize = geom(ph)%V_0(me) ** (1.0_pReal/3.0_pReal) !* loop through my neighborhood and get the connection vectors (in lattice frame) and the excess densities @@ -666,11 +665,10 @@ module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) neighbor_ip = IPneighborhood(2,n,ip,el) no = material_phasememberAt(1,neighbor_ip,neighbor_el) if (neighbor_el > 0 .and. neighbor_ip > 0) then - neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el)) - if (neighbor_instance == instance) then + if (material_phaseAt(1,neighbor_el) == ph) then nRealNeighbors = nRealNeighbors + 1.0_pReal - rho_neighbor0 = getRho0(instance,no,neighbor_ip,neighbor_el) + rho_neighbor0 = getRho0(ph,no) rho_edg_delta_neighbor(:,n) = rho_neighbor0(:,mob_edg_pos) - rho_neighbor0(:,mob_edg_neg) rho_scr_delta_neighbor(:,n) = rho_neighbor0(:,mob_scr_pos) - rho_neighbor0(:,mob_scr_neg) @@ -736,7 +734,7 @@ module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) where(rhoTotal > 0.0_pReal) rhoExcessGradient_over_rho = rhoExcessGradient / rhoTotal ! ... gives the local stress correction when multiplied with a factor - dst%tau_back(s,of) = - prm%mu * prm%b_sl(s) / (2.0_pReal * PI) & + dst%tau_back(s,me) = - prm%mu * prm%b_sl(s) / (2.0_pReal * PI) & * ( rhoExcessGradient_over_rho(1) / (1.0_pReal - prm%nu) & + rhoExcessGradient_over_rho(2)) enddo @@ -747,31 +745,29 @@ module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) .and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip)& .or. .not. debugConstitutive%selective)) then print'(/,a,i8,1x,i2,1x,i1,/)', '<< CONST >> nonlocal_microstructure at el ip ',el,ip - print'(a,/,12x,12(e10.3,1x))', '<< CONST >> rhoForest', stt%rho_forest(:,of) - print'(a,/,12x,12(f10.5,1x))', '<< CONST >> tauThreshold / MPa', dst%tau_pass(:,of)*1e-6 - print'(a,/,12x,12(f10.5,1x),/)', '<< CONST >> tauBack / MPa', dst%tau_back(:,of)*1e-6 + print'(a,/,12x,12(e10.3,1x))', '<< CONST >> rhoForest', stt%rho_forest(:,me) + print'(a,/,12x,12(f10.5,1x))', '<< CONST >> tauThreshold / MPa', dst%tau_pass(:,me)*1e-6 + print'(a,/,12x,12(f10.5,1x),/)', '<< CONST >> tauBack / MPa', dst%tau_back(:,me)*1e-6 endif #endif end associate -end subroutine plastic_nonlocal_dependentState +end subroutine nonlocal_dependentState !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp, & - Mp,Temperature,instance,of,ip,el) +module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, & + Mp,Temperature,ph,me) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & dLp_dMp integer, intent(in) :: & - instance, & - of, & - ip, & !< current integration point - el !< current element number + ph, & + me real(pReal), intent(in) :: & Temperature !< temperature @@ -786,24 +782,25 @@ module subroutine plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp, & l, & t, & !< dislocation type s !< index of my current slip system - real(pReal), dimension(param(instance)%sum_N_sl,8) :: & + real(pReal), dimension(param(ph)%sum_N_sl,8) :: & rhoSgl !< single dislocation densities (including blocked) - real(pReal), dimension(param(instance)%sum_N_sl,10) :: & + real(pReal), dimension(param(ph)%sum_N_sl,10) :: & rho - real(pReal), dimension(param(instance)%sum_N_sl,4) :: & + real(pReal), dimension(param(ph)%sum_N_sl,4) :: & v, & !< velocity tauNS, & !< resolved shear stress including non Schmid and backstress terms dv_dtau, & !< velocity derivative with respect to the shear stress dv_dtauNS !< velocity derivative with respect to the shear stress - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & tau, & !< resolved shear stress including backstress terms gdotTotal !< shear rate - associate(prm => param(instance),dst=>microstructure(instance),stt=>state(instance)) + associate(prm => param(ph),dst=>microstructure(ph),& + stt=>state(ph)) ns = prm%sum_N_sl !*** shortcut to state variables - rho = getRho(instance,of,ip,el) + rho = getRho(ph,me) rhoSgl = rho(:,sgl) do s = 1,ns @@ -818,12 +815,12 @@ module subroutine plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp, & tauNS(s,4) = math_tensordot(Mp, -prm%nonSchmid_pos(1:3,1:3,s)) endif enddo - tauNS = tauNS + spread(dst%tau_back(:,of),2,4) - tau = tau + dst%tau_back(:,of) + tauNS = tauNS + spread(dst%tau_back(:,me),2,4) + tau = tau + dst%tau_back(:,me) ! edges call kinetics(v(:,1), dv_dtau(:,1), dv_dtauNS(:,1), & - tau, tauNS(:,1), dst%tau_pass(:,of),1,Temperature, instance) + tau, tauNS(:,1), dst%tau_pass(:,me),1,Temperature, ph) v(:,2) = v(:,1) dv_dtau(:,2) = dv_dtau(:,1) dv_dtauNS(:,2) = dv_dtauNS(:,1) @@ -836,11 +833,11 @@ module subroutine plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp, & else do t = 3,4 call kinetics(v(:,t), dv_dtau(:,t), dv_dtauNS(:,t), & - tau, tauNS(:,t), dst%tau_pass(:,of),2,Temperature, instance) + tau, tauNS(:,t), dst%tau_pass(:,me),2,Temperature, ph) enddo endif - stt%v(:,of) = pack(v,.true.) + stt%v(:,me) = pack(v,.true.) !*** Bauschinger effect forall (s = 1:ns, t = 5:8, rhoSgl(s,t) * v(s,t-4) < 0.0_pReal) & @@ -863,53 +860,48 @@ module subroutine plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp, & end associate -end subroutine plastic_nonlocal_LpAndItsTangent +end subroutine nonlocal_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief (instantaneous) incremental change of microstructure !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) +module subroutine plastic_nonlocal_deltaState(Mp,ph,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress integer, intent(in) :: & - instance, & ! current instance of this plasticity - of, & !< offset - ip, & - el + ph, & + me integer :: & - ph, & !< phase ns, & ! short notation for the total number of active slip systems c, & ! character of dislocation t, & ! type of dislocation s ! index of my current slip system - real(pReal), dimension(param(instance)%sum_N_sl,10) :: & + real(pReal), dimension(param(ph)%sum_N_sl,10) :: & deltaRhoRemobilization, & ! density increment by remobilization deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change) - real(pReal), dimension(param(instance)%sum_N_sl,10) :: & + real(pReal), dimension(param(ph)%sum_N_sl,10) :: & rho ! current dislocation densities - real(pReal), dimension(param(instance)%sum_N_sl,4) :: & + real(pReal), dimension(param(ph)%sum_N_sl,4) :: & v ! dislocation glide velocity - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & tau ! current resolved shear stress - real(pReal), dimension(param(instance)%sum_N_sl,2) :: & + real(pReal), dimension(param(ph)%sum_N_sl,2) :: & rhoDip, & ! current dipole dislocation densities (screw and edge dipoles) dUpper, & ! current maximum stable dipole distance for edges and screws dUpperOld, & ! old maximum stable dipole distance for edges and screws deltaDUpper ! change in maximum stable dipole distance for edges and screws - ph = material_phaseAt(1,el) - - associate(prm => param(instance),dst => microstructure(instance),del => deltaState(instance)) - ns = prm%sum_N_sl + associate(prm => param(ph),dst => microstructure(ph),del => deltaState(ph)) + ns = prm%sum_N_sl !*** shortcut to state variables - forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) - forall (s = 1:ns, c = 1:2) dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,instance),of) + forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,ph),me) + forall (s = 1:ns, c = 1:2) dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,ph),me) - rho = getRho(instance,of,ip,el) + rho = getRho(ph,me) rhoDip = rho(:,dip) !**************************************************************************** @@ -930,7 +922,7 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) !*** calculate limits for stable dipole height do s = 1,prm%sum_N_sl - tau(s) = math_tensordot(Mp, prm%Schmid(1:3,1:3,s)) +dst%tau_back(s,of) + tau(s) = math_tensordot(Mp, prm%Schmid(1:3,1:3,s)) +dst%tau_back(s,me) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo @@ -954,19 +946,10 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) / (dUpperOld(s,c) - prm%minDipoleHeight(s,c)) forall (t=1:4) deltaRhoDipole2SingleStress(:,t) = -0.5_pReal * deltaRhoDipole2SingleStress(:,(t-1)/2+9) - forall (s = 1:ns, c = 1:2) plasticState(ph)%state(iD(s,c,instance),of) = dUpper(s,c) + forall (s = 1:ns, c = 1:2) plasticState(ph)%state(iD(s,c,ph),me) = dUpper(s,c) - plasticState(ph)%deltaState(:,of) = 0.0_pReal - del%rho(:,of) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) - -#ifdef DEBUG - if (debugConstitutive%extensive & - .and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip)& - .or. .not. debugConstitutive%selective)) then - print'(a,/,8(12x,12(e12.5,1x),/))', '<< CONST >> dislocation remobilization', deltaRhoRemobilization(:,1:8) - print'(a,/,10(12x,12(e12.5,1x),/),/)', '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress - endif -#endif + plasticState(ph)%deltaState(:,me) = 0.0_pReal + del%rho(:,me) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*ns]) end associate @@ -976,29 +959,26 @@ end subroutine plastic_nonlocal_deltaState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & - instance,of,ip,el) +module subroutine nonlocal_dotState(Mp, Temperature,timestep, & + ph,me,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress - real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F !< Deformation gradient real(pReal), intent(in) :: & Temperature, & !< temperature timestep !< substepped crystallite time increment integer, intent(in) :: & - instance, & - of, & + ph, & + me, & ip, & !< current integration point el !< current element number integer :: & - ph, & ns, & !< short notation for the total number of active slip systems c, & !< character of dislocation t, & !< type of dislocation s !< index of my current slip system - real(pReal), dimension(param(instance)%sum_N_sl,10) :: & + real(pReal), dimension(param(ph)%sum_N_sl,10) :: & rho, & rho0, & !< dislocation density at beginning of time step rhoDot, & !< density evolution @@ -1006,45 +986,44 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & rhoDotSingle2DipoleGlide, & !< density evolution by dipole formation (by glide) rhoDotAthermalAnnihilation, & !< density evolution by athermal annihilation rhoDotThermalAnnihilation !< density evolution by thermal annihilation - real(pReal), dimension(param(instance)%sum_N_sl,8) :: & + real(pReal), dimension(param(ph)%sum_N_sl,8) :: & rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) my_rhoSgl0 !< single dislocation densities of central ip (positive/negative screw and edge without dipoles) - real(pReal), dimension(param(instance)%sum_N_sl,4) :: & + real(pReal), dimension(param(ph)%sum_N_sl,4) :: & v, & !< current dislocation glide velocity v0, & gdot !< shear rates - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & tau, & !< current resolved shear stress vClimb !< climb velocity of edge dipoles - real(pReal), dimension(param(instance)%sum_N_sl,2) :: & + real(pReal), dimension(param(ph)%sum_N_sl,2) :: & rhoDip, & !< current dipole dislocation densities (screw and edge dipoles) dLower, & !< minimum stable dipole distance for edges and screws dUpper !< current maximum stable dipole distance for edges and screws real(pReal) :: & selfDiffusion !< self diffusion - ph = material_phaseAt(1,el) if (timestep <= 0.0_pReal) then plasticState(ph)%dotState = 0.0_pReal return endif - associate(prm => param(instance), & - dst => microstructure(instance), & - dot => dotState(instance), & - stt => state(instance)) + associate(prm => param(ph), & + dst => microstructure(ph), & + dot => dotState(ph), & + stt => state(ph)) ns = prm%sum_N_sl tau = 0.0_pReal gdot = 0.0_pReal - rho = getRho(instance,of,ip,el) + rho = getRho(ph,me) rhoSgl = rho(:,sgl) rhoDip = rho(:,dip) - rho0 = getRho0(instance,of,ip,el) + rho0 = getRho0(ph,me) my_rhoSgl0 = rho0(:,sgl) - forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) + forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,ph),me) gdot = rhoSgl(:,1:4) * v * spread(prm%b_sl,2,4) #ifdef DEBUG @@ -1059,7 +1038,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & !**************************************************************************** !*** limits for stable dipole height do s = 1,ns - tau(s) = math_tensordot(Mp, prm%Schmid(1:3,1:3,s)) + dst%tau_back(s,of) + tau(s) = math_tensordot(Mp, prm%Schmid(1:3,1:3,s)) + dst%tau_back(s,me) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo @@ -1080,20 +1059,20 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & isBCC: if (lattice_structure(ph) == LATTICE_bcc_ID) then forall (s = 1:ns, sum(abs(v(s,1:4))) > 0.0_pReal) rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / prm%b_sl(s) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(stt%rho_forest(s,of)) / prm%i_sl(s) ! & ! mean free path + * sqrt(stt%rho_forest(s,me)) / prm%i_sl(s) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation rhoDotMultiplication(s,3:4) = sum(abs(gdot(s,3:4))) /prm%b_sl(s) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(stt%rho_forest(s,of)) / prm%i_sl(s) ! & ! mean free path + * sqrt(stt%rho_forest(s,me)) / prm%i_sl(s) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation endforall else isBCC rhoDotMultiplication(:,1:4) = spread( & (sum(abs(gdot(:,1:2)),2) * prm%f_ed_mult + sum(abs(gdot(:,3:4)),2)) & - * sqrt(stt%rho_forest(:,of)) / prm%i_sl / prm%b_sl, 2, 4) + * sqrt(stt%rho_forest(:,me)) / prm%i_sl / prm%b_sl, 2, 4) endif isBCC - forall (s = 1:ns, t = 1:4) v0(s,t) = plasticState(ph)%state0(iV(s,t,instance),of) + forall (s = 1:ns, t = 1:4) v0(s,t) = plasticState(ph)%state0(iV(s,t,ph),me) !**************************************************************************** @@ -1136,10 +1115,10 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & if (lattice_structure(ph) == LATTICE_fcc_ID) & forall (s = 1:ns, prm%colinearSystem(s) > 0) & rhoDotAthermalAnnihilation(prm%colinearSystem(s),1:2) = - rhoDotAthermalAnnihilation(s,10) & - * 0.25_pReal * sqrt(stt%rho_forest(s,of)) * (dUpper(s,2) + dLower(s,2)) * prm%f_ed + * 0.25_pReal * sqrt(stt%rho_forest(s,me)) * (dUpper(s,2) + dLower(s,2)) * prm%f_ed - !*** thermally activated annihilation of edge dipoles by climb + !*** thermally activated annihilation me edge dipoles by climb rhoDotThermalAnnihilation = 0.0_pReal selfDiffusion = prm%D_0 * exp(-prm%Q_cl / (kB * Temperature)) vClimb = prm%V_at * selfDiffusion * prm%mu & @@ -1149,7 +1128,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) & - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have - rhoDot = rhoDotFlux(F,timestep, instance,of,ip,el) & + rhoDot = rhoDotFlux(timestep, ph,me,ip,el) & + rhoDotMultiplication & + rhoDotSingle2DipoleGlide & + rhoDotAthermalAnnihilation & @@ -1166,33 +1145,30 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & #endif plasticState(ph)%dotState = IEEE_value(1.0_pReal,IEEE_quiet_NaN) else - dot%rho(:,of) = pack(rhoDot,.true.) - dot%gamma(:,of) = sum(gdot,2) + dot%rho(:,me) = pack(rhoDot,.true.) + dot%gamma(:,me) = sum(gdot,2) endif end associate -end subroutine plastic_nonlocal_dotState +end subroutine nonlocal_dotState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -function rhoDotFlux(F,timestep, instance,of,ip,el) +function rhoDotFlux(timestep,ph,me,ip,el) - real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F !< Deformation gradient real(pReal), intent(in) :: & timestep !< substepped crystallite time increment integer, intent(in) :: & - instance, & - of, & + ph, & + me, & ip, & !< current integration point el !< current element number integer :: & - ph, & - neighbor_instance, & !< instance of my neighbor's plasticity + neighbor_ph, & !< phase of my neighbor's plasticity ns, & !< short notation for the total number of active slip systems c, & !< character of dislocation n, & !< index of my current neighbor @@ -1208,20 +1184,20 @@ function rhoDotFlux(F,timestep, instance,of,ip,el) np,& !< neighbor phase shortcut topp, & !< type of dislocation with opposite sign to t s !< index of my current slip system - real(pReal), dimension(param(instance)%sum_N_sl,10) :: & + real(pReal), dimension(param(ph)%sum_N_sl,10) :: & rho, & rho0, & !< dislocation density at beginning of time step rhoDotFlux !< density evolution by flux - real(pReal), dimension(param(instance)%sum_N_sl,8) :: & + real(pReal), dimension(param(ph)%sum_N_sl,8) :: & rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles) neighbor_rhoSgl0, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles) my_rhoSgl0 !< single dislocation densities of central ip (positive/negative screw and edge without dipoles) - real(pReal), dimension(param(instance)%sum_N_sl,4) :: & + real(pReal), dimension(param(ph)%sum_N_sl,4) :: & v, & !< current dislocation glide velocity v0, & neighbor_v0, & !< dislocation glide velocity of enighboring ip gdot !< shear rates - real(pReal), dimension(3,param(instance)%sum_N_sl,4) :: & + real(pReal), dimension(3,param(ph)%sum_N_sl,4) :: & m !< direction of dislocation motion real(pReal), dimension(3,3) :: & my_F, & !< my total deformation gradient @@ -1239,26 +1215,25 @@ function rhoDotFlux(F,timestep, instance,of,ip,el) transmissivity, & !< overall transmissivity of dislocation flux to neighboring material point lineLength !< dislocation line length leaving the current interface - ph = material_phaseAt(1,el) - associate(prm => param(instance), & - dst => microstructure(instance), & - dot => dotState(instance), & - stt => state(instance)) + associate(prm => param(ph), & + dst => microstructure(ph), & + dot => dotState(ph), & + stt => state(ph)) ns = prm%sum_N_sl gdot = 0.0_pReal - rho = getRho(instance,of,ip,el) + rho = getRho(ph,me) rhoSgl = rho(:,sgl) - rho0 = getRho0(instance,of,ip,el) + rho0 = getRho0(ph,me) my_rhoSgl0 = rho0(:,sgl) - forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,instance),of) !ToDo: MD: I think we should use state0 here + forall (s = 1:ns, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,ph),me) !ToDo: MD: I think we should use state0 here gdot = rhoSgl(:,1:4) * v * spread(prm%b_sl,2,4) - forall (s = 1:ns, t = 1:4) v0(s,t) = plasticState(ph)%state0(iV(s,t,instance),of) + forall (s = 1:ns, t = 1:4) v0(s,t) = plasticState(ph)%state0(iV(s,t,ph),me) !**************************************************************************** !*** calculate dislocation fluxes (only for nonlocal plasticity) @@ -1293,8 +1268,8 @@ function rhoDotFlux(F,timestep, instance,of,ip,el) m(1:3,:,3) = -prm%slip_transverse m(1:3,:,4) = prm%slip_transverse - my_F = F(1:3,1:3,1,ip,el) - my_Fe = matmul(my_F, math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,of))) + my_F = phase_mechanical_F(ph)%data(1:3,1:3,me) + my_Fe = matmul(my_F, math_inv33(phase_mechanical_Fp(ph)%data(1:3,1:3,me))) neighbors: do n = 1,nIPneighbors @@ -1310,9 +1285,9 @@ function rhoDotFlux(F,timestep, instance,of,ip,el) opposite_n = IPneighborhood(3,opposite_neighbor,ip,el) if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient - neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el)) - neighbor_F = F(1:3,1:3,1,neighbor_ip,neighbor_el) - neighbor_Fe = matmul(neighbor_F, math_inv33(constitutive_mech_Fp(np)%data(1:3,1:3,no))) + neighbor_ph = material_phaseAt(1,neighbor_el) + neighbor_F = phase_mechanical_F(np)%data(1:3,1:3,no) + neighbor_Fe = matmul(neighbor_F, math_inv33(phase_mechanical_Fp(np)%data(1:3,1:3,no))) Favg = 0.5_pReal * (my_F + neighbor_F) else ! if no neighbor, take my value as average Favg = my_F @@ -1333,8 +1308,8 @@ function rhoDotFlux(F,timestep, instance,of,ip,el) any(compatibility(:,:,:,n,ip,el) > 0.0_pReal)) then forall (s = 1:ns, t = 1:4) - neighbor_v0(s,t) = plasticState(np)%state0(iV (s,t,neighbor_instance),no) - neighbor_rhoSgl0(s,t) = max(plasticState(np)%state0(iRhoU(s,t,neighbor_instance),no),0.0_pReal) + neighbor_v0(s,t) = plasticState(np)%state0(iV (s,t,neighbor_ph),no) + neighbor_rhoSgl0(s,t) = max(plasticState(np)%state0(iRhoU(s,t,neighbor_ph),no),0.0_pReal) endforall where (neighbor_rhoSgl0 * IPvolume(neighbor_ip,neighbor_el) ** 0.667_pReal < prm%rho_min & @@ -1417,39 +1392,39 @@ end function rhoDotFlux ! plane normals and signed cosine of the angle between the slip directions. Only the largest values ! that sum up to a total of 1 are considered, all others are set to zero. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_updateCompatibility(orientation,instance,i,e) +module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,i,e) type(rotation), dimension(1,discretization_nIPs,discretization_Nelems), intent(in) :: & orientation ! crystal orientation integer, intent(in) :: & - instance, & + ph, & i, & e integer :: & n, & ! neighbor index + me, & neighbor_e, & ! element index of my neighbor neighbor_i, & ! integration point index of my neighbor - ph, & + neighbor_me, & neighbor_phase, & ns, & ! number of active slip systems s1, & ! slip system index (me) s2 ! slip system index (my neighbor) - real(pReal), dimension(2,param(instance)%sum_N_sl,param(instance)%sum_N_sl,nIPneighbors) :: & + real(pReal), dimension(2,param(ph)%sum_N_sl,param(ph)%sum_N_sl,nIPneighbors) :: & my_compatibility ! my_compatibility for current element and ip real(pReal) :: & my_compatibilitySum, & thresholdValue, & nThresholdValues - logical, dimension(param(instance)%sum_N_sl) :: & + logical, dimension(param(ph)%sum_N_sl) :: & belowThreshold type(rotation) :: mis - ph = material_phaseAt(1,e) - - associate(prm => param(instance)) + associate(prm => param(ph)) ns = prm%sum_N_sl + me = material_phaseMemberAt(1,i,e) !*** start out fully compatible my_compatibility = 0.0_pReal forall(s1 = 1:ns) my_compatibility(:,s1,s1,:) = 1.0_pReal @@ -1457,7 +1432,7 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,instance,i,e) neighbors: do n = 1,nIPneighbors neighbor_e = IPneighborhood(1,n,i,e) neighbor_i = IPneighborhood(2,n,i,e) - + neighbor_me = material_phaseMemberAt(1,neighbor_i,neighbor_e) neighbor_phase = material_phaseAt(1,neighbor_e) if (neighbor_e <= 0 .or. neighbor_i <= 0) then @@ -1475,8 +1450,8 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,instance,i,e) elseif (prm%chi_GB >= 0.0_pReal) then !* GRAIN BOUNDARY ! !* fixed transmissivity for adjacent ips with different texture (only if explicitly given in material.config) - if (any(dNeq(material_orientation0(1,i,e)%asQuaternion(), & - material_orientation0(1,neighbor_i,neighbor_e)%asQuaternion())) .and. & + if (any(dNeq(material_orientation0(1,ph,me)%asQuaternion(), & + material_orientation0(1,neighbor_phase,neighbor_me)%asQuaternion())) .and. & (.not. phase_localPlasticity(neighbor_phase))) & forall(s1 = 1:ns) my_compatibility(:,s1,s1,n) = sqrt(prm%chi_GB) else @@ -1533,14 +1508,14 @@ end subroutine plastic_nonlocal_updateCompatibility !-------------------------------------------------------------------------------------------------- !> @brief writes results to HDF5 output file !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_results(instance,group) +module subroutine plastic_nonlocal_results(ph,group) - integer, intent(in) :: instance + integer, intent(in) :: ph character(len=*),intent(in) :: group integer :: o - associate(prm => param(instance),dst => microstructure(instance),stt=>state(instance)) + associate(prm => param(ph),dst => microstructure(ph),stt=>state(ph)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case('rho_u_ed_pos') @@ -1604,17 +1579,16 @@ end subroutine plastic_nonlocal_results !-------------------------------------------------------------------------------------------------- !> @brief populates the initial dislocation density !-------------------------------------------------------------------------------------------------- -subroutine stateInit(ini,phase,Nconstituents,instance) +subroutine stateInit(ini,phase,Nmembers) type(tInitialParameters) :: & ini integer,intent(in) :: & phase, & - Nconstituents, & - instance + Nmembers integer :: & - e, & i, & + e, & f, & from, & upto, & @@ -1628,11 +1602,11 @@ subroutine stateInit(ini,phase,Nconstituents,instance) totalVolume, & densityBinning, & minimumIpVolume - real(pReal), dimension(Nconstituents) :: & + real(pReal), dimension(Nmembers) :: & volume - associate(stt => state(instance)) + associate(stt => state(phase)) if (ini%random_rho_u > 0.0_pReal) then ! randomly distribute dislocation segments on random slip system and of random type in the volume do e = 1,discretization_Nelems @@ -1648,21 +1622,21 @@ subroutine stateInit(ini,phase,Nconstituents,instance) meanDensity = 0.0_pReal do while(meanDensity < ini%random_rho_u) call random_number(rnd) - phasemember = nint(rnd(1)*real(Nconstituents,pReal) + 0.5_pReal) + phasemember = nint(rnd(1)*real(Nmembers,pReal) + 0.5_pReal) s = nint(rnd(2)*real(sum(ini%N_sl),pReal)*4.0_pReal + 0.5_pReal) meanDensity = meanDensity + densityBinning * volume(phasemember) / totalVolume stt%rhoSglMobile(s,phasemember) = densityBinning enddo else ! homogeneous distribution with noise - do e = 1, Nconstituents + do e = 1, Nmembers do f = 1,size(ini%N_sl,1) from = 1 + sum(ini%N_sl(1:f-1)) upto = sum(ini%N_sl(1:f)) do s = from,upto noise = [math_sampleGaussVar(0.0_pReal, ini%sigma_rho_u), & math_sampleGaussVar(0.0_pReal, ini%sigma_rho_u)] - stt%rho_sgl_mob_edg_pos(s,e) = ini%rho_u_ed_pos_0(f) + noise(1) - stt%rho_sgl_mob_edg_neg(s,e) = ini%rho_u_ed_neg_0(f) + noise(1) + stt%rho_sgl_mob_edg_pos(s,e) = ini%rho_u_ed_pos_0(f) + noise(1) + stt%rho_sgl_mob_edg_neg(s,e) = ini%rho_u_ed_neg_0(f) + noise(1) stt%rho_sgl_mob_scr_pos(s,e) = ini%rho_u_sc_pos_0(f) + noise(2) stt%rho_sgl_mob_scr_neg(s,e) = ini%rho_u_sc_neg_0(f) + noise(2) enddo @@ -1680,18 +1654,18 @@ end subroutine stateInit !-------------------------------------------------------------------------------------------------- !> @brief calculates kinetics !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, tauThreshold, c, Temperature, instance) +pure subroutine kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, tauThreshold, c, Temperature, ph) integer, intent(in) :: & c, & !< dislocation character (1:edge, 2:screw) - instance + ph real(pReal), intent(in) :: & Temperature !< temperature - real(pReal), dimension(param(instance)%sum_N_sl), intent(in) :: & + real(pReal), dimension(param(ph)%sum_N_sl), intent(in) :: & tau, & !< resolved external shear stress (without non Schmid effects) tauNS, & !< resolved external shear stress (including non Schmid effects) tauThreshold !< threshold shear stress - real(pReal), dimension(param(instance)%sum_N_sl), intent(out) :: & + real(pReal), dimension(param(ph)%sum_N_sl), intent(out) :: & v, & !< velocity dv_dtau, & !< velocity derivative with respect to resolved shear stress (without non Schmid contributions) dv_dtauNS !< velocity derivative with respect to resolved shear stress (including non Schmid contributions) @@ -1722,7 +1696,7 @@ pure subroutine kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, tauThreshold, c, Tem criticalStress_S, & !< maximum obstacle strength mobility !< dislocation mobility - associate(prm => param(instance)) + associate(prm => param(ph)) ns = prm%sum_N_sl v = 0.0_pReal dv_dtau = 0.0_pReal @@ -1795,21 +1769,22 @@ end subroutine kinetics !> @brief returns copy of current dislocation densities from state !> @details raw values is rectified !-------------------------------------------------------------------------------------------------- -pure function getRho(instance,of,ip,el) +pure function getRho(ph,me) - integer, intent(in) :: instance, of,ip,el - real(pReal), dimension(param(instance)%sum_N_sl,10) :: getRho + integer, intent(in) :: ph, me + real(pReal), dimension(param(ph)%sum_N_sl,10) :: getRho - associate(prm => param(instance)) - getRho = reshape(state(instance)%rho(:,of),[prm%sum_N_sl,10]) + associate(prm => param(ph)) - ! ensure positive densities (not for imm, they have a sign) - getRho(:,mob) = max(getRho(:,mob),0.0_pReal) - getRho(:,dip) = max(getRho(:,dip),0.0_pReal) + getRho = reshape(state(ph)%rho(:,me),[prm%sum_N_sl,10]) - where(abs(getRho) < max(prm%rho_min/IPvolume(ip,el)**(2.0_pReal/3.0_pReal),prm%rho_significant)) & - getRho = 0.0_pReal + ! ensure positive densities (not for imm, they have a sign) + getRho(:,mob) = max(getRho(:,mob),0.0_pReal) + getRho(:,dip) = max(getRho(:,dip),0.0_pReal) + + where(abs(getRho) < max(prm%rho_min/geom(ph)%V_0(me)**(2.0_pReal/3.0_pReal),prm%rho_significant)) & + getRho = 0.0_pReal end associate @@ -1820,24 +1795,43 @@ end function getRho !> @brief returns copy of current dislocation densities from state !> @details raw values is rectified !-------------------------------------------------------------------------------------------------- -pure function getRho0(instance,of,ip,el) +pure function getRho0(ph,me) - integer, intent(in) :: instance, of,ip,el - real(pReal), dimension(param(instance)%sum_N_sl,10) :: getRho0 + integer, intent(in) :: ph, me + real(pReal), dimension(param(ph)%sum_N_sl,10) :: getRho0 - associate(prm => param(instance)) - getRho0 = reshape(state0(instance)%rho(:,of),[prm%sum_N_sl,10]) + associate(prm => param(ph)) - ! ensure positive densities (not for imm, they have a sign) - getRho0(:,mob) = max(getRho0(:,mob),0.0_pReal) - getRho0(:,dip) = max(getRho0(:,dip),0.0_pReal) + getRho0 = reshape(state0(ph)%rho(:,me),[prm%sum_N_sl,10]) - where(abs(getRho0) < max(prm%rho_min/IPvolume(ip,el)**(2.0_pReal/3.0_pReal),prm%rho_significant)) & - getRho0 = 0.0_pReal + ! ensure positive densities (not for imm, they have a sign) + getRho0(:,mob) = max(getRho0(:,mob),0.0_pReal) + getRho0(:,dip) = max(getRho0(:,dip),0.0_pReal) + + where (abs(getRho0) < max(prm%rho_min/geom(ph)%V_0(me)**(2.0_pReal/3.0_pReal),prm%rho_significant)) & + getRho0 = 0.0_pReal end associate end function getRho0 -end submodule plastic_nonlocal + +subroutine storeGeometry(ph) + + integer, intent(in) :: ph + + integer :: ip, el, ce, co + real(pReal), dimension(:), allocatable :: V + + + V = reshape(IPvolume,[product(shape(IPvolume))]) + do ce = 1, size(material_homogenizationMemberAt2,1) + do co = 1, homogenization_maxNconstituents + if (material_phaseAt2(co,ce) == ph) geom(ph)%V_0(material_phaseMemberAt2(co,ce)) = V(ce) + enddo + enddo + +end subroutine + +end submodule nonlocal diff --git a/src/constitutive_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 similarity index 80% rename from src/constitutive_plastic_phenopowerlaw.f90 rename to src/phase_mechanical_plastic_phenopowerlaw.f90 index 678acad27..ae5926c0f 100644 --- a/src/constitutive_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -4,7 +4,7 @@ !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief phenomenological crystal plasticity formulation using a powerlaw fitting !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_mech) plastic_phenopowerlaw +submodule(phase:plastic) phenopowerlaw type :: tParameters real(pReal) :: & @@ -70,9 +70,8 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) logical, dimension(:), allocatable :: myPlasticity integer :: & - Ninstances, & - p, i, & - Nconstituents, & + ph, i, & + Nmembers, & sizeState, sizeDotState, & startIndex, endIndex integer, dimension(:), allocatable :: & @@ -89,27 +88,26 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) mech, & pl - print'(/,a)', ' <<<+- plastic_phenopowerlaw init -+>>>' myPlasticity = plastic_active('phenopowerlaw') - Ninstances = count(myPlasticity) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return + if(count(myPlasticity) == 0) return + + print'(/,a)', ' <<<+- phase:mechanical:plastic:phenopowerlaw init -+>>>' + print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT) - allocate(param(Ninstances)) - allocate(state(Ninstances)) - allocate(dotState(Ninstances)) phases => config_material%get('phase') - i = 0 - do p = 1, phases%length - phase => phases%get(p) + allocate(param(phases%length)) + allocate(state(phases%length)) + allocate(dotState(phases%length)) + + do ph = 1, phases%length + if(.not. myPlasticity(ph)) cycle + + associate(prm => param(ph), dot => dotState(ph), stt => state(ph)) + + phase => phases%get(ph) mech => phase%get('mechanics') - if(.not. myPlasticity(p)) cycle - i = i + 1 - associate(prm => param(i), & - dot => dotState(i), & - stt => state(i)) pl => mech%get('plasticity') !-------------------------------------------------------------------------------------------------- @@ -136,7 +134,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) xi_0_sl = pl%get_asFloats('xi_0_sl', requiredSize=size(N_sl)) prm%xi_inf_sl = pl%get_asFloats('xi_inf_sl', requiredSize=size(N_sl)) prm%h_int = pl%get_asFloats('h_int', requiredSize=size(N_sl), & - defaultVal=[(0.0_pReal,i=1,size(N_sl))]) + defaultVal=[(0.0_pReal,i=1,size(N_sl))]) prm%dot_gamma_0_sl = pl%get_asFloat('dot_gamma_0_sl') prm%n_sl = pl%get_asFloat('n_sl') @@ -225,49 +223,49 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) !-------------------------------------------------------------------------------------------------- ! allocate state arrays - Nconstituents = count(material_phaseAt == p) * discretization_nIPs + Nmembers = count(material_phaseAt2 == ph) sizeDotState = size(['xi_sl ','gamma_sl']) * prm%sum_N_sl & + size(['xi_tw ','gamma_tw']) * prm%sum_N_tw sizeState = sizeDotState - call constitutive_allocateState(plasticState(p),Nconstituents,sizeState,sizeDotState,0) + call phase_allocateState(plasticState(ph),Nmembers,sizeState,sizeDotState,0) !-------------------------------------------------------------------------------------------------- ! state aliases and initialization startIndex = 1 endIndex = prm%sum_N_sl - stt%xi_slip => plasticState(p)%state (startIndex:endIndex,:) - stt%xi_slip = spread(xi_0_sl, 2, Nconstituents) - dot%xi_slip => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) - if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi' + stt%xi_slip => plasticState(ph)%state (startIndex:endIndex,:) + stt%xi_slip = spread(xi_0_sl, 2, Nmembers) + dot%xi_slip => plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) + if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi' startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_tw - stt%xi_twin => plasticState(p)%state (startIndex:endIndex,:) - stt%xi_twin = spread(xi_0_tw, 2, Nconstituents) - dot%xi_twin => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) - if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi' + stt%xi_twin => plasticState(ph)%state (startIndex:endIndex,:) + stt%xi_twin = spread(xi_0_tw, 2, Nmembers) + dot%xi_twin => plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) + if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi' startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl - stt%gamma_slip => plasticState(p)%state (startIndex:endIndex,:) - dot%gamma_slip => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) - if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma' + stt%gamma_slip => plasticState(ph)%state (startIndex:endIndex,:) + dot%gamma_slip => plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) + if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma' ! global alias - plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(ph)%slipRate => plasticState(ph)%dotState(startIndex:endIndex,:) startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_tw - stt%gamma_twin => plasticState(p)%state (startIndex:endIndex,:) - dot%gamma_twin => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) - if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma' + stt%gamma_twin => plasticState(ph)%state (startIndex:endIndex,:) + dot%gamma_twin => plasticState(ph)%dotState(startIndex:endIndex,:) + plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) + if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma' - plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally + plasticState(ph)%state0 = plasticState(ph)%state ! ToDo: this could be done centrally end associate @@ -285,7 +283,7 @@ end function plastic_phenopowerlaw_init !> @details asummes that deformation by dislocation glide affects twinned and untwinned volume ! equally (Taylor assumption). Twinning happens only in untwinned volume !-------------------------------------------------------------------------------------------------- -pure module subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) +pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,me) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient @@ -295,23 +293,23 @@ pure module subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,insta real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & - instance, & - of + ph, & + me integer :: & i,k,l,m,n - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & gdot_slip_pos,gdot_slip_neg, & dgdot_dtauslip_pos,dgdot_dtauslip_neg - real(pReal), dimension(param(instance)%sum_N_tw) :: & + real(pReal), dimension(param(ph)%sum_N_tw) :: & gdot_twin,dgdot_dtautwin Lp = 0.0_pReal dLp_dMp = 0.0_pReal - associate(prm => param(instance)) + associate(prm => param(ph)) - call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg) + call kinetics_slip(Mp,ph,me,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg) slipSystems: do i = 1, prm%sum_N_sl Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%P_sl(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & @@ -320,7 +318,7 @@ pure module subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,insta + dgdot_dtauslip_neg(i) * prm%P_sl(k,l,i) * prm%nonSchmid_neg(m,n,i) enddo slipSystems - call kinetics_twin(Mp,instance,of,gdot_twin,dgdot_dtautwin) + call kinetics_twin(Mp,ph,me,gdot_twin,dgdot_dtautwin) twinSystems: do i = 1, prm%sum_N_tw Lp = Lp + gdot_twin(i)*prm%P_tw(1:3,1:3,i) forall (k=1:3,l=1:3,m=1:3,n=1:3) & @@ -330,32 +328,33 @@ pure module subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,insta end associate -end subroutine plastic_phenopowerlaw_LpAndItsTangent +end subroutine phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) +module subroutine phenopowerlaw_dotState(Mp,ph,me) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & - instance, & - of + ph, & + me real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & xi_slip_sat_offset,& sumGamma,sumF - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & left_SlipSlip,right_SlipSlip, & gdot_slip_pos,gdot_slip_neg - associate(prm => param(instance), stt => state(instance), dot => dotState(instance)) + associate(prm => param(ph), stt => state(ph), & + dot => dotState(ph)) - sumGamma = sum(stt%gamma_slip(:,of)) - sumF = sum(stt%gamma_twin(:,of)/prm%gamma_tw_char) + sumGamma = sum(stt%gamma_slip(:,me)) + sumF = sum(stt%gamma_twin(:,me)/prm%gamma_tw_char) !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices @@ -367,39 +366,39 @@ module subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) ! calculate left and right vectors left_SlipSlip = 1.0_pReal + prm%h_int xi_slip_sat_offset = prm%f_sl_sat_tw*sqrt(sumF) - right_SlipSlip = abs(1.0_pReal-stt%xi_slip(:,of) / (prm%xi_inf_sl+xi_slip_sat_offset)) **prm%a_sl & - * sign(1.0_pReal,1.0_pReal-stt%xi_slip(:,of) / (prm%xi_inf_sl+xi_slip_sat_offset)) + right_SlipSlip = abs(1.0_pReal-stt%xi_slip(:,me) / (prm%xi_inf_sl+xi_slip_sat_offset)) **prm%a_sl & + * sign(1.0_pReal,1.0_pReal-stt%xi_slip(:,me) / (prm%xi_inf_sl+xi_slip_sat_offset)) !-------------------------------------------------------------------------------------------------- ! shear rates - call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg) - dot%gamma_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg) - call kinetics_twin(Mp,instance,of,dot%gamma_twin(:,of)) + call kinetics_slip(Mp,ph,me,gdot_slip_pos,gdot_slip_neg) + dot%gamma_slip(:,me) = abs(gdot_slip_pos+gdot_slip_neg) + call kinetics_twin(Mp,ph,me,dot%gamma_twin(:,me)) !-------------------------------------------------------------------------------------------------- ! hardening - dot%xi_slip(:,of) = c_SlipSlip * left_SlipSlip * & - matmul(prm%h_sl_sl,dot%gamma_slip(:,of)*right_SlipSlip) & - + matmul(prm%h_sl_tw,dot%gamma_twin(:,of)) + dot%xi_slip(:,me) = c_SlipSlip * left_SlipSlip * & + matmul(prm%h_sl_sl,dot%gamma_slip(:,me)*right_SlipSlip) & + + matmul(prm%h_sl_tw,dot%gamma_twin(:,me)) - dot%xi_twin(:,of) = c_TwinSlip * matmul(prm%h_tw_sl,dot%gamma_slip(:,of)) & - + c_TwinTwin * matmul(prm%h_tw_tw,dot%gamma_twin(:,of)) + dot%xi_twin(:,me) = c_TwinSlip * matmul(prm%h_tw_sl,dot%gamma_slip(:,me)) & + + c_TwinTwin * matmul(prm%h_tw_tw,dot%gamma_twin(:,me)) end associate -end subroutine plastic_phenopowerlaw_dotState +end subroutine phenopowerlaw_dotState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_phenopowerlaw_results(instance,group) +module subroutine plastic_phenopowerlaw_results(ph,group) - integer, intent(in) :: instance + integer, intent(in) :: ph character(len=*), intent(in) :: group integer :: o - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(ph), stt => state(ph)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) @@ -431,28 +430,28 @@ end subroutine plastic_phenopowerlaw_results ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end. !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_slip(Mp,instance,of, & +pure subroutine kinetics_slip(Mp,ph,me, & gdot_slip_pos,gdot_slip_neg,dgdot_dtau_slip_pos,dgdot_dtau_slip_neg) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & - instance, & - of + ph, & + me - real(pReal), intent(out), dimension(param(instance)%sum_N_sl) :: & + real(pReal), intent(out), dimension(param(ph)%sum_N_sl) :: & gdot_slip_pos, & gdot_slip_neg - real(pReal), intent(out), optional, dimension(param(instance)%sum_N_sl) :: & + real(pReal), intent(out), optional, dimension(param(ph)%sum_N_sl) :: & dgdot_dtau_slip_pos, & dgdot_dtau_slip_neg - real(pReal), dimension(param(instance)%sum_N_sl) :: & + real(pReal), dimension(param(ph)%sum_N_sl) :: & tau_slip_pos, & tau_slip_neg integer :: i - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(ph), stt => state(ph)) do i = 1, prm%sum_N_sl tau_slip_pos(i) = math_tensordot(Mp,prm%nonSchmid_pos(1:3,1:3,i)) @@ -462,14 +461,14 @@ pure subroutine kinetics_slip(Mp,instance,of, & where(dNeq0(tau_slip_pos)) gdot_slip_pos = prm%dot_gamma_0_sl * merge(0.5_pReal,1.0_pReal, prm%nonSchmidActive) & ! 1/2 if non-Schmid active - * sign(abs(tau_slip_pos/stt%xi_slip(:,of))**prm%n_sl, tau_slip_pos) + * sign(abs(tau_slip_pos/stt%xi_slip(:,me))**prm%n_sl, tau_slip_pos) else where gdot_slip_pos = 0.0_pReal end where where(dNeq0(tau_slip_neg)) gdot_slip_neg = prm%dot_gamma_0_sl * 0.5_pReal & ! only used if non-Schmid active, always 1/2 - * sign(abs(tau_slip_neg/stt%xi_slip(:,of))**prm%n_sl, tau_slip_neg) + * sign(abs(tau_slip_neg/stt%xi_slip(:,me))**prm%n_sl, tau_slip_neg) else where gdot_slip_neg = 0.0_pReal end where @@ -500,33 +499,33 @@ end subroutine kinetics_slip ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end. !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_twin(Mp,instance,of,& +pure subroutine kinetics_twin(Mp,ph,me,& gdot_twin,dgdot_dtau_twin) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & - instance, & - of + ph, & + me - real(pReal), dimension(param(instance)%sum_N_tw), intent(out) :: & + real(pReal), dimension(param(ph)%sum_N_tw), intent(out) :: & gdot_twin - real(pReal), dimension(param(instance)%sum_N_tw), intent(out), optional :: & + real(pReal), dimension(param(ph)%sum_N_tw), intent(out), optional :: & dgdot_dtau_twin - real(pReal), dimension(param(instance)%sum_N_tw) :: & + real(pReal), dimension(param(ph)%sum_N_tw) :: & tau_twin integer :: i - associate(prm => param(instance), stt => state(instance)) + associate(prm => param(ph), stt => state(ph)) do i = 1, prm%sum_N_tw tau_twin(i) = math_tensordot(Mp,prm%P_tw(1:3,1:3,i)) enddo where(tau_twin > 0.0_pReal) - gdot_twin = (1.0_pReal-sum(stt%gamma_twin(:,of)/prm%gamma_tw_char)) & ! only twin in untwinned volume fraction - * prm%dot_gamma_0_tw*(abs(tau_twin)/stt%xi_twin(:,of))**prm%n_tw + gdot_twin = (1.0_pReal-sum(stt%gamma_twin(:,me)/prm%gamma_tw_char)) & ! only twin in untwinned volume fraction + * prm%dot_gamma_0_tw*(abs(tau_twin)/stt%xi_twin(:,me))**prm%n_tw else where gdot_twin = 0.0_pReal end where @@ -543,4 +542,4 @@ pure subroutine kinetics_twin(Mp,instance,of,& end subroutine kinetics_twin -end submodule plastic_phenopowerlaw +end submodule phenopowerlaw diff --git a/src/phase_thermal.f90 b/src/phase_thermal.f90 new file mode 100644 index 000000000..21ec93c9c --- /dev/null +++ b/src/phase_thermal.f90 @@ -0,0 +1,310 @@ +!---------------------------------------------------------------------------------------------------- +!> @brief internal microstructure state for all thermal sources and kinematics constitutive models +!---------------------------------------------------------------------------------------------------- +submodule(phase) thermal + + integer, dimension(:), allocatable :: & + thermal_Nsources + + type(tSourceState), allocatable, dimension(:) :: & + thermalState + + enum, bind(c); enumerator :: & + THERMAL_UNDEFINED_ID ,& + THERMAL_DISSIPATION_ID, & + THERMAL_EXTERNALHEAT_ID + end enum + + type :: tDataContainer ! ?? not very telling name. Better: "fieldQuantities" ?? + real(pReal), dimension(:), allocatable :: T, dot_T + end type tDataContainer + integer(kind(THERMAL_UNDEFINED_ID)), dimension(:,:), allocatable :: & + thermal_source + + type(tDataContainer), dimension(:), allocatable :: current ! ?? not very telling name. Better: "field" ?? + + integer :: thermal_source_maxSizeDotState + + + interface + + module function dissipation_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + end function dissipation_init + + module function externalheat_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + end function externalheat_init + + + module subroutine externalheat_dotState(ph, me) + integer, intent(in) :: & + ph, & + me + end subroutine externalheat_dotState + + module subroutine dissipation_getRate(TDot, ph,me) + integer, intent(in) :: & + ph, & + me + real(pReal), intent(out) :: & + TDot + end subroutine dissipation_getRate + + module subroutine externalheat_getRate(TDot, ph,me) + integer, intent(in) :: & + ph, & + me + real(pReal), intent(out) :: & + TDot + end subroutine externalheat_getRate + + end interface + +contains + +!---------------------------------------------------------------------------------------------- +!< @brief initializes thermal sources and kinematics mechanism +!---------------------------------------------------------------------------------------------- +module subroutine thermal_init(phases) + + class(tNode), pointer :: & + phases + + class(tNode), pointer :: & + phase, thermal, sources + + integer :: & + ph, so, & + Nmembers + + + print'(/,a)', ' <<<+- phase:thermal init -+>>>' + + allocate(current(phases%length)) + + allocate(thermalState(phases%length)) + allocate(thermal_Nsources(phases%length),source = 0) + + do ph = 1, phases%length + Nmembers = count(material_phaseAt2 == ph) + allocate(current(ph)%T(Nmembers),source=300.0_pReal) + allocate(current(ph)%dot_T(Nmembers),source=0.0_pReal) + phase => phases%get(ph) + thermal => phase%get('thermal',defaultVal=emptyDict) + sources => thermal%get('source',defaultVal=emptyList) + thermal_Nsources(ph) = sources%length + allocate(thermalstate(ph)%p(thermal_Nsources(ph))) + enddo + + allocate(thermal_source(maxval(thermal_Nsources),phases%length), source = THERMAL_UNDEFINED_ID) + + if (maxval(thermal_Nsources) /= 0) then + where(dissipation_init (maxval(thermal_Nsources))) thermal_source = THERMAL_DISSIPATION_ID + where(externalheat_init(maxval(thermal_Nsources))) thermal_source = THERMAL_EXTERNALHEAT_ID + endif + + thermal_source_maxSizeDotState = 0 + do ph = 1,phases%length + + do so = 1,thermal_Nsources(ph) + thermalState(ph)%p(so)%state = thermalState(ph)%p(so)%state0 + enddo + + thermal_source_maxSizeDotState = max(thermal_source_maxSizeDotState, & + maxval(thermalState(ph)%p%sizeDotState)) + enddo + +end subroutine thermal_init + + +!---------------------------------------------------------------------------------------------- +!< @brief calculates thermal dissipation rate +!---------------------------------------------------------------------------------------------- +module subroutine phase_thermal_getRate(TDot, ph,me) + + integer, intent(in) :: ph, me + real(pReal), intent(out) :: & + TDot + + real(pReal) :: & + my_Tdot + integer :: & + so + + + TDot = 0.0_pReal + + do so = 1, thermal_Nsources(ph) + select case(thermal_source(so,ph)) + case (THERMAL_DISSIPATION_ID) + call dissipation_getRate(my_Tdot, ph,me) + + case (THERMAL_EXTERNALHEAT_ID) + call externalheat_getRate(my_Tdot, ph,me) + + case default + my_Tdot = 0.0_pReal + end select + Tdot = Tdot + my_Tdot + enddo + +end subroutine phase_thermal_getRate + + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +function phase_thermal_collectDotState(ph,me) result(broken) + + integer, intent(in) :: ph, me + logical :: broken + + integer :: i + + + broken = .false. + + SourceLoop: do i = 1, thermal_Nsources(ph) + + if (thermal_source(i,ph) == THERMAL_EXTERNALHEAT_ID) & + call externalheat_dotState(ph,me) + + broken = broken .or. any(IEEE_is_NaN(thermalState(ph)%p(i)%dotState(:,me))) + + enddo SourceLoop + +end function phase_thermal_collectDotState + + +module function thermal_stress(Delta_t,ph,me) result(converged_) ! ?? why is this called "stress" when it seems closer to "updateState" ?? + + real(pReal), intent(in) :: Delta_t + integer, intent(in) :: ph, me + logical :: converged_ + + + converged_ = .not. integrateThermalState(Delta_t,ph,me) + +end function thermal_stress + + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate state with 1st order explicit Euler method +!-------------------------------------------------------------------------------------------------- +function integrateThermalState(Delta_t, ph,me) result(broken) + + real(pReal), intent(in) :: Delta_t + integer, intent(in) :: ph, me + logical :: & + broken + + integer :: & + so, & + sizeDotState + + broken = phase_thermal_collectDotState(ph,me) + if (broken) return + + do so = 1, thermal_Nsources(ph) + sizeDotState = thermalState(ph)%p(so)%sizeDotState + thermalState(ph)%p(so)%state(1:sizeDotState,me) = thermalState(ph)%p(so)%state0(1:sizeDotState,me) & + + thermalState(ph)%p(so)%dotState(1:sizeDotState,me) * Delta_t + enddo + +end function integrateThermalState + + +module subroutine thermal_forward() + + integer :: ph, so + + + do ph = 1, size(thermalState) + do so = 1, size(thermalState(ph)%p) + thermalState(ph)%p(so)%state0 = thermalState(ph)%p(so)%state + enddo + enddo + +end subroutine thermal_forward + + +!---------------------------------------------------------------------------------------------- +!< @brief Get temperature (for use by non-thermal physics) +!---------------------------------------------------------------------------------------------- +module function thermal_T(ph,me) result(T) + + integer, intent(in) :: ph, me + real(pReal) :: T + + + T = current(ph)%T(me) + +end function thermal_T + + +!---------------------------------------------------------------------------------------------- +!< @brief Get rate of temperature (for use by non-thermal physics) +!---------------------------------------------------------------------------------------------- +module function thermal_dot_T(ph,me) result(dot_T) + + integer, intent(in) :: ph, me + real(pReal) :: dot_T + + + dot_T = current(ph)%dot_T(me) + +end function thermal_dot_T + + +!---------------------------------------------------------------------------------------------- +!< @brief Set temperature +!---------------------------------------------------------------------------------------------- +module subroutine phase_thermal_setField(T,dot_T, co,ce) + + real(pReal), intent(in) :: T, dot_T + integer, intent(in) :: ce, co + + + current(material_phaseAt2(co,ce))%T(material_phaseMemberAt2(co,ce)) = T + current(material_phaseAt2(co,ce))%dot_T(material_phaseMemberAt2(co,ce)) = dot_T + +end subroutine phase_thermal_setField + + + +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a source mechanism is active or not +!-------------------------------------------------------------------------------------------------- +function thermal_active(source_label,src_length) result(active_source) + + character(len=*), intent(in) :: source_label !< name of source mechanism + integer, intent(in) :: src_length !< max. number of sources in system + logical, dimension(:,:), allocatable :: active_source + + class(tNode), pointer :: & + phases, & + phase, & + sources, thermal, & + src + integer :: p,s + + phases => config_material%get('phase') + allocate(active_source(src_length,phases%length), source = .false. ) + do p = 1, phases%length + phase => phases%get(p) + thermal => phase%get('thermal',defaultVal=emptyDict) + sources => thermal%get('source',defaultVal=emptyList) + do s = 1, sources%length + src => sources%get(s) + active_source(s,p) = src%get_asString('type') == source_label + enddo + enddo + + +end function thermal_active + + +end submodule thermal diff --git a/src/phase_thermal_dissipation.f90 b/src/phase_thermal_dissipation.f90 new file mode 100644 index 000000000..d3e7094a1 --- /dev/null +++ b/src/phase_thermal_dissipation.f90 @@ -0,0 +1,85 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for thermal source due to plastic dissipation +!> @details to be done +!-------------------------------------------------------------------------------------------------- +submodule(phase:thermal) dissipation + + type :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + kappa !< TAYLOR-QUINNEY factor + end type tParameters + + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) + + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +module function dissipation_init(source_length) result(mySources) + + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + + class(tNode), pointer :: & + phases, & + phase, & + sources, thermal, & + src + integer :: so,Nmembers,ph + + + mySources = thermal_active('dissipation',source_length) + if(count(mySources) == 0) return + print'(/,a)', ' <<<+- phase:thermal:dissipation init -+>>>' + print'(a,i2)', ' # phases: ',count(mySources); flush(IO_STDOUT) + + + phases => config_material%get('phase') + allocate(param(phases%length)) + + do ph = 1, phases%length + phase => phases%get(ph) + if(count(mySources(:,ph)) == 0) cycle !ToDo: error if > 1 + thermal => phase%get('thermal') + sources => thermal%get('source') + do so = 1, sources%length + if(mySources(so,ph)) then + associate(prm => param(ph)) + src => sources%get(so) + + prm%kappa = src%get_asFloat('kappa') + Nmembers = count(material_phaseAt2 == ph) + call phase_allocateState(thermalState(ph)%p(so),Nmembers,0,0,0) + + end associate + endif + enddo + enddo + + +end function dissipation_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief Ninstancess dissipation rate +!-------------------------------------------------------------------------------------------------- +module subroutine dissipation_getRate(TDot, ph,me) + + integer, intent(in) :: ph, me + real(pReal), intent(out) :: & + TDot + + + associate(prm => param(ph)) + TDot = prm%kappa*sum(abs(mechanical_S(ph,me)*mechanical_L_p(ph,me))) + end associate + +end subroutine dissipation_getRate + +end submodule dissipation diff --git a/src/phase_thermal_externalheat.f90 b/src/phase_thermal_externalheat.f90 new file mode 100644 index 000000000..257b4e282 --- /dev/null +++ b/src/phase_thermal_externalheat.f90 @@ -0,0 +1,133 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Michigan State University +!> @brief material subroutine for variable heat source +!-------------------------------------------------------------------------------------------------- +submodule(phase:thermal) externalheat + + + integer, dimension(:), allocatable :: & + source_thermal_externalheat_offset !< which source is my current thermal dissipation mechanism? + + type :: tParameters !< container type for internal constitutive parameters + real(pReal), dimension(:), allocatable :: & + t_n, & + f_T + integer :: & + nIntervals + end type tParameters + + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) + + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +module function externalheat_init(source_length) result(mySources) + + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + + class(tNode), pointer :: & + phases, & + phase, & + sources, thermal, & + src + integer :: so,Nmembers,ph + + + mySources = thermal_active('externalheat',source_length) + if(count(mySources) == 0) return + print'(/,a)', ' <<<+- phase:thermal:externalheat init -+>>>' + print'(a,i2)', ' # phases: ',count(mySources); flush(IO_STDOUT) + + + phases => config_material%get('phase') + allocate(param(phases%length)) + allocate(source_thermal_externalheat_offset (phases%length), source=0) + + do ph = 1, phases%length + phase => phases%get(ph) + if(count(mySources(:,ph)) == 0) cycle + thermal => phase%get('thermal') + sources => thermal%get('source') + do so = 1, sources%length + if(mySources(so,ph)) then + source_thermal_externalheat_offset(ph) = so + associate(prm => param(ph)) + src => sources%get(so) + + prm%t_n = src%get_asFloats('t_n') + prm%nIntervals = size(prm%t_n) - 1 + + prm%f_T = src%get_asFloats('f_T',requiredSize = size(prm%t_n)) + + Nmembers = count(material_phaseAt2 == ph) + call phase_allocateState(thermalState(ph)%p(so),Nmembers,1,1,0) + end associate + endif + enddo + enddo + +end function externalheat_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief rate of change of state +!> @details state only contains current time to linearly interpolate given heat powers +!-------------------------------------------------------------------------------------------------- +module subroutine externalheat_dotState(ph, me) + + integer, intent(in) :: & + ph, & + me + + integer :: & + so + + so = source_thermal_externalheat_offset(ph) + + thermalState(ph)%p(so)%dotState(1,me) = 1.0_pReal ! state is current time + +end subroutine externalheat_dotState + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns local heat generation rate +!-------------------------------------------------------------------------------------------------- +module subroutine externalheat_getRate(TDot, ph, me) + + integer, intent(in) :: & + ph, & + me + real(pReal), intent(out) :: & + TDot + + integer :: & + so, interval + real(pReal) :: & + frac_time + + so = source_thermal_externalheat_offset(ph) + + associate(prm => param(ph)) + do interval = 1, prm%nIntervals ! scan through all rate segments + frac_time = (thermalState(ph)%p(so)%state(1,me) - prm%t_n(interval)) & + / (prm%t_n(interval+1) - prm%t_n(interval)) ! fractional time within segment + if ( (frac_time < 0.0_pReal .and. interval == 1) & + .or. (frac_time >= 1.0_pReal .and. interval == prm%nIntervals) & + .or. (frac_time >= 0.0_pReal .and. frac_time < 1.0_pReal) ) & + TDot = prm%f_T(interval ) * (1.0_pReal - frac_time) + & + prm%f_T(interval+1) * frac_time ! interpolate heat rate between segment boundaries... + ! ...or extrapolate if outside me bounds + enddo + end associate + +end subroutine externalheat_getRate + +end submodule externalheat diff --git a/src/prec.f90 b/src/prec.f90 index 4d73462c4..1a96c75a9 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -32,13 +32,13 @@ module prec real(pReal), dimension(:), pointer :: p end type group_float - ! http://stackoverflow.com/questions/3948210/can-i-have-a-pointer-to-an-item-in-an-allocatable-array type :: tState integer :: & sizeState = 0, & !< size of state sizeDotState = 0, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates offsetDeltaState = 0, & !< index offset of delta state sizeDeltaState = 0 !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments + ! http://stackoverflow.com/questions/3948210 real(pReal), pointer, dimension(:), contiguous :: & atol real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/doState. However, they will never point to something, but are rather allocated and, hence, contiguous @@ -47,7 +47,6 @@ module prec dotState, & !< rate of state change deltaState !< increment of state change real(pReal), allocatable, dimension(:,:) :: & - partitionedState0, & subState0 end type diff --git a/src/results.f90 b/src/results.f90 index 6363e3efc..c9c51b9a2 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -65,7 +65,7 @@ subroutine results_init(restart) print*, 'https://doi.org/10.1007/s40192-017-0084-5'//IO_EOL if(.not. restart) then - resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','w',.true.) + resultsFile = HDF5_openFile(getSolverJobName()//'.hdf5','w') call results_addAttribute('DADF5_version_major',0) call results_addAttribute('DADF5_version_minor',11) call results_addAttribute('DAMASK_version',DAMASKVERSION) @@ -83,7 +83,7 @@ end subroutine results_init !-------------------------------------------------------------------------------------------------- subroutine results_openJobFile - resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','a',.true.) + resultsFile = HDF5_openFile(getSolverJobName()//'.hdf5','a') end subroutine results_openJobFile @@ -283,17 +283,13 @@ subroutine results_writeScalarDataset_real(group,dataset,label,description,SIuni character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit - real(pReal), intent(inout), dimension(:) :: dataset + real(pReal), intent(in), dimension(:) :: dataset integer(HID_T) :: groupHandle groupHandle = results_openGroup(group) -#ifdef PETSc - call HDF5_write(groupHandle,dataset,label,.true.) -#else - call HDF5_write(groupHandle,dataset,label,.false.) -#endif + call HDF5_write(groupHandle,dataset,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Description',description,label) @@ -314,17 +310,13 @@ subroutine results_writeVectorDataset_real(group,dataset,label,description,SIuni character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit - real(pReal), intent(inout), dimension(:,:) :: dataset + real(pReal), intent(in), dimension(:,:) :: dataset integer(HID_T) :: groupHandle groupHandle = results_openGroup(group) -#ifdef PETSc - call HDF5_write(groupHandle,dataset,label,.true.) -#else - call HDF5_write(groupHandle,dataset,label,.false.) -#endif + call HDF5_write(groupHandle,dataset,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Description',description,label) @@ -362,7 +354,7 @@ subroutine results_writeTensorDataset_real(group,dataset,label,description,SIuni endif if(transposed_) then - if(size(dataset,1) /= size(dataset,2)) call IO_error(0,ext_msg='transpose non-symmetric tensor') + if(size(dataset,1) /= size(dataset,2)) error stop 'transpose non-symmetric tensor' allocate(dataset_transposed,mold=dataset) do i=1,size(dataset_transposed,3) dataset_transposed(:,:,i) = transpose(dataset(:,:,i)) @@ -373,11 +365,7 @@ subroutine results_writeTensorDataset_real(group,dataset,label,description,SIuni groupHandle = results_openGroup(group) -#ifdef PETSc - call HDF5_write(groupHandle,dataset_transposed,label,.true.) -#else - call HDF5_write(groupHandle,dataset_transposed,label,.false.) -#endif + call HDF5_write(groupHandle,dataset_transposed,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Description',description,label) @@ -397,19 +385,15 @@ end subroutine results_writeTensorDataset_real !-------------------------------------------------------------------------------------------------- subroutine results_writeVectorDataset_int(group,dataset,label,description,SIunit) - character(len=*), intent(in) :: label,group,description - character(len=*), intent(in), optional :: SIunit - integer, intent(inout), dimension(:,:) :: dataset + character(len=*), intent(in) :: label,group,description + character(len=*), intent(in), optional :: SIunit + integer, intent(in), dimension(:,:) :: dataset integer(HID_T) :: groupHandle groupHandle = results_openGroup(group) -#ifdef PETSc - call HDF5_write(groupHandle,dataset,label,.true.) -#else - call HDF5_write(groupHandle,dataset,label,.false.) -#endif + call HDF5_write(groupHandle,dataset,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Description',description,label) @@ -429,19 +413,15 @@ end subroutine results_writeVectorDataset_int !-------------------------------------------------------------------------------------------------- subroutine results_writeTensorDataset_int(group,dataset,label,description,SIunit) - character(len=*), intent(in) :: label,group,description - character(len=*), intent(in), optional :: SIunit - integer, intent(inout), dimension(:,:,:) :: dataset + character(len=*), intent(in) :: label,group,description + character(len=*), intent(in), optional :: SIunit + integer, intent(in), dimension(:,:,:) :: dataset integer(HID_T) :: groupHandle groupHandle = results_openGroup(group) -#ifdef PETSc - call HDF5_write(groupHandle,dataset,label,.true.) -#else - call HDF5_write(groupHandle,dataset,label,.false.) -#endif + call HDF5_write(groupHandle,dataset,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Description',description,label) @@ -577,7 +557,7 @@ subroutine results_mapping_phase(phaseAt,memberAtLocal,label) !-------------------------------------------------------------------------------------------------- ! write the components of the compound type individually - call h5pset_preserve_f(plist_id, .TRUE., hdferr) + call h5pset_preserve_f(plist_id, .true., hdferr) if(hdferr < 0) error stop 'HDF5 error' loc_id = results_openGroup('/mapping') @@ -733,7 +713,8 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label) !-------------------------------------------------------------------------------------------------- ! write the components of the compound type individually - call h5pset_preserve_f(plist_id, .TRUE., hdferr) + call h5pset_preserve_f(plist_id, .true., hdferr) + if(hdferr < 0) error stop 'HDF5 error' loc_id = results_openGroup('/mapping') call h5dcreate_f(loc_id, 'homogenization', dtype_id, filespace_id, dset_id, hdferr) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 deleted file mode 100644 index 0f923ceba..000000000 --- a/src/source_damage_anisoBrittle.f90 +++ /dev/null @@ -1,218 +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 anisotropic brittle damage source mechanism -!> @details to be done -!-------------------------------------------------------------------------------------------------- -submodule (constitutive:constitutive_damage) source_damage_anisoBrittle - - integer, dimension(:), allocatable :: & - source_damage_anisoBrittle_offset, & !< which source is my current source mechanism? - source_damage_anisoBrittle_instance !< instance of source mechanism - - type :: tParameters !< container type for internal constitutive parameters - real(pReal) :: & - dot_o, & !< opening rate of cleavage planes - q !< damage rate sensitivity - real(pReal), dimension(:), allocatable :: & - s_crit, & !< critical displacement - g_crit !< critical load - real(pReal), dimension(:,:,:,:), allocatable :: & - cleavage_systems - integer :: & - sum_N_cl !< total number of cleavage planes - character(len=pStringLen), allocatable, dimension(:) :: & - output - end type tParameters - - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) - - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -module function source_damage_anisoBrittle_init(source_length) result(mySources) - - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - - class(tNode), pointer :: & - phases, & - phase, & - sources, & - src - integer :: Ninstances,sourceOffset,Nconstituents,p - integer, dimension(:), allocatable :: N_cl - character(len=pStringLen) :: extmsg = '' - - print'(/,a)', ' <<<+- source_damage_anisoBrittle init -+>>>' - - mySources = source_active('damage_anisoBrittle',source_length) - Ninstances = count(mySources) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return - - phases => config_material%get('phase') - allocate(param(Ninstances)) - allocate(source_damage_anisoBrittle_offset (phases%length), source=0) - allocate(source_damage_anisoBrittle_instance(phases%length), source=0) - - do p = 1, phases%length - phase => phases%get(p) - if(any(mySources(:,p))) source_damage_anisoBrittle_instance(p) = count(mySources(:,1:p)) - if(count(mySources(:,p)) == 0) cycle - sources => phase%get('source') - do sourceOffset = 1, sources%length - if(mySources(sourceOffset,p)) then - source_damage_anisoBrittle_offset(p) = sourceOffset - associate(prm => param(source_damage_anisoBrittle_instance(p))) - src => sources%get(sourceOffset) - - N_cl = src%get_asInts('N_cl',defaultVal=emptyIntArray) - prm%sum_N_cl = sum(abs(N_cl)) - - prm%q = src%get_asFloat('q') - prm%dot_o = src%get_asFloat('dot_o') - - prm%s_crit = src%get_asFloats('s_crit', requiredSize=size(N_cl)) - prm%g_crit = src%get_asFloats('g_crit', requiredSize=size(N_cl)) - - prm%cleavage_systems = lattice_SchmidMatrix_cleavage(N_cl,phase%get_asString('lattice'),& - phase%get_asFloat('c/a',defaultVal=0.0_pReal)) - - ! expand: family => system - prm%s_crit = math_expand(prm%s_crit,N_cl) - prm%g_crit = math_expand(prm%g_crit,N_cl) - -#if defined (__GFORTRAN__) - prm%output = output_asStrings(src) -#else - prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) -#endif - - ! sanity checks - if (prm%q <= 0.0_pReal) extmsg = trim(extmsg)//' q' - if (prm%dot_o <= 0.0_pReal) extmsg = trim(extmsg)//' dot_o' - if (any(prm%g_crit < 0.0_pReal)) extmsg = trim(extmsg)//' g_crit' - if (any(prm%s_crit < 0.0_pReal)) extmsg = trim(extmsg)//' s_crit' - - Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol' - - end associate - -!-------------------------------------------------------------------------------------------------- -! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_anisoBrittle)') - endif - enddo - enddo - -end function source_damage_anisoBrittle_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates derived quantities from state -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_anisoBrittle_dotState(S, co, ip, el) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S - - integer :: & - phase, & - constituent, & - sourceOffset, & - damageOffset, & - homog, & - i - real(pReal) :: & - traction_d, traction_t, traction_n, traction_crit - - phase = material_phaseAt(co,el) - constituent = material_phasememberAt(co,ip,el) - sourceOffset = source_damage_anisoBrittle_offset(phase) - homog = material_homogenizationAt(el) - damageOffset = material_homogenizationMemberAt(ip,el) - - associate(prm => param(source_damage_anisoBrittle_instance(phase))) - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal - do i = 1, prm%sum_N_cl - traction_d = math_tensordot(S,prm%cleavage_systems(1:3,1:3,1,i)) - traction_t = math_tensordot(S,prm%cleavage_systems(1:3,1:3,2,i)) - traction_n = math_tensordot(S,prm%cleavage_systems(1:3,1:3,3,i)) - - traction_crit = prm%g_crit(i)*damage(homog)%p(damageOffset)**2.0_pReal - - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) & - = sourceState(phase)%p(sourceOffset)%dotState(1,constituent) & - + prm%dot_o / prm%s_crit(i) & - * ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**prm%q + & - (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**prm%q + & - (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**prm%q) - enddo - end associate - -end subroutine source_damage_anisoBrittle_dotState - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns local part of nonlocal damage driving force -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - - integer, intent(in) :: & - phase, & - constituent - real(pReal), intent(in) :: & - phi - real(pReal), intent(out) :: & - localphiDot, & - dLocalphiDot_dPhi - - integer :: & - sourceOffset - - sourceOffset = source_damage_anisoBrittle_offset(phase) - - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) - - localphiDot = 1.0_pReal & - + dLocalphiDot_dPhi*phi - -end subroutine source_damage_anisoBrittle_getRateAndItsTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief writes results to HDF5 output file -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_anisoBrittle_results(phase,group) - - integer, intent(in) :: phase - character(len=*), intent(in) :: group - - integer :: o - - associate(prm => param(source_damage_anisoBrittle_instance(phase)), & - stt => sourceState(phase)%p(source_damage_anisoBrittle_offset(phase))%state) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case ('f_phi') - call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') - end select - enddo outputsLoop - end associate - -end subroutine source_damage_anisoBrittle_results - -end submodule source_damage_anisoBrittle diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 deleted file mode 100644 index 6f71fc145..000000000 --- a/src/source_damage_anisoDuctile.f90 +++ /dev/null @@ -1,187 +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 anisotropic ductile damage source mechanism -!> @details to be done -!-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_damage) source_damage_anisoDuctile - - integer, dimension(:), allocatable :: & - source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism? - source_damage_anisoDuctile_instance !< instance of damage source mechanism - - type :: tParameters !< container type for internal constitutive parameters - real(pReal) :: & - q !< damage rate sensitivity - real(pReal), dimension(:), allocatable :: & - gamma_crit !< critical plastic strain per slip system - character(len=pStringLen), allocatable, dimension(:) :: & - output - end type tParameters - - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -module function source_damage_anisoDuctile_init(source_length) result(mySources) - - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - - class(tNode), pointer :: & - phases, & - phase, & - mech, & - pl, & - sources, & - src - integer :: Ninstances,sourceOffset,Nconstituents,p - integer, dimension(:), allocatable :: N_sl - character(len=pStringLen) :: extmsg = '' - - print'(/,a)', ' <<<+- source_damage_anisoDuctile init -+>>>' - - mySources = source_active('damage_anisoDuctile',source_length) - Ninstances = count(mySources) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return - - phases => config_material%get('phase') - allocate(param(Ninstances)) - allocate(source_damage_anisoDuctile_offset (phases%length), source=0) - allocate(source_damage_anisoDuctile_instance(phases%length), source=0) - - do p = 1, phases%length - phase => phases%get(p) - if(any(mySources(:,p))) source_damage_anisoDuctile_instance(p) = count(mySources(:,1:p)) - if(count(mySources(:,p)) == 0) cycle - mech => phase%get('mechanics') - pl => mech%get('plasticity') - sources => phase%get('source') - do sourceOffset = 1, sources%length - if(mySources(sourceOffset,p)) then - source_damage_anisoDuctile_offset(p) = sourceOffset - associate(prm => param(source_damage_anisoDuctile_instance(p))) - src => sources%get(sourceOffset) - - N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) - prm%q = src%get_asFloat('q') - prm%gamma_crit = src%get_asFloats('gamma_crit',requiredSize=size(N_sl)) - - ! expand: family => system - prm%gamma_crit = math_expand(prm%gamma_crit,N_sl) - -#if defined (__GFORTRAN__) - prm%output = output_asStrings(src) -#else - prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) -#endif - - ! sanity checks - if (prm%q <= 0.0_pReal) extmsg = trim(extmsg)//' q' - if (any(prm%gamma_crit < 0.0_pReal)) extmsg = trim(extmsg)//' gamma_crit' - - Nconstituents=count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol' - - end associate - -!-------------------------------------------------------------------------------------------------- -! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_anisoDuctile)') - endif - enddo - enddo - - -end function source_damage_anisoDuctile_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates derived quantities from state -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_anisoDuctile_dotState(co, ip, el) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - - integer :: & - phase, & - constituent, & - sourceOffset, & - damageOffset, & - homog - - phase = material_phaseAt(co,el) - constituent = material_phasememberAt(co,ip,el) - sourceOffset = source_damage_anisoDuctile_offset(phase) - homog = material_homogenizationAt(el) - damageOffset = material_homogenizationMemberAt(ip,el) - - associate(prm => param(source_damage_anisoDuctile_instance(phase))) - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) & - = sum(plasticState(phase)%slipRate(:,constituent)/(damage(homog)%p(damageOffset)**prm%q)/prm%gamma_crit) - end associate - -end subroutine source_damage_anisoDuctile_dotState - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns local part of nonlocal damage driving force -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - - integer, intent(in) :: & - phase, & - constituent - real(pReal), intent(in) :: & - phi - real(pReal), intent(out) :: & - localphiDot, & - dLocalphiDot_dPhi - - integer :: & - sourceOffset - - sourceOffset = source_damage_anisoDuctile_offset(phase) - - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) - - localphiDot = 1.0_pReal & - + dLocalphiDot_dPhi*phi - -end subroutine source_damage_anisoDuctile_getRateAndItsTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief writes results to HDF5 output file -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_anisoDuctile_results(phase,group) - - integer, intent(in) :: phase - character(len=*), intent(in) :: group - - integer :: o - - associate(prm => param(source_damage_anisoDuctile_instance(phase)), & - stt => sourceState(phase)%p(source_damage_anisoDuctile_offset(phase))%state) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case ('f_phi') - call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') - end select - enddo outputsLoop - end associate - -end subroutine source_damage_anisoDuctile_results - -end submodule source_damage_anisoDuctile diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 deleted file mode 100644 index 8c768b08d..000000000 --- a/src/source_damage_isoBrittle.f90 +++ /dev/null @@ -1,190 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine incoprorating isotropic brittle damage source mechanism -!> @details to be done -!-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_damage) source_damage_isoBrittle - - integer, dimension(:), allocatable :: & - source_damage_isoBrittle_offset, & - source_damage_isoBrittle_instance - - type :: tParameters !< container type for internal constitutive parameters - real(pReal) :: & - W_crit !< critical elastic strain energy - character(len=pStringLen), allocatable, dimension(:) :: & - output - end type tParameters - - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -module function source_damage_isoBrittle_init(source_length) result(mySources) - - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - - class(tNode), pointer :: & - phases, & - phase, & - sources, & - src - integer :: Ninstances,sourceOffset,Nconstituents,p - character(len=pStringLen) :: extmsg = '' - - print'(/,a)', ' <<<+- source_damage_isoBrittle init -+>>>' - - mySources = source_active('damage_isoBrittle',source_length) - Ninstances = count(mySources) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return - - phases => config_material%get('phase') - allocate(param(Ninstances)) - allocate(source_damage_isoBrittle_offset (phases%length), source=0) - allocate(source_damage_isoBrittle_instance(phases%length), source=0) - - do p = 1, phases%length - phase => phases%get(p) - if(any(mySources(:,p))) source_damage_isoBrittle_instance(p) = count(mySources(:,1:p)) - if(count(mySources(:,p)) == 0) cycle - sources => phase%get('source') - do sourceOffset = 1, sources%length - if(mySources(sourceOffset,p)) then - source_damage_isoBrittle_offset(p) = sourceOffset - associate(prm => param(source_damage_isoBrittle_instance(p))) - src => sources%get(sourceOffset) - - prm%W_crit = src%get_asFloat('W_crit') - -#if defined (__GFORTRAN__) - prm%output = output_asStrings(src) -#else - prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) -#endif - - ! sanity checks - if (prm%W_crit <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit' - - Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,1) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol' - - end associate - -!-------------------------------------------------------------------------------------------------- -! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_isoBrittle)') - endif - enddo - enddo - - -end function source_damage_isoBrittle_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates derived quantities from state -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_isoBrittle_deltaState(C, Fe, co, ip, el) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - Fe - real(pReal), intent(in), dimension(6,6) :: & - C - - integer :: & - phase, & - constituent, & - sourceOffset - real(pReal), dimension(6) :: & - strain - real(pReal) :: & - strainenergy - - phase = material_phaseAt(co,el) !< phase ID at co,ip,el - constituent = material_phasememberAt(co,ip,el) !< state array offset for phase ID at co,ip,el - sourceOffset = source_damage_isoBrittle_offset(phase) - - strain = 0.5_pReal*math_sym33to6(matmul(transpose(Fe),Fe)-math_I3) - - associate(prm => param(source_damage_isoBrittle_instance(phase))) - strainenergy = 2.0_pReal*sum(strain*matmul(C,strain))/prm%W_crit - ! ToDo: check strainenergy = 2.0_pReal*dot_product(strain,matmul(C,strain))/prm%W_crit - - if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then - sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & - strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent) - else - sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & - sourceState(phase)%p(sourceOffset)%subState0(1,constituent) - & - sourceState(phase)%p(sourceOffset)%state(1,constituent) - endif - end associate - -end subroutine source_damage_isoBrittle_deltaState - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns local part of nonlocal damage driving force -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - - integer, intent(in) :: & - phase, & - constituent - real(pReal), intent(in) :: & - phi - real(pReal), intent(out) :: & - localphiDot, & - dLocalphiDot_dPhi - - integer :: & - sourceOffset - - sourceOffset = source_damage_isoBrittle_offset(phase) - - associate(prm => param(source_damage_isoBrittle_instance(phase))) - localphiDot = 1.0_pReal & - - phi*sourceState(phase)%p(sourceOffset)%state(1,constituent) - dLocalphiDot_dPhi = - sourceState(phase)%p(sourceOffset)%state(1,constituent) - end associate - -end subroutine source_damage_isoBrittle_getRateAndItsTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief writes results to HDF5 output file -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_isoBrittle_results(phase,group) - - integer, intent(in) :: phase - character(len=*), intent(in) :: group - - integer :: o - - associate(prm => param(source_damage_isoBrittle_instance(phase)), & - stt => sourceState(phase)%p(source_damage_isoBrittle_offset(phase))%state) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case ('f_phi') - call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') - end select - enddo outputsLoop - end associate - -end subroutine source_damage_isoBrittle_results - -end submodule source_damage_isoBrittle diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 deleted file mode 100644 index 86222bbf9..000000000 --- a/src/source_damage_isoDuctile.f90 +++ /dev/null @@ -1,178 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Luv Sharma, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine incorporating isotropic ductile damage source mechanism -!> @details to be done -!-------------------------------------------------------------------------------------------------- -submodule (constitutive:constitutive_damage) source_damage_isoDuctile - - integer, dimension(:), allocatable :: & - source_damage_isoDuctile_offset, & !< which source is my current damage mechanism? - source_damage_isoDuctile_instance !< instance of damage source mechanism - - type:: tParameters !< container type for internal constitutive parameters - real(pReal) :: & - gamma_crit, & !< critical plastic strain - q - character(len=pStringLen), allocatable, dimension(:) :: & - output - end type tParameters - - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) - - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -module function source_damage_isoDuctile_init(source_length) result(mySources) - - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - - class(tNode), pointer :: & - phases, & - phase, & - sources, & - src - integer :: Ninstances,sourceOffset,Nconstituents,p - character(len=pStringLen) :: extmsg = '' - - print'(/,a)', ' <<<+- source_damage_isoDuctile init -+>>>' - - mySources = source_active('damage_isoDuctile',source_length) - Ninstances = count(mySources) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return - - phases => config_material%get('phase') - allocate(param(Ninstances)) - allocate(source_damage_isoDuctile_offset (phases%length), source=0) - allocate(source_damage_isoDuctile_instance(phases%length), source=0) - - do p = 1, phases%length - phase => phases%get(p) - if(count(mySources(:,p)) == 0) cycle - if(any(mySources(:,p))) source_damage_isoDuctile_instance(p) = count(mySources(:,1:p)) - sources => phase%get('source') - do sourceOffset = 1, sources%length - if(mySources(sourceOffset,p)) then - source_damage_isoDuctile_offset(p) = sourceOffset - associate(prm => param(source_damage_isoDuctile_instance(p))) - src => sources%get(sourceOffset) - - prm%q = src%get_asFloat('q') - prm%gamma_crit = src%get_asFloat('gamma_crit') - -#if defined (__GFORTRAN__) - prm%output = output_asStrings(src) -#else - prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) -#endif - - ! sanity checks - if (prm%q <= 0.0_pReal) extmsg = trim(extmsg)//' q' - if (prm%gamma_crit <= 0.0_pReal) extmsg = trim(extmsg)//' gamma_crit' - - Nconstituents=count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol' - - end associate - -!-------------------------------------------------------------------------------------------------- -! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_isoDuctile)') - endif - enddo - enddo - - -end function source_damage_isoDuctile_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates derived quantities from state -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_isoDuctile_dotState(co, ip, el) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - - integer :: & - phase, & - constituent, & - sourceOffset, & - damageOffset, & - homog - - phase = material_phaseAt(co,el) - constituent = material_phasememberAt(co,ip,el) - sourceOffset = source_damage_isoDuctile_offset(phase) - homog = material_homogenizationAt(el) - damageOffset = material_homogenizationMemberAt(ip,el) - - associate(prm => param(source_damage_isoDuctile_instance(phase))) - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & - sum(plasticState(phase)%slipRate(:,constituent))/(damage(homog)%p(damageOffset)**prm%q)/prm%gamma_crit - end associate - -end subroutine source_damage_isoDuctile_dotState - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns local part of nonlocal damage driving force -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - - integer, intent(in) :: & - phase, & - constituent - real(pReal), intent(in) :: & - phi - real(pReal), intent(out) :: & - localphiDot, & - dLocalphiDot_dPhi - - integer :: & - sourceOffset - - sourceOffset = source_damage_isoDuctile_offset(phase) - - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) - - localphiDot = 1.0_pReal & - + dLocalphiDot_dPhi*phi - -end subroutine source_damage_isoDuctile_getRateAndItsTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief writes results to HDF5 output file -!-------------------------------------------------------------------------------------------------- -module subroutine source_damage_isoDuctile_results(phase,group) - - integer, intent(in) :: phase - character(len=*), intent(in) :: group - - integer :: o - - associate(prm => param(source_damage_isoDuctile_instance(phase)), & - stt => sourceState(phase)%p(source_damage_isoDuctile_offset(phase))%state) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case ('f_phi') - call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') - end select - enddo outputsLoop - end associate - -end subroutine source_damage_isoDuctile_results - -end submodule source_damage_isoDuctile diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 deleted file mode 100644 index f28567aa7..000000000 --- a/src/source_thermal_dissipation.f90 +++ /dev/null @@ -1,99 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for thermal source due to plastic dissipation -!> @details to be done -!-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_thermal) source_thermal_dissipation - - integer, dimension(:), allocatable :: & - source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism? - source_thermal_dissipation_instance !< instance of thermal dissipation source mechanism - - type :: tParameters !< container type for internal constitutive parameters - real(pReal) :: & - kappa !< TAYLOR-QUINNEY factor - end type tParameters - - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) - - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -module function source_thermal_dissipation_init(source_length) result(mySources) - - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - - class(tNode), pointer :: & - phases, & - phase, & - sources, & - src - integer :: Ninstances,sourceOffset,Nconstituents,p - - print'(/,a)', ' <<<+- source_thermal_dissipation init -+>>>' - - mySources = source_active('thermal_dissipation',source_length) - Ninstances = count(mySources) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return - - phases => config_material%get('phase') - allocate(param(Ninstances)) - allocate(source_thermal_dissipation_offset (phases%length), source=0) - allocate(source_thermal_dissipation_instance(phases%length), source=0) - - do p = 1, phases%length - phase => phases%get(p) - if(count(mySources(:,p)) == 0) cycle - if(any(mySources(:,p))) source_thermal_dissipation_instance(p) = count(mySources(:,1:p)) - sources => phase%get('source') - do sourceOffset = 1, sources%length - if(mySources(sourceOffset,p)) then - source_thermal_dissipation_offset(p) = sourceOffset - associate(prm => param(source_thermal_dissipation_instance(p))) - - src => sources%get(sourceOffset) - prm%kappa = src%get_asFloat('kappa') - Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,0,0,0) - - end associate - endif - enddo - enddo - - -end function source_thermal_dissipation_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief Ninstancess dissipation rate -!-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT, Tstar, Lp, phase) - - integer, intent(in) :: & - phase - real(pReal), intent(in), dimension(3,3) :: & - Tstar - real(pReal), intent(in), dimension(3,3) :: & - Lp - - real(pReal), intent(out) :: & - TDot, & - dTDot_dT - - associate(prm => param(source_thermal_dissipation_instance(phase))) - TDot = prm%kappa*sum(abs(Tstar*Lp)) - dTDot_dT = 0.0_pReal - end associate - -end subroutine source_thermal_dissipation_getRateAndItsTangent - -end submodule source_thermal_dissipation diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 deleted file mode 100644 index 9ba4a051b..000000000 --- a/src/source_thermal_externalheat.f90 +++ /dev/null @@ -1,138 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Michigan State University -!> @brief material subroutine for variable heat source -!-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_thermal) source_thermal_externalheat - - - integer, dimension(:), allocatable :: & - source_thermal_externalheat_offset, & !< which source is my current thermal dissipation mechanism? - source_thermal_externalheat_instance !< instance of thermal dissipation source mechanism - - type :: tParameters !< container type for internal constitutive parameters - real(pReal), dimension(:), allocatable :: & - t_n, & - f_T - integer :: & - nIntervals - end type tParameters - - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) - - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -module function source_thermal_externalheat_init(source_length) result(mySources) - - integer, intent(in) :: source_length - logical, dimension(:,:), allocatable :: mySources - - class(tNode), pointer :: & - phases, & - phase, & - sources, & - src - integer :: Ninstances,sourceOffset,Nconstituents,p - - print'(/,a)', ' <<<+- source_thermal_externalHeat init -+>>>' - - mySources = source_active('thermal_externalheat',source_length) - Ninstances = count(mySources) - print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) - if(Ninstances == 0) return - - phases => config_material%get('phase') - allocate(param(Ninstances)) - allocate(source_thermal_externalheat_offset (phases%length), source=0) - allocate(source_thermal_externalheat_instance(phases%length), source=0) - - do p = 1, phases%length - phase => phases%get(p) - if(any(mySources(:,p))) source_thermal_externalheat_instance(p) = count(mySources(:,1:p)) - if(count(mySources(:,p)) == 0) cycle - sources => phase%get('source') - do sourceOffset = 1, sources%length - if(mySources(sourceOffset,p)) then - source_thermal_externalheat_offset(p) = sourceOffset - associate(prm => param(source_thermal_externalheat_instance(p))) - src => sources%get(sourceOffset) - - prm%t_n = src%get_asFloats('t_n') - prm%nIntervals = size(prm%t_n) - 1 - - prm%f_T = src%get_asFloats('f_T',requiredSize = size(prm%t_n)) - - Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) - end associate - - endif - enddo - enddo - -end function source_thermal_externalheat_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief rate of change of state -!> @details state only contains current time to linearly interpolate given heat powers -!-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_externalheat_dotState(phase, of) - - integer, intent(in) :: & - phase, & - of - - integer :: & - sourceOffset - - sourceOffset = source_thermal_externalheat_offset(phase) - - sourceState(phase)%p(sourceOffset)%dotState(1,of) = 1.0_pReal ! state is current time - -end subroutine source_thermal_externalheat_dotState - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns local heat generation rate -!-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of) - - integer, intent(in) :: & - phase, & - of - real(pReal), intent(out) :: & - TDot, & - dTDot_dT - - integer :: & - sourceOffset, interval - real(pReal) :: & - frac_time - - sourceOffset = source_thermal_externalheat_offset(phase) - - associate(prm => param(source_thermal_externalheat_instance(phase))) - do interval = 1, prm%nIntervals ! scan through all rate segments - frac_time = (sourceState(phase)%p(sourceOffset)%state(1,of) - prm%t_n(interval)) & - / (prm%t_n(interval+1) - prm%t_n(interval)) ! fractional time within segment - if ( (frac_time < 0.0_pReal .and. interval == 1) & - .or. (frac_time >= 1.0_pReal .and. interval == prm%nIntervals) & - .or. (frac_time >= 0.0_pReal .and. frac_time < 1.0_pReal) ) & - TDot = prm%f_T(interval ) * (1.0_pReal - frac_time) + & - prm%f_T(interval+1) * frac_time ! interpolate heat rate between segment boundaries... - ! ...or extrapolate if outside of bounds - enddo - dTDot_dT = 0.0 - end associate - -end subroutine source_thermal_externalheat_getRateAndItsTangent - -end submodule source_thermal_externalheat diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 deleted file mode 100644 index d30e50677..000000000 --- a/src/thermal_conduction.f90 +++ /dev/null @@ -1,229 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for temperature evolution from heat conduction -!-------------------------------------------------------------------------------------------------- -module thermal_conduction - use prec - use material - use config - use lattice - use results - use constitutive - use YAML_types - - implicit none - private - - type :: tParameters - character(len=pStringLen), allocatable, dimension(:) :: & - output - end type tParameters - - type(tparameters), dimension(:), allocatable :: & - param - - public :: & - thermal_conduction_init, & - thermal_conduction_getSourceAndItsTangent, & - thermal_conduction_getConductivity, & - thermal_conduction_getSpecificHeat, & - thermal_conduction_getMassDensity, & - thermal_conduction_putTemperatureAndItsRate, & - thermal_conduction_results - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_init - - integer :: Ninstances,Nmaterialpoints,h - class(tNode), pointer :: & - material_homogenization, & - homog, & - homogThermal - - print'(/,a)', ' <<<+- thermal_conduction init -+>>>'; flush(6) - - Ninstances = count(thermal_type == THERMAL_conduction_ID) - allocate(param(Ninstances)) - - material_homogenization => config_material%get('homogenization') - do h = 1, size(material_name_homogenization) - if (thermal_type(h) /= THERMAL_conduction_ID) cycle - homog => material_homogenization%get(h) - homogThermal => homog%get('thermal') - associate(prm => param(thermal_typeInstance(h))) - -#if defined (__GFORTRAN__) - prm%output = output_asStrings(homogThermal) -#else - prm%output = homogThermal%get_asStrings('output',defaultVal=emptyStringArray) -#endif - - Nmaterialpoints=count(material_homogenizationAt==h) - - allocate (temperature (h)%p(Nmaterialpoints), source=thermal_initialT(h)) - allocate (temperatureRate(h)%p(Nmaterialpoints), source=0.0_pReal) - - end associate - enddo - -end subroutine thermal_conduction_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief return heat generation rate -!-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - T - real(pReal), intent(out) :: & - Tdot, dTdot_dT - integer :: & - homog - - Tdot = 0.0_pReal - dTdot_dT = 0.0_pReal - - homog = material_homogenizationAt(el) - call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, crystallite_S,crystallite_Lp ,ip, el) - - Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal) - dTdot_dT = dTdot_dT/real(homogenization_Nconstituents(homog),pReal) - -end subroutine thermal_conduction_getSourceAndItsTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief return homogenized thermal conductivity in reference configuration -!-------------------------------------------------------------------------------------------------- -function thermal_conduction_getConductivity(ip,el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - thermal_conduction_getConductivity - integer :: & - grain - - - thermal_conduction_getConductivity = 0.0_pReal - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - thermal_conduction_getConductivity = thermal_conduction_getConductivity + & - crystallite_push33ToRef(grain,ip,el,lattice_K(:,:,material_phaseAt(grain,el))) - enddo - - thermal_conduction_getConductivity = thermal_conduction_getConductivity & - / real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal) - -end function thermal_conduction_getConductivity - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized specific heat capacity -!-------------------------------------------------------------------------------------------------- -function thermal_conduction_getSpecificHeat(ip,el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal) :: & - thermal_conduction_getSpecificHeat - integer :: & - grain - - thermal_conduction_getSpecificHeat = 0.0_pReal - - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat & - + lattice_c_p(material_phaseAt(grain,el)) - enddo - - thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat & - / real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal) - -end function thermal_conduction_getSpecificHeat - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized mass density -!-------------------------------------------------------------------------------------------------- -function thermal_conduction_getMassDensity(ip,el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal) :: & - thermal_conduction_getMassDensity - integer :: & - grain - - thermal_conduction_getMassDensity = 0.0_pReal - - - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - thermal_conduction_getMassDensity = thermal_conduction_getMassDensity & - + lattice_rho(material_phaseAt(grain,el)) - enddo - - thermal_conduction_getMassDensity = thermal_conduction_getMassDensity & - / real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal) - -end function thermal_conduction_getMassDensity - - -!-------------------------------------------------------------------------------------------------- -!> @brief updates thermal state with solution from heat conduction PDE -!-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - T, & - Tdot - integer :: & - homog, & - offset - - homog = material_homogenizationAt(el) - offset = material_homogenizationMemberAt(ip,el) - temperature (homog)%p(offset) = T - temperatureRate(homog)%p(offset) = Tdot - -end subroutine thermal_conduction_putTemperatureAndItsRate - - -!-------------------------------------------------------------------------------------------------- -!> @brief writes results to HDF5 output file -!-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_results(homog,group) - - integer, intent(in) :: homog - character(len=*), intent(in) :: group - - integer :: o - - associate(prm => param(damage_typeInstance(homog))) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case('T') - call results_writeDataset(group,temperature(homog)%p,'T',& - 'temperature','K') - end select - enddo outputsLoop - end associate - -end subroutine thermal_conduction_results - -end module thermal_conduction diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 deleted file mode 100644 index 2a41ada49..000000000 --- a/src/thermal_isothermal.f90 +++ /dev/null @@ -1,36 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for isothermal temperature field -!-------------------------------------------------------------------------------------------------- -module thermal_isothermal - use prec - use config - use material - - implicit none - public - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates fields, reads information from material configuration file -!-------------------------------------------------------------------------------------------------- -subroutine thermal_isothermal_init - - integer :: h,Nmaterialpoints - - print'(/,a)', ' <<<+- thermal_isothermal init -+>>>'; flush(6) - - do h = 1, size(material_name_homogenization) - if (thermal_type(h) /= THERMAL_isothermal_ID) cycle - - Nmaterialpoints = count(material_homogenizationAt == h) - - allocate(temperature (h)%p(Nmaterialpoints),source=thermal_initialT(h)) - allocate(temperatureRate(h)%p(Nmaterialpoints),source = 0.0_pReal) - - enddo - -end subroutine thermal_isothermal_init - -end module thermal_isothermal