diff --git a/.gitignore b/.gitignore index 2a118ef29..c34f2f0b7 100644 --- a/.gitignore +++ b/.gitignore @@ -1,8 +1,5 @@ *.pyc -*.mod -*.o *.hdf5 -*.exe *.bak *~ bin diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 1e1b8fe49..7b33574de 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -382,13 +382,6 @@ Phenopowerlaw_singleSlip: - master - release -TextureComponents: - stage: grid - script: TextureComponents/test.py - except: - - master - - release - ################################################################################################### Marc_compileIfort2018_1: @@ -505,7 +498,7 @@ Processing: - rm abq_addUserOutput.py marc_addUserOutput.py - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py - cd $DAMASKROOT/processing/post - - rm marc_to_vtk.py vtk2ang.py + - rm marc_to_vtk.py vtk2ang.py DAD*.py - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py except: - master diff --git a/CMakeLists.txt b/CMakeLists.txt index 0cfe47248..6c9bbea04 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -105,12 +105,13 @@ set (CMAKE_C_COMPILER "${PETSC_MPICC}") # Now start to care about DAMASK # DAMASK solver defines project to build -if (DAMASK_SOLVER STREQUAL "GRID") - project (DAMASK_grid Fortran C) +string(TOLOWER ${DAMASK_SOLVER} DAMASK_SOLVER) +if (DAMASK_SOLVER STREQUAL "grid") + project (damask-grid Fortran C) add_definitions (-DGrid) message ("Building Grid Solver\n") -elseif (DAMASK_SOLVER STREQUAL "FEM") - project (DAMASK_FEM Fortran C) +elseif (DAMASK_SOLVER STREQUAL "fem" OR DAMASK_SOLVER STREQUAL "mesh") + project (damask-mesh Fortran C) add_definitions (-DFEM) message ("Building FEM Solver\n") else () @@ -138,14 +139,14 @@ elseif (CMAKE_BUILD_TYPE STREQUAL "PERFORMANCE") endif () # $OPTIMIZATION takes precedence over $BUILD_TYPE defaults -if (OPTIMIZATION STREQUAL "") +if (OPTIMIZATION STREQUAL "" OR NOT DEFINED OPTIMIZATION) set (OPTIMIZATION "${OPTI}") else () set (OPTIMIZATION "${OPTIMIZATION}") endif () # $OPENMP takes precedence over $BUILD_TYPE defaults -if (OPENMP STREQUAL "") +if (OPENMP STREQUAL "" OR NOT DEFINED OPENMP) set (OPENMP "${PARALLEL}") else () set(OPENMP "${OPENMP}") @@ -156,22 +157,6 @@ if (CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY") set (BUILDCMD_POST "${BUILDCMD_POST} -fsyntax-only") endif () -# Parse DAMASK_BIN from CONFIG file -file (READ "CONFIG" CONFIGFILE) -string (REGEX REPLACE ";" "\\\\;" CONFIGFILE "${CONFIGFILE}") -string (REGEX REPLACE "\n" ";" CONFIGFILE "${CONFIGFILE}") -foreach (item ${CONFIGFILE}) - string (REGEX MATCH ".+DAMASK_BIN.+" item ${item}) - if (item) - string (REGEX REPLACE "set" "" item "${item}") - string (REGEX REPLACE "=" " " item "${item}") - string (REGEX REPLACE "\\\${DAMASK_ROOT}" "${PROJECT_SOURCE_DIR}" item "${item}") - string (REPLACE "DAMASK_BIN" ";" STRING_LIST ${item}) - list (GET STRING_LIST 1 item) - string (STRIP "${item}" CMAKE_INSTALL_PREFIX) - endif () -endforeach(item ${CONFIGFILE}) - # Parse DAMASK version from VERSION file find_program (CAT_EXECUTABLE NAMES cat) execute_process (COMMAND ${CAT_EXECUTABLE} ${PROJECT_SOURCE_DIR}/VERSION @@ -184,283 +169,14 @@ add_definitions (-DDAMASKVERSION="${DAMASK_V}") add_definitions (-DPETSc) set (DAMASK_INCLUDE_FLAGS "${DAMASK_INCLUDE_FLAGS} ${PETSC_INCLUDES}") +list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake) -################################################################################################### -# Intel Compiler -################################################################################################### if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") - - if (OPENMP) - set (OPENMP_FLAGS "-qopenmp -parallel") - endif () - - if (OPTIMIZATION STREQUAL "OFF") - set (OPTIMIZATION_FLAGS "-O0 -no-ip") - elseif (OPTIMIZATION STREQUAL "DEFENSIVE") - set (OPTIMIZATION_FLAGS "-O2") - elseif (OPTIMIZATION STREQUAL "AGGRESSIVE") - set (OPTIMIZATION_FLAGS "-ipo -O3 -no-prec-div -fp-model fast=2 -xHost") - # -fast = -ipo, -O3, -no-prec-div, -static, -fp-model fast=2, and -xHost" - endif () - - # -assume std_mod_proc_name (included in -standard-semantics) causes problems if other modules - # (PETSc, HDF5) are not compiled with this option (https://software.intel.com/en-us/forums/intel-fortran-compiler-for-linux-and-mac-os-x/topic/62172) - set (STANDARD_CHECK "-stand f15 -standard-semantics -assume nostd_mod_proc_name") - set (LINKER_FLAGS "${LINKER_FLAGS} -shared-intel") - # Link against shared Intel libraries instead of static ones - -#------------------------------------------------------------------------------------------------ -# Fine tuning compilation options - set (COMPILE_FLAGS "${COMPILE_FLAGS} -fpp") - # preprocessor - - set (COMPILE_FLAGS "${COMPILE_FLAGS} -ftz") - # flush underflow to zero, automatically set if -O[1,2,3] - - set (COMPILE_FLAGS "${COMPILE_FLAGS} -diag-disable") - # disables warnings ... - set (COMPILE_FLAGS "${COMPILE_FLAGS} 5268") - # ... the text exceeds right hand column allowed on the line (we have only comments there) - - set (COMPILE_FLAGS "${COMPILE_FLAGS} -warn") - # enables warnings ... - set (COMPILE_FLAGS "${COMPILE_FLAGS} declarations") - # ... any undeclared names (alternative name: -implicitnone) - set (COMPILE_FLAGS "${COMPILE_FLAGS},general") - # ... warning messages and informational messages are issued by the compiler - set (COMPILE_FLAGS "${COMPILE_FLAGS},usage") - # ... questionable programming practices - set (COMPILE_FLAGS "${COMPILE_FLAGS},interfaces") - # ... checks the interfaces of all SUBROUTINEs called and FUNCTIONs invoked in your compilation against an external set of interface blocks - set (COMPILE_FLAGS "${COMPILE_FLAGS},ignore_loc") - # ... %LOC is stripped from an actual argument - set (COMPILE_FLAGS "${COMPILE_FLAGS},alignments") - # ... data that is not naturally aligned - set (COMPILE_FLAGS "${COMPILE_FLAGS},unused") - # ... declared variables that are never used - - # Additional options - # -warn: enables warnings, where - # truncated_source: Determines whether warnings occur when source exceeds the maximum column width in fixed-format files. - # (too many warnings because we have comments beyond character 132) - # uncalled: Determines whether warnings occur when a statement function is never called - # all: - # -name as_is: case sensitive Fortran! - -#------------------------------------------------------------------------------------------------ -# Runtime debugging - set (DEBUG_FLAGS "${DEBUG_FLAGS} -g") - # Generate symbolic debugging information in the object file - - set (DEBUG_FLAGS "${DEBUG_FLAGS} -traceback") - # Generate extra information in the object file to provide source file traceback information when a severe error occurs at run time - - set (DEBUG_FLAGS "${DEBUG_FLAGS} -gen-interfaces") - # Generate an interface block for each routine. http://software.intel.com/en-us/blogs/2012/01/05/doctor-fortran-gets-explicit-again/ - - set (DEBUG_FLAGS "${DEBUG_FLAGS} -fp-stack-check") - # Generate extra code after every function call to ensure that the floating-point (FP) stack is in the expected state - - set (DEBUG_FLAGS "${DEBUG_FLAGS} -fp-model strict") - # Trap uninitalized variables - - set (DEBUG_FLAGS "${DEBUG_FLAGS} -check" ) - # Checks at runtime ... - set (DEBUG_FLAGS "${DEBUG_FLAGS} bounds") - # ... if an array index is too small (<1) or too large! - set (DEBUG_FLAGS "${DEBUG_FLAGS},format") - # ... for the data type of an item being formatted for output. - set (DEBUG_FLAGS "${DEBUG_FLAGS},output_conversion") - # ... for the fit of data items within a designated format descriptor field. - set (DEBUG_FLAGS "${DEBUG_FLAGS},pointers") - # ... for certain disassociated or uninitialized pointers or unallocated allocatable objects. - set (DEBUG_FLAGS "${DEBUG_FLAGS},uninit") - # ... for uninitialized variables. - set (DEBUG_FLAGS "${DEBUG_FLAGS} -ftrapuv") - # ... initializes stack local variables to an unusual value to aid error detection - set (DEBUG_FLAGS "${DEBUG_FLAGS} -fpe-all=0") - # ... capture all floating-point exceptions, sets -ftz automatically - - set (DEBUG_FLAGS "${DEBUG_FLAGS} -warn") - # enables warnings ... - set (DEBUG_FLAGS "${DEBUG_FLAGS} errors") - # ... warnings are changed to errors - set (DEBUG_FLAGS "${DEBUG_FLAGS},stderrors") - # ... warnings about Fortran standard violations are changed to errors - - set (DEBUG_FLAGS "${DEBUG_FLAGS} -debug-parameters all") - # generate debug information for parameters - - # Additional options - # -heap-arrays: Should not be done for OpenMP, but set "ulimit -s unlimited" on shell. Probably it helps also to unlimit other limits - # -check: Checks at runtime, where - # arg_temp_created: will cause a lot of warnings because we create a bunch of temporary arrays (performance?) - # stack: - -#------------------------------------------------------------------------------------------------ -# precision settings - set (PRECISION_FLAGS "${PRECISION_FLAGS} -real-size 64") - # set precision for standard real to 32 | 64 | 128 (= 4 | 8 | 16 bytes, type pReal is always 8 bytes) - - -################################################################################################### -# GNU Compiler -################################################################################################### + include(Compiler-Intel) elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") - - if (OPENMP) - set (OPENMP_FLAGS "-fopenmp") - endif () - - if (OPTIMIZATION STREQUAL "OFF") - set (OPTIMIZATION_FLAGS "-O0" ) - elseif (OPTIMIZATION STREQUAL "DEFENSIVE") - set (OPTIMIZATION_FLAGS "-O2") - elseif (OPTIMIZATION STREQUAL "AGGRESSIVE") - set (OPTIMIZATION_FLAGS "-O3 -ffast-math -funroll-loops -ftree-vectorize") - endif () - - set (STANDARD_CHECK "-std=f2008ts -pedantic-errors" ) - set (LINKER_FLAGS "${LINKER_FLAGS} -Wl") - # options parsed directly to the linker - set (LINKER_FLAGS "${LINKER_FLAGS},-undefined,dynamic_lookup" ) - # ensure to link against dynamic libraries - -#------------------------------------------------------------------------------------------------ -# Fine tuning compilation options - set (COMPILE_FLAGS "${COMPILE_FLAGS} -xf95-cpp-input") - # preprocessor - - set (COMPILE_FLAGS "${COMPILE_FLAGS} -ffree-line-length-132") - # restrict line length to the standard 132 characters (lattice.f90 require more characters) - - set (COMPILE_FLAGS "${COMPILE_FLAGS} -fimplicit-none") - # assume "implicit none" even if not present in source - - set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wall") - # sets the following Fortran options: - # -Waliasing: warn about possible aliasing of dummy arguments. Specifically, it warns if the same actual argument is associated with a dummy argument with "INTENT(IN)" and a dummy argument with "INTENT(OUT)" in a call with an explicit interface. - # -Wampersand: checks if a character expression is continued proberly by an ampersand at the end of the line and at the beginning of the new line - # -Warray-bounds: checks if array reference is out of bounds at compile time. use -fcheck-bounds to also check during runtime - # -Wconversion: warn about implicit conversions between different type - # -Wsurprising: warn when "suspicious" code constructs are encountered. While technically legal these usually indicate that an error has been made. - # -Wc-binding-type: - # -Wintrinsics-std: only standard intrisics are available, e.g. "call flush(6)" will cause an error - # -Wno-tabs: do not allow tabs in source - # -Wintrinsic-shadow: warn if a user-defined procedure or module procedure has the same name as an intrinsic - # -Wline-truncation: - # -Wtarget-lifetime: - # -Wreal-q-constant: warn about real-literal-constants with 'q' exponent-letter - # -Wunused: a number of unused-xxx warnings - # and sets the general (non-Fortran options) options: - # -Waddress - # -Warray-bounds (only with -O2) - # -Wc++11-compat - # -Wchar-subscripts - # -Wcomment - # -Wformat - # -Wmaybe-uninitialized - # -Wnonnull - # -Wparentheses - # -Wpointer-sign - # -Wreorder - # -Wreturn-type - # -Wsequence-point - # -Wstrict-aliasing - # -Wstrict-overflow=1 - # -Wswitch - # -Wtrigraphs - # -Wuninitialized - # -Wunknown-pragmas - # -Wunused-function - # -Wunused-label - # -Wunused-value - # -Wunused-variable - # -Wvolatile-register-var - - set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wextra") - # sets the following Fortran options: - # -Wunuses-parameter: - # -Wcompare-reals: - # and sets the general (non-Fortran options) options: - # -Wclobbered - # -Wempty-body - # -Wignored-qualifiers - # -Wmissing-field-initializers - # -Woverride-init - # -Wsign-compare - # -Wtype-limits - # -Wuninitialized - # -Wunused-but-set-parameter (only with -Wunused or -Wall) - # -Wno-globals - - set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wcharacter-truncation") - # warn if character expressions (strings) are truncated - - set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wunderflow") - # produce a warning when numerical constant expressions are encountered, which yield an UNDERFLOW during compilation - - set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wsuggest-attribute=pure") - set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wsuggest-attribute=noreturn") - set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wconversion-extra") - set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wimplicit-procedure") - set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wno-unused-parameter") - set (COMPILE_FLAGS "${COMPILE_FLAGS} -ffpe-summary=all") - # print summary of floating point exeptions (invalid,zero,overflow,underflow,inexact,denormal) - - # Additional options - # -Warray-temporarieswarnings: because we have many temporary arrays (performance issue?): - # -Wimplicit-interface: no interfaces for lapack/MPI routines - # -Wunsafe-loop-optimizations: warn if the loop cannot be optimized due to nontrivial assumptions. - -#------------------------------------------------------------------------------------------------ -# Runtime debugging - set (DEBUG_FLAGS "${DEBUG_FLAGS} -ffpe-trap=invalid,zero,overflow") - # stop execution if floating point exception is detected (NaN is silent) - - set (DEBUG_FLAGS "${DEBUG_FLAGS} -g") - # Generate symbolic debugging information in the object file - - set (DEBUG_FLAGS "${DEBUG_FLAGS} -fbacktrace") - set (DEBUG_FLAGS "${DEBUG_FLAGS} -fdump-core") - set (DEBUG_FLAGS "${DEBUG_FLAGS} -fcheck=all") - # checks for (array-temps,bounds,do,mem,pointer,recursion) - - # Additional options - # -ffpe-trap=precision,denormal,underflow -#------------------------------------------------------------------------------------------------ -# precision settings - set (PRECISION_FLAGS "${PRECISION_FLAGS} -fdefault-real-8") - # set precision to 8 bytes for standard real (=8 for pReal). Will set size of double to 16 bytes as long as -fdefault-double-8 is not set - set (PRECISION_FLAGS "${PRECISION_FLAGS} -fdefault-double-8") - # set precision to 8 bytes for double real, would be 16 bytes if -fdefault-real-8 is used - - -################################################################################################### -# PGI Compiler -################################################################################################### + include(Compiler-GNU) elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "PGI") - - if (OPTIMIZATION STREQUAL "OFF") - set (OPTIMIZATION_FLAGS "-O0" ) - elseif (OPTIMIZATION STREQUAL "DEFENSIVE") - set (OPTIMIZATION_FLAGS "-O2") - elseif (OPTIMIZATION STREQUAL "AGGRESSIVE") - set (OPTIMIZATION_FLAGS "-O3") - endif () - - -#------------------------------------------------------------------------------------------------ -# Fine tuning compilation options - set (COMPILE_FLAGS "${COMPILE_FLAGS} -Mpreprocess") - # preprocessor - - set (STANDARD_CHECK "-Mallocatable=03") - -#------------------------------------------------------------------------------------------------ -# Runtime debugging - set (DEBUG_FLAGS "${DEBUG_FLAGS} -g") - # Includes debugging information in the object module; sets the optimization level to zero unless a -⁠O option is present on the command line + include(Compiler-PGI) else () message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized") endif () @@ -483,18 +199,3 @@ message ("Fortran Linker Command:\n${CMAKE_Fortran_LINK_EXECUTABLE}\n") # location of code add_subdirectory (src) - -# INSTALL BUILT BINARIES -if (CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY") - exec_program (mktemp OUTPUT_VARIABLE nothing) - exec_program (mktemp ARGS -d OUTPUT_VARIABLE black_hole) - install (PROGRAMS ${nothing} DESTINATION ${black_hole}) -else () - if (PROJECT_NAME STREQUAL "DAMASK_grid") - install (PROGRAMS ${PROJECT_BINARY_DIR}/src/DAMASK_spectral - DESTINATION ${CMAKE_INSTALL_PREFIX}) - elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") - install (PROGRAMS ${PROJECT_BINARY_DIR}/src/DAMASK_FEM - DESTINATION ${CMAKE_INSTALL_PREFIX}) - endif () -endif () diff --git a/CONFIG b/CONFIG index 31a9c34c8..6d5226c89 100644 --- a/CONFIG +++ b/CONFIG @@ -1,8 +1,6 @@ # "set"-syntax needed only for tcsh (but works with bash and zsh) # DAMASK_ROOT will be expanded -set DAMASK_BIN = ${DAMASK_ROOT}/bin - set DAMASK_NUM_THREADS = 4 set MSC_ROOT = /opt/msc diff --git a/Makefile b/Makefile index 53ae30c1c..b24e3d36b 100644 --- a/Makefile +++ b/Makefile @@ -2,30 +2,31 @@ SHELL = /bin/sh ######################################################################################## # Makefile for the installation of DAMASK ######################################################################################## +DAMASK_ROOT = $(shell python -c "import os,sys; print(os.path.normpath(os.path.realpath(os.path.expanduser('$(pwd)'))))") .PHONY: all -all: grid FEM processing +all: grid mesh processing .PHONY: grid grid: build/grid - @(cd build/grid;make -j4 --no-print-directory -ws all install;) - + @(cd build/grid;make -j4 all install;) .PHONY: spectral -spectral: build/grid - @(cd build/grid;make -j4 --no-print-directory -ws all install;) +spectral: grid +.PHONY: mesh +mesh: build/mesh + @(cd build/mesh; make -j4 all install;) .PHONY: FEM -FEM: build/FEM - @(cd build/FEM; make -j4 --no-print-directory -ws all install;) +FEM: mesh .PHONY: build/grid build/grid: @mkdir -p build/grid - @(cd build/grid; cmake -Wno-dev -DDAMASK_SOLVER=GRID -DCMAKE_BUILD_TYPE=${BUILD_TYPE} -DBUILDCMD_POST=${BUILDCMD_POST} -DBUILDCMD_PRE=${BUILDCMD_PRE} -DOPTIMIZATION=${OPTIMIZATION} -DOPENMP=${OPENMP} ../../;) + @(cd build/grid; cmake -Wno-dev -DDAMASK_SOLVER=GRID -DCMAKE_INSTALL_PREFIX=${DAMASK_ROOT} -DCMAKE_BUILD_TYPE=${BUILD_TYPE} -DBUILDCMD_POST=${BUILDCMD_POST} -DBUILDCMD_PRE=${BUILDCMD_PRE} -DOPTIMIZATION=${OPTIMIZATION} -DOPENMP=${OPENMP} ../../;) -.PHONY: build/FEM -build/FEM: - @mkdir -p build/FEM - @(cd build/FEM; cmake -Wno-dev -DDAMASK_SOLVER=FEM -DCMAKE_BUILD_TYPE=${BUILD_TYPE} -DBUILDCMD_POST=${BUILDCMD_POST} -DBUILDCMD_PRE=${BUILDCMD_PRE} -DOPTIMIZATION=${OPTIMIZATION} -DOPENMP=${OPENMP} ../../;) +.PHONY: build/mesh +build/mesh: + @mkdir -p build/mesh + @(cd build/mesh; cmake -Wno-dev -DDAMASK_SOLVER=FEM -DCMAKE_INSTALL_PREFIX=${DAMASK_ROOT} -DCMAKE_BUILD_TYPE=${BUILD_TYPE} -DBUILDCMD_POST=${BUILDCMD_POST} -DBUILDCMD_PRE=${BUILDCMD_PRE} -DOPTIMIZATION=${OPTIMIZATION} -DOPENMP=${OPENMP} ../../;) .PHONY: clean clean: diff --git a/PRIVATE b/PRIVATE index f342bc7da..212ac3b32 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit f342bc7dabddf5a9c7786d14115145ef4b0f330b +Subproject commit 212ac3b326f3a15926d71109fec0173d95931b6b diff --git a/VERSION b/VERSION index a55a6e6d5..00ca40975 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-130-gda034f97 +v2.0.3-152-gd74599d3 diff --git a/cmake/Compiler-GNU.cmake b/cmake/Compiler-GNU.cmake new file mode 100644 index 000000000..008c0c90e --- /dev/null +++ b/cmake/Compiler-GNU.cmake @@ -0,0 +1,130 @@ +################################################################################################### +# GNU Compiler +################################################################################################### + + if (OPENMP) + set (OPENMP_FLAGS "-fopenmp") + endif () + + if (OPTIMIZATION STREQUAL "OFF") + set (OPTIMIZATION_FLAGS "-O0" ) + elseif (OPTIMIZATION STREQUAL "DEFENSIVE") + set (OPTIMIZATION_FLAGS "-O2") + elseif (OPTIMIZATION STREQUAL "AGGRESSIVE") + set (OPTIMIZATION_FLAGS "-O3 -ffast-math -funroll-loops -ftree-vectorize") + endif () + + set (STANDARD_CHECK "-std=f2008ts -pedantic-errors" ) + set (LINKER_FLAGS "${LINKER_FLAGS} -Wl") + # options parsed directly to the linker + set (LINKER_FLAGS "${LINKER_FLAGS},-undefined,dynamic_lookup" ) + # ensure to link against dynamic libraries + +#------------------------------------------------------------------------------------------------ +# Fine tuning compilation options + set (COMPILE_FLAGS "${COMPILE_FLAGS} -xf95-cpp-input") + # preprocessor + + set (COMPILE_FLAGS "${COMPILE_FLAGS} -ffree-line-length-132") + # restrict line length to the standard 132 characters (lattice.f90 require more characters) + + set (COMPILE_FLAGS "${COMPILE_FLAGS} -fimplicit-none") + # assume "implicit none" even if not present in source + + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wall") + # sets the following Fortran options: + # -Waliasing: warn about possible aliasing of dummy arguments. Specifically, it warns if the same actual argument is associated with a dummy argument with "INTENT(IN)" and a dummy argument with "INTENT(OUT)" in a call with an explicit interface. + # -Wampersand: checks if a character expression is continued proberly by an ampersand at the end of the line and at the beginning of the new line + # -Warray-bounds: checks if array reference is out of bounds at compile time. use -fcheck-bounds to also check during runtime + # -Wconversion: warn about implicit conversions between different type + # -Wsurprising: warn when "suspicious" code constructs are encountered. While technically legal these usually indicate that an error has been made. + # -Wc-binding-type: + # -Wintrinsics-std: only standard intrisics are available, e.g. "call flush(6)" will cause an error + # -Wno-tabs: do not allow tabs in source + # -Wintrinsic-shadow: warn if a user-defined procedure or module procedure has the same name as an intrinsic + # -Wline-truncation: + # -Wtarget-lifetime: + # -Wreal-q-constant: warn about real-literal-constants with 'q' exponent-letter + # -Wunused: a number of unused-xxx warnings + # and sets the general (non-Fortran options) options: + # -Waddress + # -Warray-bounds (only with -O2) + # -Wc++11-compat + # -Wchar-subscripts + # -Wcomment + # -Wformat + # -Wmaybe-uninitialized + # -Wnonnull + # -Wparentheses + # -Wpointer-sign + # -Wreorder + # -Wreturn-type + # -Wsequence-point + # -Wstrict-aliasing + # -Wstrict-overflow=1 + # -Wswitch + # -Wtrigraphs + # -Wuninitialized + # -Wunknown-pragmas + # -Wunused-function + # -Wunused-label + # -Wunused-value + # -Wunused-variable + # -Wvolatile-register-var + + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wextra") + # sets the following Fortran options: + # -Wunuses-parameter: + # -Wcompare-reals: + # and sets the general (non-Fortran options) options: + # -Wclobbered + # -Wempty-body + # -Wignored-qualifiers + # -Wmissing-field-initializers + # -Woverride-init + # -Wsign-compare + # -Wtype-limits + # -Wuninitialized + # -Wunused-but-set-parameter (only with -Wunused or -Wall) + # -Wno-globals + + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wcharacter-truncation") + # warn if character expressions (strings) are truncated + + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wunderflow") + # produce a warning when numerical constant expressions are encountered, which yield an UNDERFLOW during compilation + + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wsuggest-attribute=pure") + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wsuggest-attribute=noreturn") + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wconversion-extra") + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wimplicit-procedure") + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Wno-unused-parameter") + set (COMPILE_FLAGS "${COMPILE_FLAGS} -ffpe-summary=all") + # print summary of floating point exeptions (invalid,zero,overflow,underflow,inexact,denormal) + + # Additional options + # -Warray-temporarieswarnings: because we have many temporary arrays (performance issue?): + # -Wimplicit-interface: no interfaces for lapack/MPI routines + # -Wunsafe-loop-optimizations: warn if the loop cannot be optimized due to nontrivial assumptions. + +#------------------------------------------------------------------------------------------------ +# Runtime debugging + set (DEBUG_FLAGS "${DEBUG_FLAGS} -ffpe-trap=invalid,zero,overflow") + # stop execution if floating point exception is detected (NaN is silent) + + set (DEBUG_FLAGS "${DEBUG_FLAGS} -g") + # Generate symbolic debugging information in the object file + + set (DEBUG_FLAGS "${DEBUG_FLAGS} -fbacktrace") + set (DEBUG_FLAGS "${DEBUG_FLAGS} -fdump-core") + set (DEBUG_FLAGS "${DEBUG_FLAGS} -fcheck=all") + # checks for (array-temps,bounds,do,mem,pointer,recursion) + + # Additional options + # -ffpe-trap=precision,denormal,underflow +#------------------------------------------------------------------------------------------------ +# precision settings + set (PRECISION_FLAGS "${PRECISION_FLAGS} -fdefault-real-8") + # set precision to 8 bytes for standard real (=8 for pReal). Will set size of double to 16 bytes as long as -fdefault-double-8 is not set + set (PRECISION_FLAGS "${PRECISION_FLAGS} -fdefault-double-8") + # set precision to 8 bytes for double real, would be 16 bytes if -fdefault-real-8 is used diff --git a/cmake/Compiler-Intel.cmake b/cmake/Compiler-Intel.cmake new file mode 100644 index 000000000..998f60326 --- /dev/null +++ b/cmake/Compiler-Intel.cmake @@ -0,0 +1,114 @@ +################################################################################################### +# Intel Compiler +################################################################################################### + if (OPENMP) + set (OPENMP_FLAGS "-qopenmp -parallel") + endif () + + if (OPTIMIZATION STREQUAL "OFF") + set (OPTIMIZATION_FLAGS "-O0 -no-ip") + elseif (OPTIMIZATION STREQUAL "DEFENSIVE") + set (OPTIMIZATION_FLAGS "-O2") + elseif (OPTIMIZATION STREQUAL "AGGRESSIVE") + set (OPTIMIZATION_FLAGS "-ipo -O3 -no-prec-div -fp-model fast=2 -xHost") + # -fast = -ipo, -O3, -no-prec-div, -static, -fp-model fast=2, and -xHost" + endif () + + # -assume std_mod_proc_name (included in -standard-semantics) causes problems if other modules + # (PETSc, HDF5) are not compiled with this option (https://software.intel.com/en-us/forums/intel-fortran-compiler-for-linux-and-mac-os-x/topic/62172) + set (STANDARD_CHECK "-stand f15 -standard-semantics -assume nostd_mod_proc_name") + set (LINKER_FLAGS "${LINKER_FLAGS} -shared-intel") + # Link against shared Intel libraries instead of static ones + +#------------------------------------------------------------------------------------------------ +# Fine tuning compilation options + set (COMPILE_FLAGS "${COMPILE_FLAGS} -fpp") + # preprocessor + + set (COMPILE_FLAGS "${COMPILE_FLAGS} -ftz") + # flush underflow to zero, automatically set if -O[1,2,3] + + set (COMPILE_FLAGS "${COMPILE_FLAGS} -diag-disable") + # disables warnings ... + set (COMPILE_FLAGS "${COMPILE_FLAGS} 5268") + # ... the text exceeds right hand column allowed on the line (we have only comments there) + + set (COMPILE_FLAGS "${COMPILE_FLAGS} -warn") + # enables warnings ... + set (COMPILE_FLAGS "${COMPILE_FLAGS} declarations") + # ... any undeclared names (alternative name: -implicitnone) + set (COMPILE_FLAGS "${COMPILE_FLAGS},general") + # ... warning messages and informational messages are issued by the compiler + set (COMPILE_FLAGS "${COMPILE_FLAGS},usage") + # ... questionable programming practices + set (COMPILE_FLAGS "${COMPILE_FLAGS},interfaces") + # ... checks the interfaces of all SUBROUTINEs called and FUNCTIONs invoked in your compilation against an external set of interface blocks + set (COMPILE_FLAGS "${COMPILE_FLAGS},ignore_loc") + # ... %LOC is stripped from an actual argument + set (COMPILE_FLAGS "${COMPILE_FLAGS},alignments") + # ... data that is not naturally aligned + set (COMPILE_FLAGS "${COMPILE_FLAGS},unused") + # ... declared variables that are never used + + # Additional options + # -warn: enables warnings, where + # truncated_source: Determines whether warnings occur when source exceeds the maximum column width in fixed-format files. + # (too many warnings because we have comments beyond character 132) + # uncalled: Determines whether warnings occur when a statement function is never called + # all: + # -name as_is: case sensitive Fortran! + +#------------------------------------------------------------------------------------------------ +# Runtime debugging + set (DEBUG_FLAGS "${DEBUG_FLAGS} -g") + # Generate symbolic debugging information in the object file + + set (DEBUG_FLAGS "${DEBUG_FLAGS} -traceback") + # Generate extra information in the object file to provide source file traceback information when a severe error occurs at run time + + set (DEBUG_FLAGS "${DEBUG_FLAGS} -gen-interfaces") + # Generate an interface block for each routine. http://software.intel.com/en-us/blogs/2012/01/05/doctor-fortran-gets-explicit-again/ + + set (DEBUG_FLAGS "${DEBUG_FLAGS} -fp-stack-check") + # Generate extra code after every function call to ensure that the floating-point (FP) stack is in the expected state + + set (DEBUG_FLAGS "${DEBUG_FLAGS} -fp-model strict") + # Trap uninitalized variables + + set (DEBUG_FLAGS "${DEBUG_FLAGS} -check" ) + # Checks at runtime ... + set (DEBUG_FLAGS "${DEBUG_FLAGS} bounds") + # ... if an array index is too small (<1) or too large! + set (DEBUG_FLAGS "${DEBUG_FLAGS},format") + # ... for the data type of an item being formatted for output. + set (DEBUG_FLAGS "${DEBUG_FLAGS},output_conversion") + # ... for the fit of data items within a designated format descriptor field. + set (DEBUG_FLAGS "${DEBUG_FLAGS},pointers") + # ... for certain disassociated or uninitialized pointers or unallocated allocatable objects. + set (DEBUG_FLAGS "${DEBUG_FLAGS},uninit") + # ... for uninitialized variables. + set (DEBUG_FLAGS "${DEBUG_FLAGS} -ftrapuv") + # ... initializes stack local variables to an unusual value to aid error detection + set (DEBUG_FLAGS "${DEBUG_FLAGS} -fpe-all=0") + # ... capture all floating-point exceptions, sets -ftz automatically + + set (DEBUG_FLAGS "${DEBUG_FLAGS} -warn") + # enables warnings ... + set (DEBUG_FLAGS "${DEBUG_FLAGS} errors") + # ... warnings are changed to errors + set (DEBUG_FLAGS "${DEBUG_FLAGS},stderrors") + # ... warnings about Fortran standard violations are changed to errors + + set (DEBUG_FLAGS "${DEBUG_FLAGS} -debug-parameters all") + # generate debug information for parameters + + # Additional options + # -heap-arrays: Should not be done for OpenMP, but set "ulimit -s unlimited" on shell. Probably it helps also to unlimit other limits + # -check: Checks at runtime, where + # arg_temp_created: will cause a lot of warnings because we create a bunch of temporary arrays (performance?) + # stack: + +#------------------------------------------------------------------------------------------------ +# precision settings + set (PRECISION_FLAGS "${PRECISION_FLAGS} -real-size 64") + # set precision for standard real to 32 | 64 | 128 (= 4 | 8 | 16 bytes, type pReal is always 8 bytes) diff --git a/cmake/Compiler-PGI.cmake b/cmake/Compiler-PGI.cmake new file mode 100644 index 000000000..bca76f648 --- /dev/null +++ b/cmake/Compiler-PGI.cmake @@ -0,0 +1,25 @@ +################################################################################################### +# PGI Compiler +################################################################################################### +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "PGI") + + if (OPTIMIZATION STREQUAL "OFF") + set (OPTIMIZATION_FLAGS "-O0" ) + elseif (OPTIMIZATION STREQUAL "DEFENSIVE") + set (OPTIMIZATION_FLAGS "-O2") + elseif (OPTIMIZATION STREQUAL "AGGRESSIVE") + set (OPTIMIZATION_FLAGS "-O3") + endif () + + +#------------------------------------------------------------------------------------------------ +# Fine tuning compilation options + set (COMPILE_FLAGS "${COMPILE_FLAGS} -Mpreprocess") + # preprocessor + + set (STANDARD_CHECK "-Mallocatable=03") + +#------------------------------------------------------------------------------------------------ +# Runtime debugging + set (DEBUG_FLAGS "${DEBUG_FLAGS} -g") + # Includes debugging information in the object module; sets the optimization level to zero unless a -⁠O option is present on the command line diff --git a/env/DAMASK.csh b/env/DAMASK.csh index 1819dd305..d223d885a 100644 --- a/env/DAMASK.csh +++ b/env/DAMASK.csh @@ -13,9 +13,7 @@ set BRANCH = `git branch 2>/dev/null| grep -E '^\* ')` cd - >/dev/null # if DAMASK_BIN is present -if ( $?DAMASK_BIN) then - set path = ($DAMASK_BIN $path) -endif +set path = ($DAMASK_ROOT/bin $path) set SOLVER=`which DAMASK_spectral` set PROCESSING=`which postResults` diff --git a/env/DAMASK.sh b/env/DAMASK.sh index fa2c8db25..1b4bea86a 100644 --- a/env/DAMASK.sh +++ b/env/DAMASK.sh @@ -33,8 +33,7 @@ unset -f set # add BRANCH if DAMASK_ROOT is a git repository cd $DAMASK_ROOT >/dev/null; BRANCH=$(git branch 2>/dev/null| grep -E '^\* '); cd - >/dev/null -# add DAMASK_BIN if present -[ "x$DAMASK_BIN" != "x" ] && PATH=$DAMASK_BIN:$PATH +PATH=${DAMASK_ROOT}/bin:$PATH SOLVER=$(type -p DAMASK_spectral || true 2>/dev/null) [ "x$SOLVER" == "x" ] && SOLVER=$(blink 'Not found!') diff --git a/env/DAMASK.zsh b/env/DAMASK.zsh index 61b9c89f9..5449007f9 100644 --- a/env/DAMASK.zsh +++ b/env/DAMASK.zsh @@ -25,7 +25,7 @@ unset -f set cd $DAMASK_ROOT >/dev/null; BRANCH=$(git branch 2>/dev/null| grep -E '^\* '); cd - >/dev/null # add DAMASK_BIN if present -[[ "x$DAMASK_BIN" != "x" ]] && PATH=$DAMASK_BIN:$PATH +PATH=${DAMASK_ROOT}/bin:$PATH SOLVER=$(which DAMASK_spectral || true 2>/dev/null) [[ "x$SOLVER" == "x" ]] && SOLVER=$(blink 'Not found!') diff --git a/examples/SpectralMethod/Polycrystal/material.config b/examples/SpectralMethod/Polycrystal/material.config index 39e7f1952..71d7e07d7 100644 --- a/examples/SpectralMethod/Polycrystal/material.config +++ b/examples/SpectralMethod/Polycrystal/material.config @@ -30,11 +30,20 @@ plasticity phenopowerlaw (output) resistance_slip (output) shearrate_slip (output) resolvedstress_slip -(output) totalshear +(output) accumulatedshear_slip (output) resistance_twin (output) shearrate_twin (output) resolvedstress_twin -(output) totalvolfrac +(output) accumulatedshear_twin + +# only for HDF5 out +(output) orientation # quaternion +(output) f # deformation gradient tensor; synonyms: "defgrad" +(output) fe # elastic deformation gradient tensor +(output) fp # plastic deformation gradient tensor +(output) p # first Piola-Kichhoff stress tensor; synonyms: "firstpiola", "1stpiola" +(output) lp # plastic velocity gradient tensor + lattice_structure fcc Nslip 12 # per family diff --git a/installation/patch/README.md b/installation/patch/README.md index dd8232758..0b8251510 100644 --- a/installation/patch/README.md +++ b/installation/patch/README.md @@ -12,7 +12,10 @@ patch -p1 < installation/patch/nameOfPatch ## Available patches * **disable_HDF5** disables all HDF5 output. - HDF5 output is an experimental feature. Also, some routines not present in HDF5 1.8.x are remove to allow compilation of DAMASK with HDF5 < 1.10.x + HDF5 output is an experimental feature. Also, some routines not present in HDF5 1.8.x are removed to allow compilation of DAMASK with HDF5 < 1.10.x + + * **disable_old_output** disables all non-HDF5 output. + Saves some memory when using only HDF5 output ## Create patch commit your changes diff --git a/installation/patch/disable_old_output b/installation/patch/disable_old_output new file mode 100644 index 000000000..732dfc83e --- /dev/null +++ b/installation/patch/disable_old_output @@ -0,0 +1,178 @@ +From 6dbd904a4cfc28add3c39bb2a4ec9e2dbb2442b6 Mon Sep 17 00:00:00 2001 +From: Martin Diehl +Date: Thu, 18 Apr 2019 18:25:32 +0200 +Subject: [PATCH] to create patch + +--- + src/DAMASK_grid.f90 | 81 +----------------------------------------- + src/homogenization.f90 | 2 ++ + 2 files changed, 3 insertions(+), 80 deletions(-) + +diff --git a/src/DAMASK_grid.f90 b/src/DAMASK_grid.f90 +index f2f52bb2..a7543f4d 100644 +--- a/src/DAMASK_grid.f90 ++++ b/src/DAMASK_grid.f90 +@@ -18,7 +18,6 @@ program DAMASK_spectral + use DAMASK_interface, only: & + DAMASK_interface_init, & + loadCaseFile, & +- geometryFile, & + getSolverJobName, & + interface_restartInc + use IO, only: & +@@ -49,14 +48,9 @@ program DAMASK_spectral + restartInc + use numerics, only: & + worldrank, & +- worldsize, & + stagItMax, & + maxCutBack, & + continueCalculation +- use homogenization, only: & +- materialpoint_sizeResults, & +- materialpoint_results, & +- materialpoint_postResults + use material, only: & + thermal_type, & + damage_type, & +@@ -131,12 +125,6 @@ program DAMASK_spectral + type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases + type(tLoadCase) :: newLoadCase + type(tSolutionState), allocatable, dimension(:) :: solres +- integer(MPI_OFFSET_KIND) :: fileOffset +- integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize +- integer(pInt), parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742 +- integer(pInt), parameter :: maxRealOut = maxByteOut/pReal +- integer(pLongInt), dimension(2) :: outputIndex +- PetscErrorCode :: ierr + procedure(grid_mech_spectral_basic_init), pointer :: & + mech_init + procedure(grid_mech_spectral_basic_forward), pointer :: & +@@ -384,22 +372,6 @@ program DAMASK_spectral + ! write header of output file + if (worldrank == 0) then + writeHeader: if (interface_restartInc < 1_pInt) then +- open(newunit=fileUnit,file=trim(getSolverJobName())//& +- '.spectralOut',form='UNFORMATTED',status='REPLACE') +- write(fileUnit) 'load:', trim(loadCaseFile) ! ... and write header +- write(fileUnit) 'workingdir:', 'n/a' +- write(fileUnit) 'geometry:', trim(geometryFile) +- write(fileUnit) 'grid:', grid +- write(fileUnit) 'size:', geomSize +- write(fileUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults +- write(fileUnit) 'loadcases:', size(loadCases) +- write(fileUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase +- write(fileUnit) 'times:', loadCases%time ! one entry per LoadCase +- write(fileUnit) 'logscales:', loadCases%logscale +- write(fileUnit) 'increments:', loadCases%incs ! one entry per LoadCase +- write(fileUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc +- write(fileUnit) 'eoh' +- close(fileUnit) ! end of header + open(newunit=statUnit,file=trim(getSolverJobName())//& + '.sta',form='FORMATTED',status='REPLACE') + write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file +@@ -412,39 +384,6 @@ program DAMASK_spectral + endif writeHeader + endif + +-!-------------------------------------------------------------------------------------------------- +-! prepare MPI parallel out (including opening of file) +- allocate(outputSize(worldsize), source = 0_MPI_OFFSET_KIND) +- outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND) +- call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process +- if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce') +- call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', & +- MPI_MODE_WRONLY + MPI_MODE_APPEND, & +- MPI_INFO_NULL, & +- fileUnit, & +- ierr) +- if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_open') +- call MPI_file_get_position(fileUnit,fileOffset,ierr) ! get offset from header +- if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_get_position') +- fileOffset = fileOffset + sum(outputSize(1:worldrank)) ! offset of my process in file (header + processes before me) +- call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr) +- if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek') +- +- writeUndeformed: if (interface_restartInc < 1_pInt) then +- write(6,'(1/,a)') ' ... writing initial configuration to file ........................' +- call CPFEM_results(0_pInt,0.0_pReal) +- do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output +- outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1? +- min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) +- call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & +- [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & +- int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)), & +- MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) +- if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write') +- enddo +- fileOffset = fileOffset + sum(outputSize) ! forward to current file position +- endif writeUndeformed +- + + loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) + time0 = time ! load case start time +@@ -574,7 +513,6 @@ program DAMASK_spectral + write(6,'(/,a)') ' cutting back ' + else ! no more options to continue + call IO_warning(850_pInt) +- call MPI_file_close(fileUnit,ierr) + close(statUnit) + call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written + endif +@@ -593,24 +531,8 @@ program DAMASK_spectral + ' increment ', totalIncsCounter, ' NOT converged' + endif; flush(6) + +- if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency +- write(6,'(1/,a)') ' ... writing results to file ......................................' +- flush(6) +- call materialpoint_postResults() +- call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr) +- if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') +- do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output +- outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & +- min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) +- call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),& +- [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & +- int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)),& +- MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) +- if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write') +- enddo +- fileOffset = fileOffset + sum(outputSize) ! forward to current file position ++ if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) & ! at output frequency + call CPFEM_results(totalIncsCounter,time) +- endif + if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ... + .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information + restartWrite = .true. ! set restart parameter for FEsolving +@@ -633,7 +555,6 @@ program DAMASK_spectral + real(convergedCounter, pReal)/& + real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, ' %) increments converged!' + flush(6) +- call MPI_file_close(fileUnit,ierr) + close(statUnit) + + if (notConvergedCounter > 0_pInt) call quit(2_pInt) ! error if some are not converged +diff --git a/src/homogenization.f90 b/src/homogenization.f90 +index 06da6ab2..0743d545 100644 +--- a/src/homogenization.f90 ++++ b/src/homogenization.f90 +@@ -269,6 +269,7 @@ subroutine homogenization_init + + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results + + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results + + constitutive_source_maxSizePostResults) ++ materialpoint_sizeResults = 0 + allocate(materialpoint_results(materialpoint_sizeResults,theMesh%elem%nIPs,theMesh%nElems)) + + write(6,'(/,a)') ' <<<+- homogenization init -+>>>' +@@ -682,6 +683,7 @@ subroutine materialpoint_postResults + i, & !< integration point number + e !< element number + ++ return + !$OMP PARALLEL DO PRIVATE(myNgrains,myCrystallite,thePos,theSize) + elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2) + myNgrains = homogenization_Ngrains(mesh_element(3,e)) +-- +2.21.0 + diff --git a/installation/symlink_Processing.py b/installation/symlink_Processing.py index 60f8d3639..90497c0eb 100755 --- a/installation/symlink_Processing.py +++ b/installation/symlink_Processing.py @@ -7,7 +7,7 @@ import damask damaskEnv = damask.Environment() baseDir = damaskEnv.relPath('processing/') -binDir = damaskEnv.options['DAMASK_BIN'] +binDir = damaskEnv.relPath('bin/') if not os.path.isdir(binDir): os.mkdir(binDir) diff --git a/processing/post/DADF5_vtk_cells.py b/processing/post/DADF5_vtk_cells.py new file mode 100755 index 000000000..3bbf9fd45 --- /dev/null +++ b/processing/post/DADF5_vtk_cells.py @@ -0,0 +1,92 @@ +#!/usr/bin/env python3 +# -*- coding: UTF-8 no BOM -*- + +import os,vtk +import numpy as np +import argparse +import damask +from vtk.util import numpy_support + +scriptName = os.path.splitext(os.path.basename(__file__))[0] +scriptID = ' '.join([scriptName,damask.version]) + +# -------------------------------------------------------------------- +# MAIN +# -------------------------------------------------------------------- +parser = argparse.ArgumentParser() + +#ToDo: We need to decide on a way of handling arguments of variable lentght +#https://stackoverflow.com/questions/15459997/passing-integer-lists-to-python + +#parser.add_argument('--version', action='version', version='%(prog)s {}'.format(scriptID)) +parser.add_argument('filenames', nargs='+', + help='DADF5 files') + +options = parser.parse_args() + +options.labels = ['Fe','Fp','xi_sl'] + +# --- loop over input files ------------------------------------------------------------------------ + +for filename in options.filenames: + results = damask.DADF5(filename) + + if results.structured: # for grid solvers use rectilinear grid + rGrid = vtk.vtkRectilinearGrid() + coordArray = [vtk.vtkDoubleArray(), + vtk.vtkDoubleArray(), + vtk.vtkDoubleArray(), + ] + + rGrid.SetDimensions(*(results.grid+1)) + for dim in [0,1,2]: + for c in np.linspace(0,results.size[dim],1+results.grid[dim]): + coordArray[dim].InsertNextValue(c) + + rGrid.SetXCoordinates(coordArray[0]) + rGrid.SetYCoordinates(coordArray[1]) + rGrid.SetZCoordinates(coordArray[2]) + + + for i,inc in enumerate(results.increments): + print('Output step {}/{}'.format(i+1,len(results.increments))) + vtk_data = [] + results.active['increments'] = [inc] + for label in options.labels: + for o in results.c_output_types: + results.active['c_output_types'] = [o] + if o != 'generic': + for c in results.constituents: + results.active['constituents'] = [c] + x = results.get_dataset_location(label) + if len(x) == 0: + continue + array = results.read_dataset(x,0) + shape = [array.shape[0],np.product(array.shape[1:])] + vtk_data.append(numpy_support.numpy_to_vtk(num_array=array.reshape(shape),deep=True,array_type= vtk.VTK_DOUBLE)) + vtk_data[-1].SetName('1_'+x[0].split('/',1)[1]) + rGrid.GetCellData().AddArray(vtk_data[-1]) + else: + results.active['constituents'] = results.constituents + x = results.get_dataset_location(label) + if len(x) == 0: + continue + array = results.read_dataset(x,0) + shape = [array.shape[0],np.product(array.shape[1:])] + vtk_data.append(numpy_support.numpy_to_vtk(num_array=array.reshape(shape),deep=True,array_type= vtk.VTK_DOUBLE)) + vtk_data[-1].SetName('1_'+x[0].split('/')[1]+'/generic/'+label) + rGrid.GetCellData().AddArray(vtk_data[-1]) + + if results.structured: + writer = vtk.vtkXMLRectilinearGridWriter() + + writer.SetCompressorTypeToZLib() + writer.SetDataModeToBinary() + writer.SetFileName(os.path.join(os.path.split(filename)[0], + os.path.splitext(os.path.split(filename)[1])[0] + + '_inc{:04d}'.format(i) + # ToDo: adjust to length of increments + '.' + writer.GetDefaultFileExtension())) + if results.structured: + writer.SetInputData(rGrid) + + writer.Write() diff --git a/processing/post/addDisplacement.py b/processing/post/addDisplacement.py index aa12ba2b1..53311ce9e 100755 --- a/processing/post/addDisplacement.py +++ b/processing/post/addDisplacement.py @@ -40,9 +40,10 @@ def displacementAvgFFT(F,grid,size,nodal=False,transformed=False): np.linspace(0,size[0],1+grid[0]), indexing = 'ij') else: - x, y, z = np.meshgrid(np.linspace(0,size[2],grid[2],endpoint=False), - np.linspace(0,size[1],grid[1],endpoint=False), - np.linspace(0,size[0],grid[0],endpoint=False), + delta = size/grid*0.5 + x, y, z = np.meshgrid(np.linspace(delta[2],size[2]-delta[2],grid[2]), + np.linspace(delta[1],size[1]-delta[1],grid[1]), + np.linspace(delta[0],size[0]-delta[0],grid[0]), indexing = 'ij') origCoords = np.concatenate((z[:,:,:,None],y[:,:,:,None],x[:,:,:,None]),axis = 3) diff --git a/python/.gitignore b/python/.gitignore new file mode 100644 index 000000000..bd729dc2c --- /dev/null +++ b/python/.gitignore @@ -0,0 +1,2 @@ +dist +damask.egg-info diff --git a/python/MANIFEST.in b/python/MANIFEST.in new file mode 100644 index 000000000..bb6d21f36 --- /dev/null +++ b/python/MANIFEST.in @@ -0,0 +1 @@ +include damask/VERSION diff --git a/python/damask/.gitignore b/python/damask/.gitignore deleted file mode 100644 index 1b8936623..000000000 --- a/python/damask/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -core.so -corientation.so -*.pyx diff --git a/python/damask/LICENSE b/python/damask/LICENSE new file mode 120000 index 000000000..30cff7403 --- /dev/null +++ b/python/damask/LICENSE @@ -0,0 +1 @@ +../../LICENSE \ No newline at end of file diff --git a/python/damask/README b/python/damask/README new file mode 120000 index 000000000..3830a4118 --- /dev/null +++ b/python/damask/README @@ -0,0 +1 @@ +../../README \ No newline at end of file diff --git a/python/damask/VERSION b/python/damask/VERSION new file mode 120000 index 000000000..558194c5a --- /dev/null +++ b/python/damask/VERSION @@ -0,0 +1 @@ +../../VERSION \ No newline at end of file diff --git a/python/damask/__init__.py b/python/damask/__init__.py index d7ed4a9f9..684ab48b5 100644 --- a/python/damask/__init__.py +++ b/python/damask/__init__.py @@ -3,8 +3,8 @@ """Main aggregator""" import os -with open(os.path.join(os.path.dirname(__file__),'../../VERSION')) as f: - version = f.readline()[:-1] +with open(os.path.join(os.path.dirname(__file__),'VERSION')) as f: + version = f.readline()[1:-1] name = 'damask' @@ -14,6 +14,7 @@ from .asciitable import ASCIItable # noqa from .config import Material # noqa from .colormaps import Colormap, Color # noqa from .orientation import Symmetry, Lattice, Rotation, Orientation # noqa +from .dadf5 import DADF5 # noqa #from .block import Block # only one class from .result import Result # noqa diff --git a/python/damask/dadf5.py b/python/damask/dadf5.py new file mode 100644 index 000000000..4214f4922 --- /dev/null +++ b/python/damask/dadf5.py @@ -0,0 +1,112 @@ +# -*- coding: UTF-8 no BOM -*- +import h5py +import re +import numpy as np + +# ------------------------------------------------------------------ +class DADF5(): + """Read and write to DADF5 files""" + +# ------------------------------------------------------------------ + def __init__(self, + filename, + mode = 'r', + ): + + if mode not in ['a','r']: + print('Invalid file access mode') + with h5py.File(filename,mode): + pass + + with h5py.File(filename,'r') as f: + + if f.attrs['DADF5-major'] != 0 or f.attrs['DADF5-minor'] != 1: + raise TypeError('Unsupported DADF5 version {} '.format(f.attrs['DADF5-version'])) + + self.structured = 'grid' in f['mapping'].attrs.keys() + + if self.structured: + self.grid = f['mapping'].attrs['grid'] + self.size = f['mapping'].attrs['size'] + + r=re.compile('inc[0-9]+') + self.increments = [{'inc': int(u[3:]), + 'time': round(f[u].attrs['time/s'],12), + } for u in f.keys() if r.match(u)] + + self.constituents = np.unique(f['mapping/cellResults/constituent']['Name']).tolist() # ToDo: I am not to happy with the name + self.constituents = [c.decode() for c in self.constituents] + + self.materialpoints = np.unique(f['mapping/cellResults/materialpoint']['Name']).tolist() # ToDo: I am not to happy with the name + self.materialpoints = [m.decode() for m in self.materialpoints] + + self.Nconstituents = [i for i in range(np.shape(f['mapping/cellResults/constituent'])[1])] + self.Nmaterialpoints = np.shape(f['mapping/cellResults/constituent'])[0] + + self.c_output_types = [] + for c in self.constituents: + for o in f['inc{:05}/constituent/{}'.format(self.increments[0]['inc'],c)].keys(): + self.c_output_types.append(o) + self.c_output_types = list(set(self.c_output_types)) # make unique + + self.active= {'increments': self.increments, + 'constituents': self.constituents, + 'materialpoints': self.materialpoints, + 'constituent': self.Nconstituents, + 'c_output_types': self.c_output_types} + + self.filename = filename + self.mode = mode + + def list_data(self): + """Shows information on all datasets in the file""" + with h5py.File(self.filename,'r') as f: + group_inc = 'inc{:05}'.format(self.active['increments'][0]['inc']) + for c in self.active['constituents']: + print('\n'+c) + group_constituent = group_inc+'/constituent/'+c + for t in self.active['c_output_types']: + print(' {}'.format(t)) + group_output_types = group_constituent+'/'+t + try: + for x in f[group_output_types].keys(): + print(' {} ({})'.format(x,f[group_output_types+'/'+x].attrs['Description'].decode())) + except: + pass + + + def get_dataset_location(self,label): + """Returns the location of all active datasets with given label""" + path = [] + with h5py.File(self.filename,'r') as f: + for i in self.active['increments']: + group_inc = 'inc{:05}'.format(i['inc']) + for c in self.active['constituents']: + group_constituent = group_inc+'/constituent/'+c + for t in self.active['c_output_types']: + try: + f[group_constituent+'/'+t+'/'+label] + path.append(group_constituent+'/'+t+'/'+label) + except: + pass + return path + + + def read_dataset(self,path,c): + """ + Dataset for all points/cells + + If more than one path is given, the dataset is composed of the individual contributions + """ + with h5py.File(self.filename,'r') as f: + shape = (self.Nmaterialpoints,) + np.shape(f[path[0]])[1:] + dataset = np.full(shape,np.nan) + for pa in path: + label = pa.split('/')[2] + p = np.where(f['mapping/cellResults/constituent'][:,c]['Name'] == str.encode(label))[0] + u = (f['mapping/cellResults/constituent'][p,c]['Position']) + dataset[p,:] = f[pa][u,:] + + return dataset + + diff --git a/python/damask/environment.py b/python/damask/environment.py index 17786ab28..21eb24694 100644 --- a/python/damask/environment.py +++ b/python/damask/environment.py @@ -1,6 +1,6 @@ # -*- coding: UTF-8 no BOM -*- -import os,subprocess,shlex,re +import os,re class Environment(): __slots__ = [ \ @@ -26,24 +26,3 @@ class Environment(): if len(items) == 2: self.options[items[0].upper()] = \ re.sub('\$\{*DAMASK_ROOT\}*',self.rootDir(),os.path.expandvars(items[1])) # expand all shell variables and DAMASK_ROOT - - def isAvailable(self,software,Nneeded =-1): - licensesNeeded = {'abaqus' :5, - 'standard':5 - } - if Nneeded == -1: Nneeded = licensesNeeded[software] - try: - cmd = """ ssh mulicense2 "/lm-status | grep 'Users of %s: ' | cut -d' ' -f7,13" """%software - process = subprocess.Popen(shlex.split(cmd),stdout = subprocess.PIPE,stderr = subprocess.PIPE) - licenses = list(map(int, process.stdout.readline().split())) - try: - if licenses[0]-licenses[1] >= Nneeded: - return 0 - else: - print('%s missing licenses for %s'%(licenses[1] + Nneeded - licenses[0],software)) - return licenses[1] + Nneeded - licenses[0] - except IndexError: - print('Could not retrieve license information for %s'%software) - return 127 - except: - return 126 diff --git a/python/setup.py b/python/setup.py new file mode 100644 index 000000000..515401c59 --- /dev/null +++ b/python/setup.py @@ -0,0 +1,28 @@ +import setuptools +import os + +with open(os.path.join(os.path.dirname(__file__),'damask/VERSION')) as f: + version = f.readline()[1:-1] + +setuptools.setup( + 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", + packages=setuptools.find_packages(), + include_package_data=True, + install_requires = [ + "scipy", + "h5py", + "vtk" + ], + license = 'GPL3', + classifiers = [ + "Programming Language :: Python :: 3", + "License :: OSI Approved :: GPL3", + "Operating System :: OS Independent", + ], +) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 274069226..b2eee5561 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -4,43 +4,37 @@ if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") SET_SOURCE_FILES_PROPERTIES("lattice.f90" PROPERTIES COMPILE_FLAGS "-ffree-line-length-240") endif() -file(GLOB_RECURSE sources *.f90 *.c) +file(GLOB damask-sources *.f90 *.c) # probably we should have subfolders for abaqus and MSC.Marc -list(FILTER sources EXCLUDE REGEX ".*CPFEM\\.f90") -list(FILTER sources EXCLUDE REGEX ".*DAMASK_marc.*\\.f90") -list(FILTER sources EXCLUDE REGEX ".*mesh_marc.*\\.f90") -list(FILTER sources EXCLUDE REGEX ".*mesh_abaqus.*\\.f90") -list(FILTER sources EXCLUDE REGEX ".*commercialFEM_fileList.*\\.f90") +list(FILTER damask-sources EXCLUDE REGEX ".*CPFEM.f90") +list(FILTER damask-sources EXCLUDE REGEX ".*DAMASK_marc.*.f90") +list(FILTER damask-sources EXCLUDE REGEX ".*mesh_marc.*.f90") +list(FILTER damask-sources EXCLUDE REGEX ".*mesh_abaqus.*.f90") +list(FILTER damask-sources EXCLUDE REGEX ".*commercialFEM_fileList.*.f90") -if (PROJECT_NAME STREQUAL "DAMASK_grid") +if (PROJECT_NAME STREQUAL "damask-grid") - # probably we should have subfolders for FEM and spectral - list(FILTER sources EXCLUDE REGEX ".*DAMASK_FEM.*\\.f90") - list(FILTER sources EXCLUDE REGEX ".*FEM_utilities.*\\.f90") - list(FILTER sources EXCLUDE REGEX ".*FEM_zoo.*\\.f90") - list(FILTER sources EXCLUDE REGEX ".*mesh_FEM.*\\.f90") - list(FILTER sources EXCLUDE REGEX ".*FEM_mech.*\\.f90") + list(FILTER damask-sources EXCLUDE REGEX ".*mesh_FEM.*.f90") + file(GLOB grid-sources grid/*.f90) if(NOT CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY") - add_executable(DAMASK_spectral ${sources}) + add_executable(DAMASK_spectral ${damask-sources} ${grid-sources}) + install (TARGETS DAMASK_spectral RUNTIME DESTINATION bin) else() - add_library(DAMASK_spectral OBJECT ${sources}) + add_library(DAMASK_spectral OBJECT ${damask-sources} ${grid-sources}) + exec_program (mktemp OUTPUT_VARIABLE nothing) + exec_program (mktemp ARGS -d OUTPUT_VARIABLE black_hole) + install (PROGRAMS ${nothing} DESTINATION ${black_hole}) endif() -elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") +elseif (PROJECT_NAME STREQUAL "damask-mesh") - # probably we should have subfolders for FEM and spectral - list(FILTER sources EXCLUDE REGEX ".*DAMASK_grid.*\\.f90") - list(FILTER sources EXCLUDE REGEX ".*grid_mech_FEM.*\\.f90") - list(FILTER sources EXCLUDE REGEX ".*grid_mech_spectral_basic.*\\.f90") - list(FILTER sources EXCLUDE REGEX ".*grid_mech_spectral_polarisation.*\\.f90") - list(FILTER sources EXCLUDE REGEX ".*grid_damage_spectral.*\\.f90") - list(FILTER sources EXCLUDE REGEX ".*grid_thermal_spectral.*\\.f90") - list(FILTER sources EXCLUDE REGEX ".*spectral_utilities.*\\.f90") - list(FILTER sources EXCLUDE REGEX ".*mesh_grid.*\\.f90") + list(FILTER damask-sources EXCLUDE REGEX ".*mesh_grid.*.f90") + file(GLOB mesh-sources mesh/*.f90) - add_executable(DAMASK_FEM ${sources}) + add_executable(DAMASK_FEM ${damask-sources} ${mesh-sources}) + install (TARGETS DAMASK_FEM RUNTIME DESTINATION bin) endif() diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index a2593e1cb..731b44f06 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -70,6 +70,8 @@ module HDF5_utilities module procedure HDF5_addAttribute_str module procedure HDF5_addAttribute_int module procedure HDF5_addAttribute_real + module procedure HDF5_addAttribute_int_array + module procedure HDF5_addAttribute_real_array end interface HDF5_addAttribute @@ -268,10 +270,11 @@ end subroutine HDF5_closeGroup !-------------------------------------------------------------------------------------------------- logical function HDF5_objectExists(loc_id,path) - integer(HID_T), intent(in) :: loc_id + integer(HID_T), intent(in) :: loc_id character(len=*), intent(in), optional :: path - integer :: hdferr - character(len=256) :: p + + integer :: hdferr + character(len=256) :: p if (present(path)) then p = trim(path) @@ -295,13 +298,14 @@ end function HDF5_objectExists !-------------------------------------------------------------------------------------------------- subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) - integer(HID_T), intent(in) :: loc_id - character(len=*), intent(in) :: attrLabel, attrValue - character(len=*), intent(in), optional :: path - integer :: hdferr - integer(HID_T) :: attr_id, space_id, type_id - logical :: attrExists - character(len=256) :: p + integer(HID_T), intent(in) :: loc_id + character(len=*), intent(in) :: attrLabel, attrValue + character(len=*), intent(in), optional :: path + + integer :: hdferr + integer(HID_T) :: attr_id, space_id, type_id + logical :: attrExists + character(len=256) :: p if (present(path)) then p = trim(path) @@ -340,14 +344,15 @@ end subroutine HDF5_addAttribute_str !-------------------------------------------------------------------------------------------------- subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path) - integer(HID_T), intent(in) :: loc_id - character(len=*), intent(in) :: attrLabel - integer(pInt), intent(in) :: attrValue + integer(HID_T), intent(in) :: loc_id + character(len=*), intent(in) :: attrLabel + integer(pInt), intent(in) :: attrValue character(len=*), intent(in), optional :: path - integer :: hdferr - integer(HID_T) :: attr_id, space_id, type_id - logical :: attrExists - character(len=256) :: p + + integer :: hdferr + integer(HID_T) :: attr_id, space_id + logical :: attrExists + character(len=256) :: p if (present(path)) then p = trim(path) @@ -356,27 +361,21 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path) endif call h5screate_f(H5S_SCALAR_F,space_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5screate_f') - call h5tcopy_f(H5T_NATIVE_INTEGER, type_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5tcopy_f') - call h5tset_size_f(type_id, 1_HSIZE_T, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5tset_size_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5screate_f') call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5aexists_by_name_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5aexists_by_name_f') if (attrExists) then call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5adelete_by_name_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5adelete_by_name_f') endif - call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5acreate_f') - call h5awrite_f(attr_id, type_id, attrValue, int([1],HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5awrite_f') + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5acreate_f') + call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5awrite_f') call h5aclose_f(attr_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5aclose_f') - call h5tclose_f(type_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5tclose_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5tclose_f') call h5sclose_f(space_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5sclose_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int: h5sclose_f') end subroutine HDF5_addAttribute_int @@ -386,14 +385,15 @@ end subroutine HDF5_addAttribute_int !-------------------------------------------------------------------------------------------------- subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path) - integer(HID_T), intent(in) :: loc_id - character(len=*), intent(in) :: attrLabel - real(pReal), intent(in) :: attrValue - character(len=*), intent(in), optional :: path - integer :: hdferr - integer(HID_T) :: attr_id, space_id, type_id - logical :: attrExists - character(len=256) :: p + integer(HID_T), intent(in) :: loc_id + character(len=*), intent(in) :: attrLabel + real(pReal), intent(in) :: attrValue + character(len=*), intent(in), optional :: path + + integer :: hdferr + integer(HID_T) :: attr_id, space_id + logical :: attrExists + character(len=256) :: p if (present(path)) then p = trim(path) @@ -402,31 +402,113 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path) endif call h5screate_f(H5S_SCALAR_F,space_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5screate_f') - call h5tcopy_f(H5T_NATIVE_DOUBLE, type_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5tcopy_f') - call h5tset_size_f(type_id, 8_HSIZE_T, hdferr) ! ToDo - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5tset_size_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5screate_f') call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5aexists_by_name_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5aexists_by_name_f') if (attrExists) then call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5adelete_by_name_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5adelete_by_name_f') endif - call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5acreate_f') - call h5awrite_f(attr_id, type_id, attrValue, int([1],HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5awrite_f') + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5acreate_f') + call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5awrite_f') call h5aclose_f(attr_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5aclose_f') - call h5tclose_f(type_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5tclose_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5tclose_f') call h5sclose_f(space_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5sclose_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_real: h5sclose_f') end subroutine HDF5_addAttribute_real +!-------------------------------------------------------------------------------------------------- +!> @brief adds a integer attribute to the path given relative to the location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path) + + integer(HID_T), intent(in) :: loc_id + character(len=*), intent(in) :: attrLabel + integer(pInt), intent(in), dimension(:) :: attrValue + character(len=*), intent(in), optional :: path + + integer :: hdferr + integer(HID_T) :: attr_id, space_id + integer(HSIZE_T),dimension(1) :: array_size + logical :: attrExists + character(len=256) :: p + + if (present(path)) then + p = trim(path) + else + p = '.' + endif + + array_size = size(attrValue,kind=HSIZE_T) + + call h5screate_simple_f(1, array_size, space_id, hdferr, array_size) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5screate_f') + call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f') + if (attrExists) then + call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f') + endif + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5acreate_f') + call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, array_size, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5awrite_f') + call h5aclose_f(attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5tclose_f') + call h5sclose_f(space_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5sclose_f') + +end subroutine HDF5_addAttribute_int_array + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a real attribute to the path given relative to the location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path) + + integer(HID_T), intent(in) :: loc_id + character(len=*), intent(in) :: attrLabel + real(pReal), intent(in), dimension(:) :: attrValue + character(len=*), intent(in), optional :: path + + integer :: hdferr + integer(HID_T) :: attr_id, space_id + integer(HSIZE_T),dimension(1) :: array_size + logical :: attrExists + character(len=256) :: p + + if (present(path)) then + p = trim(path) + else + p = '.' + endif + + array_size = size(attrValue,kind=HSIZE_T) + + call h5screate_simple_f(1, array_size, space_id, hdferr, array_size) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5screate_f') + call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f') + if (attrExists) then + call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f') + endif + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5acreate_f') + call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, array_size, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5awrite_f') + call h5aclose_f(attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5tclose_f') + call h5sclose_f(space_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_int_array: h5sclose_f') + +end subroutine HDF5_addAttribute_real_array + + !-------------------------------------------------------------------------------------------------- !> @brief set link to object in results file !-------------------------------------------------------------------------------------------------- diff --git a/src/IO.f90 b/src/IO.f90 index 33c4a778d..074e2b0f4 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -708,6 +708,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'too many systems requested' case (146_pInt) msg = 'number of values does not match' + case (147_pInt) + msg = 'not supported anymore' !-------------------------------------------------------------------------------------------------- ! material error messages and related messages in mesh diff --git a/src/MarcInclude/concom2016 b/src/MarcInclude/concom2016 deleted file mode 100644 index e26774bfc..000000000 --- a/src/MarcInclude/concom2016 +++ /dev/null @@ -1,417 +0,0 @@ -! common block definition file taken from respective MSC.Marc release and reformated to free format -!*********************************************************************** -! -! File: concom.cmn -! -! MSC.Marc include file -! -integer(pInt) & - iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,& - ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,& - ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,& - ipoist, irpflo, ismall, ismalt, isoil, ispect, ispnow, istore, iswep, ithcrp,& - itherm, iupblg, iupdat, jacflg, jel, jparks, largst, lfond, loadup, loaduq,& - lodcor, lovl, lsub, magnet, ncycle, newtnt, newton, noshr, linear, ivscpl,& - icrpim, iradrt, ipshft, itshr, iangin, iupmdr, iconjf, jincfl, jpermg, jhour,& - isolvr, jritz, jtable, jshell, jdoubl, jform, jcentr, imini, kautth, iautof,& - ibukty, iassum, icnstd, icnstt, kmakmas, imethvp, iradrte, iradrtp, iupdate, iupdatp,& - ncycnt, marmen , idynme, ihavca, ispf, kmini, imixex, largtt, kdoela, iautofg,& - ipshftp, idntrc, ipore, jtablm, jtablc, isnecma, itrnspo, imsdif, jtrnspo, mcnear,& - imech, imecht, ielcmat, ielectt, magnett, imsdift, noplas, jtabls, jactch, jtablth,& - kgmsto , jpzo, ifricsh, iremkin, iremfor, ishearp, jspf, machining, jlshell, icompsol,& - iupblgfo, jcondir, nstcrp, nactive, ipassref, nstspnt, ibeart, icheckmpc, noline, icuring,& - ishrink, ioffsflg, isetoff, ioffsetm,iharmt, inc_incdat, iautspc, ibrake, icbush, istream_input,& - iprsinp, ivlsinp, ifirst_time,ipin_m, jgnstr_glb, imarc_return,iqvcinp, nqvceid, istpnx, imicro1,& - iaxisymm, jbreakglue,iglstif, jfastasm,iwear, iwearcf, imixmeth, ielcmadyn, idinout, igena_meth,& - magf_meth, non_assumed, iredoboudry, ioffsz0,icomplt, mesh_dual, iactrp, mgnewton, iusedens,igsigd0,& - iaem, icosim, inodels, nlharm, iampini, iphasetr -dimension :: ideva(60) -integer(pInt) num_concom -parameter(num_concom=245) -common/marc_concom/& - iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,& - ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,& - ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,& - ipoist, irpflo, ismall, ismalt, isoil, ispect, ispnow, istore, iswep, ithcrp,& - itherm, iupblg, iupdat, jacflg, jel, jparks, largst, lfond, loadup, loaduq,& - lodcor, lovl, lsub, magnet, ncycle, newtnt, newton, noshr, linear, ivscpl,& - icrpim, iradrt, ipshft, itshr, iangin, iupmdr, iconjf, jincfl, jpermg, jhour,& - isolvr, jritz, jtable, jshell, jdoubl, jform, jcentr, imini, kautth, iautof,& - ibukty, iassum, icnstd, icnstt, kmakmas, imethvp, iradrte, iradrtp, iupdate, iupdatp,& - ncycnt, marmen, idynme, ihavca, ispf, kmini, imixex, largtt, kdoela, iautofg,& - ipshftp, idntrc, ipore, jtablm, jtablc, isnecma, itrnspo, imsdif, jtrnspo, mcnear,& - imech, imecht, ielcmat, ielectt, magnett, imsdift, noplas, jtabls, jactch, jtablth,& - kgmsto , jpzo, ifricsh, iremkin, iremfor, ishearp, jspf, machining, jlshell, icompsol,& - iupblgfo, jcondir, nstcrp, nactive, ipassref, nstspnt, ibeart, icheckmpc, noline, icuring,& - ishrink, ioffsflg, isetoff, ioffsetm,iharmt, inc_incdat, iautspc, ibrake, icbush , istream_input,& - iprsinp, ivlsinp, ifirst_time,ipin_m, jgnstr_glb, imarc_return,iqvcinp, nqvceid, istpnx, imicro1,& - iaxisymm, jbreakglue,iglstif, jfastasm,iwear, iwearcf, imixmeth, ielcmadyn, idinout,igena_meth,& - magf_meth, non_assumed, iredoboudry, ioffsz0,icomplt, mesh_dual, iactrp, mgnewton, iusedens,igsigd0,& - iaem, icosim, inodels, nlharm, iampini, iphasetr -! -! comments of variables: -! -! iacous Control flag for acoustic analysis. Input data. -! iacous=1 modal acoustic analysis. -! iacous=2 harmonic acoustic-structural analysis. -! iasmbl Control flag to indicate that operator matrix should be -! recalculated. -! iautth Control flag for AUTO THERM option. -! ibear Control flag for bearing analysis. Input data. -! icompl Control variable to indicate that a complex analysis is -! being performed. Either a Harmonic analysis with damping, -! or a harmonic electro-magnetic analysis. Input data. -! iconj Flag for EBE conjugate gradient solver (=solver 1, retired) -! Also used for VKI iterative solver. -! icreep Control flag for creep analysis. Input data. -! ideva(60) - debug print out flag -! 1 print element stiffness matrices, mass matrix -! 2 output matrices used in tying -! 3 force the solution of a nonpositive definite matrix -! 4 print info of connections to each node -! 5 info of gap convergence, internal heat generated, contact -! touching and separation -! 6 nodal value array during rezoning -! 7 tying info in CONRAD GAP option, fluid element numbers in -! CHANNEL option -! 8 output incremental displacements in local coord. system -! 9 latent heat output -! 10 stress-strain in local coord. system -! 11 additional info on interlaminar stress -! 12 output right hand side and solution vector -! 13 info of CPU resources used and memory available on NT -! 14 info of mesh adaption process, 2D outline information -! info of penetration checking for remeshing -! save .fem files after afmesh3d meshing -! 15 surface energy balance flag -! 16 print info regarding pyrolysis -! 17 print info of "streamline topology" -! 18 print mesh data changes after remeshing -! 19 print material flow stress data read in from *.mat file -! if unit flag is on, print out flow stress after conversion -! 20 print information on table input -! 21 print out information regarding kinematic boundary conditions -! 22 print out information regarding dist loads, point loads, film -! and foundations -! 23 print out information about automatic domain decomposition -! 24 print out iteration information in SuperForm status report file -! 25 print out information for ablation -! 26 print out information for films - Table input -! 27 print out the tying forces -! 28 print out for CASI solver, convection, -! 29 DDM single file debug printout -! 30 print out cavity debug info -! 31 print out welding related info -! 32 prints categorized DDM memory usage -! 33 print out the cutting info regarding machining feature -! 34 print out the list of quantities which can be defined via a table -! and for each quantity the supported independent variables -! 35 print out detailed coupling region info -! 36 print out solver debug info level 1 (Least Detailed) -! 37 print out solver debug info level 1 (Medium Detailed) -! 38 print out solver debug info level 1 (Very Detailed) -! 39 print detailed memory allocation info -! 40 print out marc-adams debug info -! 41 output rezone mapping post file for debugging -! 42 output post file after calling oprofos() for debugging -! 43 debug printout for vcct -! 44 debug printout for progressive failure -! 45 print out automatically generated midside node coordinates (arecrd) -! 46 print out message about routine and location, where the ibort is raised (ibort_inc) -! 47 print out summary message of element variables on a -! group-basis after all the automatic changes have been -! made (em_ellibp) -! 48 Automatically generate check results based on max and min vals. -! These vals are stored in the checkr file, which is inserted -! into the *dat file by the generate_check_results script from /marc/tools -! 49 Automatically generate check results based on the real calculated values -! at the sppecified check result locations. -! These vals are stored in the checkr file, which is inserted -! into the *dat file by the update_check_results script from /marc/tools -! 50 generate a file containing the resistance or capacity matrix; -! this file can be used to compare results with a reference file -! 51 print out detailed information for segment-to-segment contact -! 52 print out detailed relative displacement information -! for uniaxial sliding contact -! 53 print out detailed sliding direction information for -! uniaxial sliding contact -! 54 print out detailed information for edges attached to a curve -! 55 print information related to viscoelasticity calculations -! 56 print out detailed information for element coloring for multithreading -! 57 print out extra overheads due to multi-threading. -! These overhead includes (i) time and (ii) memory. -! The memory report will be summed over all the children. -! -! -! 58 debug output for ELSTO usage -! -! idyn Control flag for dynamics. Input data. -! 1 = eigenvalue extraction and / or modal superposition -! 2 = Newmark Beta and Single Step Houbolt (ssh with idynme=1) -! 3 = Houbolt -! 4 = Central difference -! 5 = Newer central difference -! idynt Copy of idyn at begining of increment -! ielas Control flag for ELASTIC analysis. Input data. -! Set by user or automatically turned on by Fourier option. -! Implies that each load case is treated separately. -! In Adaptive meshing analysis , forces re-analysis until -! convergence obtained. -! Also seriously misused to indicate no convergence. -! = 1 elastic option with fourier analysis -! = 2 elastic option without fourier analysis -! =-1 no convergence in recycles or max # increments reached -! Set to 1 if ELASTIC or SUBSTRUC parameter cards are used, -! or if fourier option is used. -! Then set to 2 if not fourier analysis. -! ielcma Control flag for electromagnetic analysis. Input data. -! ielcma = 1 Harmonic formulation -! ielcma = 2 Transient formulation -! ielect Control flag for electrostatic option. Input data. -! iform Control flag indicating that contact will be performed. -! ifour Control flag for Fourier analysis. -! 0 = Odd and even terms. -! 1 = symmetric (cosine) terms -! 2 = antisymmetric (sine) terms. -! iharm Control flag to indicate that a harmonic analysis will -! be performed. May change between passes. -! ihcps Control flag for coupled thermal - stress analysis. -! iheat Control flag for heat transfer analysis. Input data. -! iheatt Permanent control flag for heat transfer analysis. -! Note in coupled analysis iheatt will remain as one, -! but iheat will be zero in stress pass. -! ihresp Control flag to indicate to perform a harmonic subincrement. -! ijoule Control flag for Joule heating. -! ilem Control flag to determin which vector is to be transformed. -! Control flag to see where one is: -! ilem = 1 - elem.f -! ilem = 2 - initst.f -! ilem = 3 - pressr.f -! ilem = 3 - fstif.f -! ilem = 4 - jflux.f -! ilem = 4 - strass.f -! ilem = 5 - mass.f -! ilem = 5 - osolty.f -! ilnmom Control flag for soil - pore pressure calculation. Input data. -! ilnmom = 0 - perform only pore pressure calculation. -! = 1 - couples pore pressure - displacement analysis -! iloren Control flag for DeLorenzi J-Integral evaluation. Input data. -! inc Increment number. -! incext Control flag indicating that currently working on a -! subincrement. -! Could be due to harmonics , damping component (bearing), -! stiffness component (bearing), auto therm creep or -! old viscoplaticity -! incsub Sub-increment number. -! ipass Control flag for which part of coupled analysis. -! ipass = -1 - reset to base values -! ipass = 0 - do nothing -! ipass = 1 - stress part -! ipass = 2 - heat transfer part -! iplres Flag indicating that either second matrix is stored. -! dynamic analysis - mass matrix -! heat transfer - specific heat matrix -! buckle - initial stress stiffness -! ipois Control flag indicating Poisson type analysis -! ipois = 1 for heat transfer -! = 1 for heat transfer part of coupled -! = 1 for bearing -! = 1 for electrostatic -! = 1 for magnetostatic -! ipoist Permanent copy of ipois. In coupled analysis , ipois = 0 -! in stress portion, yet ipoist will still =1. -! irpflo global flag for rigid plastic flow analysis -! = 1 eularian formulation -! = 2 regular formulation; rigid material present in the analysis - -! ismall control flag to indicate small displacement analysis. input data. -! ismall = 0 - large disp included. -! ismall = 1 - small displacement. -! the flag is changing between passes. -! ismalt permanent copy of ismall . in heat transfer portion of -! coupled analysis ismall =0 , but ismalt remains the same. -! isoil control flag indicating that soil / pore pressure -! calculation . input data. -! ispect control flag for response spectrum calculation. input data. -! ispnow control flag to indicate to perform a spectrum response -! calculation now. -! istore store stresses flag. -! istore = 0 in elem.f and if first pass of creep -! convergence checking in ogetst.f -! or harmonic analysis or thruc.f if not -! converged. -! iswep control flag for eigenvalue analysis. -! iswep=1 - go do extraction process -! ithcrp control flag for auto therm creep option. input data. -! itherm control flag for either temperature dependent material -! properties and/or thermal loads. -! iupblg control flag for follower force option. input data. -! iupdat control flag for update lagrange option for current element. -! jacflg control flag for lanczos iteration method. input data. -! jel control flag indicating that total load applied in -! increment, ignore previous solution. -! jel = 1 in increment 0 -! = 1 if elastic or fourier -! = 1 in subincrements with elastic and adaptive -! jparks control flag for j integral by parks method. input data. -! largst control flag for finite strain plasticity. input data. -! lfond control variable that indicates if doing elastic -! foundation or film calculation. influences whether -! this is volumetric or surface integration. -! loadup control flag that indicates that nonlinearity occurred -! during previous increment. -! loaduq control flag that indicates that nonlinearity occurred. -! lodcor control flag for switching on the residual load correction. -! notice in input stage lodcor=0 means no loadcor, -! after omarc lodcor=1 means no loadcor -! lovl control flag for determining which "overlay" is to -! be called from ellib. -! lovl = 1 omarc -! = 2 oaread -! = 3 opress -! = 4 oasemb -! = 5 osolty -! = 6 ogetst -! = 7 oscinc -! = 8 odynam -! = 9 opmesh -! = 10 omesh2 -! = 11 osetz -! = 12 oass -! = 13 oincdt -! = 14 oasmas -! = 15 ofluas -! = 16 ofluso -! = 17 oshtra -! = 18 ocass -! = 19 osoltc -! = 20 orezon -! = 21 otest -! = 22 oeigen -! lsub control variable to determine which part of element -! assembly function is being done. -! lsub = 1 - no longer used -! = 2 - beta* -! = 3 - cons* -! = 4 - ldef* -! = 5 - posw* -! = 6 - theta* -! = 7 - tmarx* -! = 8 - geom* -! magnet control flag for magnetostatic analysis. input data. -! ncycle cycle number. accumulated in osolty.f -! note first time through oasemb.f , ncycle = 0. -! newtnt control flag for permanent copy of newton. -! newton iteration type. input data. -! newton : = 1 full newton raphson -! 2 modified newton raphson -! 3 newton raphson with strain correct. -! 4 direct substitution -! 5 direct substitution followed by n.r. -! 6 direct substitution with line search -! 7 full newton raphson with secant initial stress -! 8 secant method -! 9 full newton raphson with line search -! noshr control flag for calculation interlaminar shears for -! elements 22,45, and 75. input data. -!ees -! -! jactch = 1 or 2 if elements are activated or deactivated -! = 3 if elements are adaptively remeshed or rezoned -! = 0 normally / reset to 0 when assembly is done -! ifricsh = 0 call to fricsh in otest not needed -! = 1 call to fricsh (nodal friction) in otest needed -! iremkin = 0 remove deactivated kinematic boundary conditions -! immediately - only in new input format (this is default) -! = 1 remove deactivated kinematic boundary conditions -! gradually - only in new input format -! iremfor = 0 remove force boundary conditions immediately - -! only in new input format (this is default) -! = 1 remove force boundary conditions gradually - -! only in new input format (this is default) -! ishearp set to 1 if shear panel elements are present in the model -! -! jspf = 0 not in spf loadcase -! > 0 in spf loadcase (jspf=1 during first increment) -! machining = 1 if the metal cutting feature is used, for memory allocation purpose -! = 0 (default) if no metal cutting feature required -! -! jlshell = 1 if there is a shell element in the mesh -! icompsol = 1 if there is a composite solid element in the mesh -! iupblgfo = 1 if follower force for point loads -! jcondir = 1 if contact priority option is used -! nstcrp = 0 (default) steady state creep flag (undocumented feature. -! if not 0, turns off special ncycle = 0 code in radial.f) -! nactive = number of active passes, if =1 then it's not a coupled analysis -! ipassref = reference ipass, if not in a multiphysics pass ipass=ipassref -! icheckmpc = value of mpc-check parameter option -! noline = set to 1 in osolty if no line seacrh should be done in ogetst -! icuring = set to 1 if the curing is included for the heat transfer analysis. -! ishrink = set to 1 if shrinkage strain is included for mechancial analysis. -! ioffsflg = 1 for small displacement beam/shell offsets -! = 2 for large displacement beam/shell offsets -! isetoff = 0 - do not apply beam/shell offsets -! = 1 - apply beam/shell offsets -! ioffsetm = min. value of offset flag -! iharmt = 1 global flag if a coupled analysis contains an harmonic pass -! inc_incdat = flag to record increment number of a new loadcase in incdat.f -! iautspc = flag for AutoSPC option -! ibrake = brake squeal in this increment -! icbush = set to 1 if cbush elements present in model -! istream_input = set to 1 for streaming input calling Marc as library -! iprsinp = set to 1 if pressure input, introduced so other variables -! such as h could be a function of pressure -! ivlsinp = set to 1 if velocity input, introduced so other variables -! such as h could be a function of velocity -! ipin_m = # of beam element with PIN flag -! jgnstr_glb = global control over pre or fast integrated composite shells -! imarc_return = Marc return flag for streaming input control -! iqvcimp = if non-zero, then the number of QVECT boundary conditions -! nqvceid = number of QVECT boundary conditions, where emisivity/absorbtion id entered -! istpnx = 1 if to stop at end of increment -! imicro1 = 1 if micro1 interface is used -! iaxisymm = set to 1 if axisymmetric analysis -! jbreakglue = set to 1 if breaking glued option is used -! iglstif = 1 if ddm and global stiffness matrix formed (sgi solver 6 or solver9) -! jfastasm = 1 do fast assembly using SuperForm code -! iwear = set to 1 if wear model, set to 2 if wear model and coordinates updated -! iwearcf = set to 1 to store nodal coefficient of friction for wear calculation -! imixmeth = set=1 then use nonlinear mixture material - allocate memory -! ielcmadyn = flag for magnetodynamics -! 0 - electromagnetics using newmark beta -! 1 - transient magnetics using backward euler -! idinout = flag to control if inside out elements should be deactivated -! igena_meth = 0 - generalized alpha parameters depend on whether or not contact -! is flagged (dynamic,7) -! 10 - generalized alpha parameters are optimized for a contact -! analysis (dynamic,8) -! 11 - generalized alpha parameters are optimized for an analysis -! without contact (dynamic,8) -! magf_meth = - Method to compute force in magnetostatic - structural -! = 1 - Virtual work method based on finite difference for the force computation -! = 2 - Maxwell stress tensor -! = 3 - Virtual work method based on local derivative for the force computation -! non_assumed = 1 no assumed strain formulation (forced) -! iredoboudry set to 1 if contact boundary needs to be recalculated -! ioffsz0 = 1 if composite are used with reference position.ne.0 -! icomplt = 1 global flag if a coupled analysis contains an complex pass -! mesh_dual = 1 two independent meshes are used in magnetodynamic/thermal/structural -! one for magnetodynamic and the other for the remaining passes -! iactrp = 1 in an analysis with global remeshing, include inactive -! rigid bodies on post file -! mgnewton = 1 Use full Newton Raphson iteration for magnetostatic pass -! -! iusedens > 0 if mass density is used in the analysis (dynamics, mass dependent loading) -! igsigd0 = 1 set varselem(igsigd) to zero in next oasemb -! iaem = 1 if marc is called from aem (0 - off - default) -! icosim = 1 if marc is used in co-simulation software (ADAMS-MARC) -! inodels = 1 nodal integration elements 239/240/241 present -! nlharm = 0 harmonic subincrements are linear -! = 1 harmonic subincrements are nonlinear -! iampini = 0 amplitude of previous harmonic subinc is initial estimate (default) -! = 1 zero amplitude is initial estimate -! iphasetr = 1 phase transformation material model is used -! -!*********************************************************************** -!$omp threadprivate(/marc_concom/) -!! diff --git a/src/MarcInclude/concom2017 b/src/MarcInclude/concom2017 deleted file mode 100644 index 08cc3b59b..000000000 --- a/src/MarcInclude/concom2017 +++ /dev/null @@ -1,424 +0,0 @@ -! common block definition file taken from respective MSC.Marc release and reformated to free format -!*********************************************************************** -! -! File: concom.cmn -! -! MSC.Marc include file -! -integer(pInt) & - iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,& - ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,& - ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,& - ipoist, irpflo, ismall, ismalt, isoil, ispect, ispnow, istore, iswep, ithcrp,& - itherm, iupblg, iupdat, jacflg, jel, jparks, largst, lfond, loadup, loaduq,& - lodcor, lovl, lsub, magnet, ncycle, newtnt, newton, noshr, linear, ivscpl,& - icrpim, iradrt, ipshft, itshr, iangin, iupmdr, iconjf, jincfl, jpermg, jhour,& - isolvr, jritz, jtable, jshell, jdoubl, jform, jcentr, imini, kautth, iautof,& - ibukty, iassum, icnstd, icnstt, kmakmas, imethvp, iradrte, iradrtp, iupdate, iupdatp,& - ncycnt, marmen , idynme, ihavca, ispf, kmini, imixex, largtt, kdoela, iautofg,& - ipshftp, idntrc, ipore, jtablm, jtablc, isnecma, itrnspo, imsdif, jtrnspo, mcnear,& - imech, imecht, ielcmat, ielectt, magnett, imsdift, noplas, jtabls, jactch, jtablth,& - kgmsto , jpzo, ifricsh, iremkin, iremfor, ishearp, jspf, machining, jlshell, icompsol,& - iupblgfo, jcondir, nstcrp, nactive, ipassref, nstspnt, ibeart, icheckmpc, noline, icuring,& - ishrink, ioffsflg, isetoff, ioffsetm,iharmt, inc_incdat, iautspc, ibrake, icbush, istream_input,& - iprsinp, ivlsinp, ifirst_time,ipin_m, jgnstr_glb, imarc_return,iqvcinp, nqvceid, istpnx, imicro1,& - iaxisymm, jbreakglue,iglstif, jfastasm,iwear, iwearcf, imixmeth, ielcmadyn, idinout, igena_meth,& - magf_meth, non_assumed, iredoboudry, ioffsz0,icomplt, mesh_dual, iactrp, mgnewton, iusedens,igsigd0,& - iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror -dimension :: ideva(60) -integer(pInt) num_concom -parameter(num_concom=249) -common/marc_concom/& - iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,& - ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,& - ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,& - ipoist, irpflo, ismall, ismalt, isoil, ispect, ispnow, istore, iswep, ithcrp,& - itherm, iupblg, iupdat, jacflg, jel, jparks, largst, lfond, loadup, loaduq,& - lodcor, lovl, lsub, magnet, ncycle, newtnt, newton, noshr, linear, ivscpl,& - icrpim, iradrt, ipshft, itshr, iangin, iupmdr, iconjf, jincfl, jpermg, jhour,& - isolvr, jritz, jtable, jshell, jdoubl, jform, jcentr, imini, kautth, iautof,& - ibukty, iassum, icnstd, icnstt, kmakmas, imethvp, iradrte, iradrtp, iupdate, iupdatp,& - ncycnt, marmen, idynme, ihavca, ispf, kmini, imixex, largtt, kdoela, iautofg,& - ipshftp, idntrc, ipore, jtablm, jtablc, isnecma, itrnspo, imsdif, jtrnspo, mcnear,& - imech, imecht, ielcmat, ielectt, magnett, imsdift, noplas, jtabls, jactch, jtablth,& - kgmsto , jpzo, ifricsh, iremkin, iremfor, ishearp, jspf, machining, jlshell, icompsol,& - iupblgfo, jcondir, nstcrp, nactive, ipassref, nstspnt, ibeart, icheckmpc, noline, icuring,& - ishrink, ioffsflg, isetoff, ioffsetm,iharmt, inc_incdat, iautspc, ibrake, icbush, istream_input,& - iprsinp, ivlsinp, ifirst_time,ipin_m, jgnstr_glb, imarc_return,iqvcinp, nqvceid, istpnx, imicro1,& - iaxisymm, jbreakglue,iglstif, jfastasm,iwear, iwearcf, imixmeth, ielcmadyn, idinout, igena_meth,& - magf_meth, non_assumed, iredoboudry, ioffsz0,icomplt, mesh_dual, iactrp, mgnewton, iusedens,igsigd0,& - iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror -! -! comments of variables: -! -! iacous Control flag for acoustic analysis. Input data. -! iacous=1 modal acoustic analysis. -! iacous=2 harmonic acoustic-structural analysis. -! iasmbl Control flag to indicate that operator matrix should be -! recalculated. -! iautth Control flag for AUTO THERM option. -! ibear Control flag for bearing analysis. Input data. -! icompl Control variable to indicate that a complex analysis is -! being performed. Either a Harmonic analysis with damping, -! or a harmonic electro-magnetic analysis. Input data. -! iconj Flag for EBE conjugate gradient solver (=solver 1, retired) -! Also used for VKI iterative solver. -! icreep Control flag for creep analysis. Input data. -! ideva(60) - debug print out flag -! 1 print element stiffness matrices, mass matrix -! 2 output matrices used in tying -! 3 force the solution of a nonpositive definite matrix -! 4 print info of connections to each node -! 5 info of gap convergence, internal heat generated, contact -! touching and separation -! 6 nodal value array during rezoning -! 7 tying info in CONRAD GAP option, fluid element numbers in -! CHANNEL option -! 8 output incremental displacements in local coord. system -! 9 latent heat output -! 10 stress-strain in local coord. system -! 11 additional info on interlaminar stress -! 12 output right hand side and solution vector -! 13 info of CPU resources used and memory available on NT -! 14 info of mesh adaption process, 2D outline information -! info of penetration checking for remeshing -! save .fem files after afmesh3d meshing -! 15 surface energy balance flag -! 16 print info regarding pyrolysis -! 17 print info of "streamline topology" -! 18 print mesh data changes after remeshing -! 19 print material flow stress data read in from *.mat file -! if unit flag is on, print out flow stress after conversion -! 20 print information on table input -! 21 print out information regarding kinematic boundary conditions -! 22 print out information regarding dist loads, point loads, film -! and foundations -! 23 print out information about automatic domain decomposition -! 24 print out iteration information in SuperForm status report file -! 25 print out information for ablation -! 26 print out information for films - Table input -! 27 print out the tying forces -! 28 print out for CASI solver, convection, -! 29 DDM single file debug printout -! 30 print out cavity debug info -! 31 print out welding related info -! 32 prints categorized DDM memory usage -! 33 print out the cutting info regarding machining feature -! 34 print out the list of quantities which can be defined via a table -! and for each quantity the supported independent variables -! 35 print out detailed coupling region info -! 36 print out solver debug info level 1 (Least Detailed) -! 37 print out solver debug info level 1 (Medium Detailed) -! 38 print out solver debug info level 1 (Very Detailed) -! 39 print detailed memory allocation info -! 40 print out marc-adams debug info -! 41 output rezone mapping post file for debugging -! 42 output post file after calling oprofos() for debugging -! 43 debug printout for vcct -! 44 debug printout for progressive failure -! 45 print out automatically generated midside node coordinates (arecrd) -! 46 print out message about routine and location, where the ibort is raised (ibort_inc) -! 47 print out summary message of element variables on a -! group-basis after all the automatic changes have been -! made (em_ellibp) -! 48 Automatically generate check results based on max and min vals. -! These vals are stored in the checkr file, which is inserted -! into the *dat file by the generate_check_results script from /marc/tools -! 49 Automatically generate check results based on the real calculated values -! at the sppecified check result locations. -! These vals are stored in the checkr file, which is inserted -! into the *dat file by the update_check_results script from /marc/tools -! 50 generate a file containing the resistance or capacity matrix; -! this file can be used to compare results with a reference file -! 51 print out detailed information for segment-to-segment contact -! 52 print out detailed relative displacement information -! for uniaxial sliding contact -! 53 print out detailed sliding direction information for -! uniaxial sliding contact -! 54 print out detailed information for edges attached to a curve -! 55 print information related to viscoelasticity calculations -! 56 print out detailed information for element coloring for multithreading -! 57 print out extra overheads due to multi-threading. -! These overhead includes (i) time and (ii) memory. -! The memory report will be summed over all the children. -! -! -! 58 debug output for ELSTO usage -! -! idyn Control flag for dynamics. Input data. -! 1 = eigenvalue extraction and / or modal superposition -! 2 = Newmark Beta and Single Step Houbolt (ssh with idynme=1) -! 3 = Houbolt -! 4 = Central difference -! 5 = Newer central difference -! idynt Copy of idyn at begining of increment -! ielas Control flag for ELASTIC analysis. Input data. -! Set by user or automatically turned on by Fourier option. -! Implies that each load case is treated separately. -! In Adaptive meshing analysis , forces re-analysis until -! convergence obtained. -! Also seriously misused to indicate no convergence. -! = 1 elastic option with fourier analysis -! = 2 elastic option without fourier analysis -! =-1 no convergence in recycles or max # increments reached -! Set to 1 if ELASTIC or SUBSTRUC parameter cards are used, -! or if fourier option is used. -! Then set to 2 if not fourier analysis. -! ielcma Control flag for electromagnetic analysis. Input data. -! ielcma = 1 Harmonic formulation -! ielcma = 2 Transient formulation -! ielect Control flag for electrostatic option. Input data. -! iform Control flag indicating that contact will be performed. -! ifour Control flag for Fourier analysis. -! 0 = Odd and even terms. -! 1 = symmetric (cosine) terms -! 2 = antisymmetric (sine) terms. -! iharm Control flag to indicate that a harmonic analysis will -! be performed. May change between passes. -! ihcps Control flag for coupled thermal - stress analysis. -! iheat Control flag for heat transfer analysis. Input data. -! iheatt Permanent control flag for heat transfer analysis. -! Note in coupled analysis iheatt will remain as one, -! but iheat will be zero in stress pass. -! ihresp Control flag to indicate to perform a harmonic subincrement. -! ijoule Control flag for Joule heating. -! ilem Control flag to determin which vector is to be transformed. -! Control flag to see where one is: -! ilem = 1 - elem.f -! ilem = 2 - initst.f -! ilem = 3 - pressr.f -! ilem = 3 - fstif.f -! ilem = 4 - jflux.f -! ilem = 4 - strass.f -! ilem = 5 - mass.f -! ilem = 5 - osolty.f -! ilnmom Control flag for soil - pore pressure calculation. Input data. -! ilnmom = 0 - perform only pore pressure calculation. -! = 1 - couples pore pressure - displacement analysis -! iloren Control flag for DeLorenzi J-Integral evaluation. Input data. -! inc Increment number. -! incext Control flag indicating that currently working on a -! subincrement. -! Could be due to harmonics , damping component (bearing), -! stiffness component (bearing), auto therm creep or -! old viscoplaticity -! incsub Sub-increment number. -! ipass Control flag for which part of coupled analysis. -! ipass = -1 - reset to base values -! ipass = 0 - do nothing -! ipass = 1 - stress part -! ipass = 2 - heat transfer part -! iplres Flag indicating that either second matrix is stored. -! dynamic analysis - mass matrix -! heat transfer - specific heat matrix -! buckle - initial stress stiffness -! ipois Control flag indicating Poisson type analysis -! ipois = 1 for heat transfer -! = 1 for heat transfer part of coupled -! = 1 for bearing -! = 1 for electrostatic -! = 1 for magnetostatic -! ipoist Permanent copy of ipois. In coupled analysis , ipois = 0 -! in stress portion, yet ipoist will still =1. -! irpflo global flag for rigid plastic flow analysis -! = 1 eularian formulation -! = 2 regular formulation; rigid material present in the analysis - -! ismall control flag to indicate small displacement analysis. input data. -! ismall = 0 - large disp included. -! ismall = 1 - small displacement. -! the flag is changing between passes. -! ismalt permanent copy of ismall . in heat transfer portion of -! coupled analysis ismall =0 , but ismalt remains the same. -! isoil control flag indicating that soil / pore pressure -! calculation . input data. -! ispect control flag for response spectrum calculation. input data. -! ispnow control flag to indicate to perform a spectrum response -! calculation now. -! istore store stresses flag. -! istore = 0 in elem.f and if first pass of creep -! convergence checking in ogetst.f -! or harmonic analysis or thruc.f if not -! converged. -! iswep control flag for eigenvalue analysis. -! iswep=1 - go do extraction process -! ithcrp control flag for auto therm creep option. input data. -! itherm control flag for either temperature dependent material -! properties and/or thermal loads. -! iupblg control flag for follower force option. input data. -! iupdat control flag for update lagrange option for current element. -! jacflg control flag for lanczos iteration method. input data. -! jel control flag indicating that total load applied in -! increment, ignore previous solution. -! jel = 1 in increment 0 -! = 1 if elastic or fourier -! = 1 in subincrements with elastic and adaptive -! jparks control flag for j integral by parks method. input data. -! largst control flag for finite strain plasticity. input data. -! lfond control variable that indicates if doing elastic -! foundation or film calculation. influences whether -! this is volumetric or surface integration. -! loadup control flag that indicates that nonlinearity occurred -! during previous increment. -! loaduq control flag that indicates that nonlinearity occurred. -! lodcor control flag for switching on the residual load correction. -! notice in input stage lodcor=0 means no loadcor, -! after omarc lodcor=1 means no loadcor -! lovl control flag for determining which "overlay" is to -! be called from ellib. -! lovl = 1 omarc -! = 2 oaread -! = 3 opress -! = 4 oasemb -! = 5 osolty -! = 6 ogetst -! = 7 oscinc -! = 8 odynam -! = 9 opmesh -! = 10 omesh2 -! = 11 osetz -! = 12 oass -! = 13 oincdt -! = 14 oasmas -! = 15 ofluas -! = 16 ofluso -! = 17 oshtra -! = 18 ocass -! = 19 osoltc -! = 20 orezon -! = 21 otest -! = 22 oeigen -! lsub control variable to determine which part of element -! assembly function is being done. -! lsub = 1 - no longer used -! = 2 - beta* -! = 3 - cons* -! = 4 - ldef* -! = 5 - posw* -! = 6 - theta* -! = 7 - tmarx* -! = 8 - geom* -! magnet control flag for magnetostatic analysis. input data. -! ncycle cycle number. accumulated in osolty.f -! note first time through oasemb.f , ncycle = 0. -! newtnt control flag for permanent copy of newton. -! newton iteration type. input data. -! newton : = 1 full newton raphson -! 2 modified newton raphson -! 3 newton raphson with strain correct. -! 4 direct substitution -! 5 direct substitution followed by n.r. -! 6 direct substitution with line search -! 7 full newton raphson with secant initial stress -! 8 secant method -! 9 full newton raphson with line search -! noshr control flag for calculation interlaminar shears for -! elements 22,45, and 75. input data. -!ees -! -! jactch = 1 or 2 if elements are activated or deactivated -! = 3 if elements are adaptively remeshed or rezoned -! = 0 normally / reset to 0 when assembly is done -! ifricsh = 0 call to fricsh in otest not needed -! = 1 call to fricsh (nodal friction) in otest needed -! iremkin = 0 remove deactivated kinematic boundary conditions -! immediately - only in new input format (this is default) -! = 1 remove deactivated kinematic boundary conditions -! gradually - only in new input format -! iremfor = 0 remove force boundary conditions immediately - -! only in new input format (this is default) -! = 1 remove force boundary conditions gradually - -! only in new input format (this is default) -! ishearp set to 1 if shear panel elements are present in the model -! -! jspf = 0 not in spf loadcase -! > 0 in spf loadcase (jspf=1 during first increment) -! machining = 1 if the metal cutting feature is used, for memory allocation purpose -! = 0 (default) if no metal cutting feature required -! -! jlshell = 1 if there is a shell element in the mesh -! icompsol = 1 if there is a composite solid element in the mesh -! iupblgfo = 1 if follower force for point loads -! jcondir = 1 if contact priority option is used -! nstcrp = 0 (default) steady state creep flag (undocumented feature. -! if not 0, turns off special ncycle = 0 code in radial.f) -! nactive = number of active passes, if =1 then it's not a coupled analysis -! ipassref = reference ipass, if not in a multiphysics pass ipass=ipassref -! icheckmpc = value of mpc-check parameter option -! noline = set to 1 in osolty if no line seacrh should be done in ogetst -! icuring = set to 1 if the curing is included for the heat transfer analysis. -! ishrink = set to 1 if shrinkage strain is included for mechancial analysis. -! ioffsflg = 1 for small displacement beam/shell offsets -! = 2 for large displacement beam/shell offsets -! isetoff = 0 - do not apply beam/shell offsets -! = 1 - apply beam/shell offsets -! ioffsetm = min. value of offset flag -! iharmt = 1 global flag if a coupled analysis contains an harmonic pass -! inc_incdat = flag to record increment number of a new loadcase in incdat.f -! iautspc = flag for AutoSPC option -! ibrake = brake squeal in this increment -! icbush = set to 1 if cbush elements present in model -! istream_input = set to 1 for streaming input calling Marc as library -! iprsinp = set to 1 if pressure input, introduced so other variables -! such as h could be a function of pressure -! ivlsinp = set to 1 if velocity input, introduced so other variables -! such as h could be a function of velocity -! ipin_m = # of beam element with PIN flag -! jgnstr_glb = global control over pre or fast integrated composite shells -! imarc_return = Marc return flag for streaming input control -! iqvcimp = if non-zero, then the number of QVECT boundary conditions -! nqvceid = number of QVECT boundary conditions, where emisivity/absorbtion id entered -! istpnx = 1 if to stop at end of increment -! imicro1 = 1 if micro1 interface is used -! iaxisymm = set to 1 if axisymmetric analysis -! jbreakglue = set to 1 if breaking glued option is used -! iglstif = 1 if ddm and global stiffness matrix formed (sgi solver 6 or solver9) -! jfastasm = 1 do fast assembly using SuperForm code -! iwear = set to 1 if wear model, set to 2 if wear model and coordinates updated -! iwearcf = set to 1 to store nodal coefficient of friction for wear calculation -! imixmeth = set=1 then use nonlinear mixture material - allocate memory -! ielcmadyn = flag for magnetodynamics -! 0 - electromagnetics using newmark beta -! 1 - transient magnetics using backward euler -! idinout = flag to control if inside out elements should be deactivated -! igena_meth = 0 - generalized alpha parameters depend on whether or not contact -! is flagged (dynamic,7) -! 10 - generalized alpha parameters are optimized for a contact -! analysis (dynamic,8) -! 11 - generalized alpha parameters are optimized for an analysis -! without contact (dynamic,8) -! magf_meth = - Method to compute force in magnetostatic - structural -! = 1 - Virtual work method based on finite difference for the force computation -! = 2 - Maxwell stress tensor -! = 3 - Virtual work method based on local derivative for the force computation -! non_assumed = 1 no assumed strain formulation (forced) -! iredoboudry set to 1 if contact boundary needs to be recalculated -! ioffsz0 = 1 if composite are used with reference position.ne.0 -! icomplt = 1 global flag if a coupled analysis contains an complex pass -! mesh_dual = 1 two independent meshes are used in magnetodynamic/thermal/structural -! one for magnetodynamic and the other for the remaining passes -! iactrp = 1 in an analysis with global remeshing, include inactive -! rigid bodies on post file -! mgnewton = 1 Use full Newton Raphson iteration for magnetostatic pass -! -! iusedens > 0 if mass density is used in the analysis (dynamics, mass dependent loading) -! igsigd0 = 1 set varselem(igsigd) to zero in next oasemb -! iaem = 1 if marc is called from aem (0 - off - default) -! icosim = 1 if marc is used in co-simulation software (ADAMS-MARC) -! inodels = 1 nodal integration elements 239/240/241 present -! nlharm = 0 harmonic subincrements are linear -! = 1 harmonic subincrements are nonlinear -! iampini = 0 amplitude of previous harmonic subinc is initial estimate (default) -! = 1 zero amplitude is initial estimate -! iphasetr = 1 phase transformation material model is used -! iforminp flag indicating that contact is switched on via the CONTACT -! option in the input file (as opposed to the case that contact -! is switched on internally due to cyclic symmetry or model -! section creation) -! ispecerror = a+10*b (only for spectrum response analysis with missing mass option) -! a=0 or a=1 (modal shape with non-zero shift) -! b=0 or b=1 (recover with new assembly of stiffness matrix) -! -!*********************************************************************** -!$omp threadprivate(/marc_concom/) -!! diff --git a/src/MarcInclude/creeps2016 b/src/MarcInclude/creeps2016 deleted file mode 100644 index 85c67492d..000000000 --- a/src/MarcInclude/creeps2016 +++ /dev/null @@ -1,66 +0,0 @@ -! common block definition file taken from respective MSC.Marc release and reformated to free format -!*********************************************************************** -! -! File: creeps.cmn -! -! MSC.Marc include file -! -real(pReal) cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b -integer(pInt) icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,& - icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa -real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst -real(pReal) fraction_donn,timinc_ol2 -! -integer(pInt) num_creepsr,num_creepsi,num_creeps2r -parameter(num_creepsr=7) -parameter(num_creepsi=17) -parameter(num_creeps2r=6) -common/marc_creeps/cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b,icfte,icfst,& - icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa -common/marc_creeps2/time_beg_lcase,time_beg_inc,fractol,time_beg_pst,fraction_donn,timinc_ol2 -! -! cptim Total time at begining of increment. -! timinc Incremental time for this step. -! icfte Local copy number of slopes of creep strain rate function -! versus temperature. Is -1 if exponent law used. -! icfst Local copy number of slopes of creep strain rate function -! versus equivalent stress. Is -1 if exponent law used. -! icfeq Local copy number of slopes of creep strain rate function -! versus equivalent strain. Is -1 if exponent law used. -! icftm Local copy number of slopes of creep strain rate function -! versus time. Is -1 if exponent law used. -! icetem Element number that needs to be checked for creep convergence -! or, if negative, the number of elements that need to -! be checked. In the latter case the elements to check -! are stored in ielcp. -! mcreep Maximum nuber of iterations for explicit creep. -! jcreep Counter of number of iterations for explicit creep -! procedure. jcreep must be .le. mcreep -! icpa Pointer to constant in creep strain rate expression. -! icftmp Pointer to temperature dependent creep strain rate data. -! icfstr Pointer to equivalent stress dependent creep strain rate data. -! icfqcp Pointer to equivalent creep strain dependent creep strain -! rate data. -! icfcpm Pointer to equivalent creep strain rate dependent -! creep strain rate data. -! icrppr Permanent copy of icreep -! icrcha Control flag for creep convergence checking , if set to -! 1 then testing on absolute change in stress and creep -! strain, not relative testing. Input data. -! icpb Pointer to storage of material id cross reference numbers. -! iicpmt -! iicpa Pointer to constant in creep strain rate expression -! -! time_beg_lcase time at the beginning of the current load case -! time_beg_inc time at the beginning of the current increment -! fractol fraction of loadcase or increment time when we -! consider it to be finished -! time_beg_pst time corresponding to first increment to be -! read in from thermal post file for auto step -! -! timinc_old Time step of the previous increment -! -!*********************************************************************** -!!$omp threadprivate(/marc_creeps/) -!!$omp threadprivate(/marc_creeps2/) -!! diff --git a/src/MarcInclude/creeps2017 b/src/MarcInclude/creeps2017 deleted file mode 100644 index 85c67492d..000000000 --- a/src/MarcInclude/creeps2017 +++ /dev/null @@ -1,66 +0,0 @@ -! common block definition file taken from respective MSC.Marc release and reformated to free format -!*********************************************************************** -! -! File: creeps.cmn -! -! MSC.Marc include file -! -real(pReal) cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b -integer(pInt) icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,& - icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa -real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst -real(pReal) fraction_donn,timinc_ol2 -! -integer(pInt) num_creepsr,num_creepsi,num_creeps2r -parameter(num_creepsr=7) -parameter(num_creepsi=17) -parameter(num_creeps2r=6) -common/marc_creeps/cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b,icfte,icfst,& - icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa -common/marc_creeps2/time_beg_lcase,time_beg_inc,fractol,time_beg_pst,fraction_donn,timinc_ol2 -! -! cptim Total time at begining of increment. -! timinc Incremental time for this step. -! icfte Local copy number of slopes of creep strain rate function -! versus temperature. Is -1 if exponent law used. -! icfst Local copy number of slopes of creep strain rate function -! versus equivalent stress. Is -1 if exponent law used. -! icfeq Local copy number of slopes of creep strain rate function -! versus equivalent strain. Is -1 if exponent law used. -! icftm Local copy number of slopes of creep strain rate function -! versus time. Is -1 if exponent law used. -! icetem Element number that needs to be checked for creep convergence -! or, if negative, the number of elements that need to -! be checked. In the latter case the elements to check -! are stored in ielcp. -! mcreep Maximum nuber of iterations for explicit creep. -! jcreep Counter of number of iterations for explicit creep -! procedure. jcreep must be .le. mcreep -! icpa Pointer to constant in creep strain rate expression. -! icftmp Pointer to temperature dependent creep strain rate data. -! icfstr Pointer to equivalent stress dependent creep strain rate data. -! icfqcp Pointer to equivalent creep strain dependent creep strain -! rate data. -! icfcpm Pointer to equivalent creep strain rate dependent -! creep strain rate data. -! icrppr Permanent copy of icreep -! icrcha Control flag for creep convergence checking , if set to -! 1 then testing on absolute change in stress and creep -! strain, not relative testing. Input data. -! icpb Pointer to storage of material id cross reference numbers. -! iicpmt -! iicpa Pointer to constant in creep strain rate expression -! -! time_beg_lcase time at the beginning of the current load case -! time_beg_inc time at the beginning of the current increment -! fractol fraction of loadcase or increment time when we -! consider it to be finished -! time_beg_pst time corresponding to first increment to be -! read in from thermal post file for auto step -! -! timinc_old Time step of the previous increment -! -!*********************************************************************** -!!$omp threadprivate(/marc_creeps/) -!!$omp threadprivate(/marc_creeps2/) -!! diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 1158ddc07..6428e19d1 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1107,14 +1107,12 @@ subroutine constitutive_results integer :: p character(len=256) :: group - - call HDF5_closeGroup(results_addGroup('current/constitutive')) do p=1,size(config_name_phase) - group = trim('current/constitutive')//'/'//trim(config_name_phase(p)) + group = trim('current/constituent')//'/'//trim(config_name_phase(p)) call HDF5_closeGroup(results_addGroup(group)) - group = trim(group)//'/'//'plastic' + group = trim(group)//'/plastic' call HDF5_closeGroup(results_addGroup(group)) select case(material_phase_plasticity_type(p)) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 42daa21bb..2d10809cc 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1116,7 +1116,7 @@ end function crystallite_postResults !-------------------------------------------------------------------------------------------------- -!> @brief writes constitutive results to HDF5 output file +!> @brief writes crystallite results to HDF5 output file !-------------------------------------------------------------------------------------------------- subroutine crystallite_results #if defined(PETSc) || defined(DAMASK_HDF5) @@ -1134,12 +1134,12 @@ subroutine crystallite_results real(pReal), allocatable, dimension(:,:,:) :: selected_tensors type(rotation), allocatable, dimension(:) :: selected_rotations character(len=256) :: group,lattice_label - - call HDF5_closeGroup(results_addGroup('current/constituent')) do p=1,size(config_name_phase) - group = trim('current/constituent')//'/'//trim(config_name_phase(p)) - call HDF5_closeGroup(results_addGroup(group)) + group = trim('current/constituent')//'/'//trim(config_name_phase(p))//'/generic' + + call HDF5_closeGroup(results_addGroup(group)) + do o = 1, size(output_constituent(p)%label) select case (output_constituent(p)%label(o)) case('f') @@ -1201,64 +1201,62 @@ subroutine crystallite_results !-------------------------------------------------------------------------------------------------- !> @brief select tensors for output !-------------------------------------------------------------------------------------------------- - function select_tensors(dataset,instance) + function select_tensors(dataset,instance) use material, only: & homogenization_maxNgrains, & material_phaseAt - integer, intent(in) :: instance - real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset - real(pReal), allocatable, dimension(:,:,:) :: select_tensors - integer :: e,i,c,j - - allocate(select_tensors(3,3,count(material_phaseAt==instance)*homogenization_maxNgrains)) + integer, intent(in) :: instance + real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset + real(pReal), allocatable, dimension(:,:,:) :: select_tensors + integer :: e,i,c,j + + allocate(select_tensors(3,3,count(material_phaseAt==instance)*homogenization_maxNgrains)) - j=1 - do e = 1, size(material_phaseAt,2) - do i = 1, homogenization_maxNgrains !ToDo: this needs to be changed for varying Ngrains - do c = 1, size(material_phaseAt,1) - if (material_phaseAt(c,e) == instance) then - select_tensors(1:3,1:3,j) = dataset(1:3,1:3,c,i,e) + j=0 + do e = 1, size(material_phaseAt,2) + do i = 1, homogenization_maxNgrains !ToDo: this needs to be changed for varying Ngrains + do c = 1, size(material_phaseAt,1) + if (material_phaseAt(c,e) == instance) then j = j + 1 - endif - enddo + select_tensors(1:3,1:3,j) = dataset(1:3,1:3,c,i,e) + endif + enddo + enddo enddo - enddo - - end function select_tensors + end function select_tensors !-------------------------------------------------------------------------------------------------- !> @brief select rotations for output !-------------------------------------------------------------------------------------------------- - function select_rotations(dataset,instance) + function select_rotations(dataset,instance) use material, only: & homogenization_maxNgrains, & material_phaseAt - integer, intent(in) :: instance - type(rotation), dimension(:,:,:), intent(in) :: dataset - type(rotation), allocatable, dimension(:) :: select_rotations - integer :: e,i,c,j - - allocate(select_rotations(count(material_phaseAt==instance)*homogenization_maxNgrains)) + integer, intent(in) :: instance + type(rotation), dimension(:,:,:), intent(in) :: dataset + type(rotation), allocatable, dimension(:) :: select_rotations + integer :: e,i,c,j + + allocate(select_rotations(count(material_phaseAt==instance)*homogenization_maxNgrains)) - j=1 - do e = 1, size(material_phaseAt,2) - do i = 1, homogenization_maxNgrains !ToDo: this needs to be changed for varying Ngrains - do c = 1, size(material_phaseAt,1) - if (material_phaseAt(c,e) == instance) then - select_rotations(j) = dataset(c,i,e) + j=0 + do e = 1, size(material_phaseAt,2) + do i = 1, homogenization_maxNgrains !ToDo: this needs to be changed for varying Ngrains + do c = 1, size(material_phaseAt,1) + if (material_phaseAt(c,e) == instance) then j = j + 1 - endif - enddo - enddo - enddo + select_rotations(j) = dataset(c,i,e) + endif + enddo + enddo + enddo - end function select_rotations #endif diff --git a/src/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 similarity index 99% rename from src/DAMASK_grid.f90 rename to src/grid/DAMASK_grid.f90 index 29b505d14..f2f52bb2f 100644 --- a/src/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -358,6 +358,11 @@ program DAMASK_spectral enddo close(fileUnit) + call results_openJobFile + call results_addAttribute('grid',grid,'mapping') + call results_addAttribute('size',geomSize,'mapping') + call results_closeJobFile + !-------------------------------------------------------------------------------------------------- ! doing initialization depending on active solvers call Utilities_init() diff --git a/src/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 similarity index 100% rename from src/grid_damage_spectral.f90 rename to src/grid/grid_damage_spectral.f90 diff --git a/src/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 similarity index 100% rename from src/grid_mech_FEM.f90 rename to src/grid/grid_mech_FEM.f90 diff --git a/src/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 similarity index 100% rename from src/grid_mech_spectral_basic.f90 rename to src/grid/grid_mech_spectral_basic.f90 diff --git a/src/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 similarity index 100% rename from src/grid_mech_spectral_polarisation.f90 rename to src/grid/grid_mech_spectral_polarisation.f90 diff --git a/src/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 similarity index 100% rename from src/grid_thermal_spectral.f90 rename to src/grid/grid_thermal_spectral.f90 diff --git a/src/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 similarity index 100% rename from src/spectral_utilities.f90 rename to src/grid/spectral_utilities.f90 diff --git a/src/lattice.f90 b/src/lattice.f90 index d11932c29..1a7508984 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -7,1288 +7,1278 @@ ! and cleavage as well as interaction among the various systems !-------------------------------------------------------------------------------------------------- module lattice - use prec, only: & - pReal - use future - - implicit none - private - + use prec, only: & + pReal + use future + + implicit none + private + ! BEGIN DEPRECATED - integer, parameter, public :: & - LATTICE_maxNcleavageFamily = 3 !< max # of transformation system families over lattice structures - - integer, allocatable, dimension(:,:), protected, public :: & - lattice_NcleavageSystem !< total # of transformation systems in each family - - real(pReal), allocatable, dimension(:,:,:,:,:), protected, public :: & - lattice_Scleavage !< Schmid matrices for cleavage systems + integer, parameter, public :: & + LATTICE_maxNcleavageFamily = 3 !< max # of transformation system families over lattice structures + + integer, allocatable, dimension(:,:), protected, public :: & + lattice_NcleavageSystem !< total # of transformation systems in each family + + real(pReal), allocatable, dimension(:,:,:,:,:), protected, public :: & + lattice_Scleavage !< Schmid matrices for cleavage systems ! END DEPRECATED !-------------------------------------------------------------------------------------------------- ! face centered cubic - integer, dimension(2), parameter, private :: & - LATTICE_FCC_NSLIPSYSTEM = [12, 6] !< # of slip systems per family for fcc - - integer, dimension(1), parameter, private :: & - LATTICE_FCC_NTWINSYSTEM = [12] !< # of twin systems per family for fcc - - integer, dimension(1), parameter, private :: & - LATTICE_FCC_NTRANSSYSTEM = [12] !< # of transformation systems per family for fcc - - integer, dimension(2), parameter, private :: & - LATTICE_FCC_NCLEAVAGESYSTEM = [3, 4] !< # of cleavage systems per family for fcc - - integer, parameter, private :: & - LATTICE_FCC_NSLIP = sum(LATTICE_FCC_NSLIPSYSTEM), & !< total # of slip systems for fcc - LATTICE_FCC_NTWIN = sum(LATTICE_FCC_NTWINSYSTEM), & !< total # of twin systems for fcc - LATTICE_FCC_NTRANS = sum(LATTICE_FCC_NTRANSSYSTEM), & !< total # of transformation systems for fcc - LATTICE_FCC_NCLEAVAGE = sum(LATTICE_FCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for fcc - - real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter, private :: & - LATTICE_FCC_SYSTEMSLIP = reshape(real([& - ! Slip direction Plane normal ! SCHMID-BOAS notation - 0, 1,-1, 1, 1, 1, & ! B2 - -1, 0, 1, 1, 1, 1, & ! B4 - 1,-1, 0, 1, 1, 1, & ! B5 - 0,-1,-1, -1,-1, 1, & ! C1 - 1, 0, 1, -1,-1, 1, & ! C3 - -1, 1, 0, -1,-1, 1, & ! C5 - 0,-1, 1, 1,-1,-1, & ! A2 - -1, 0,-1, 1,-1,-1, & ! A3 - 1, 1, 0, 1,-1,-1, & ! A6 - 0, 1, 1, -1, 1,-1, & ! D1 - 1, 0,-1, -1, 1,-1, & ! D4 - -1,-1, 0, -1, 1,-1, & ! D6 - ! Slip system <110>{110} - 1, 1, 0, 1,-1, 0, & - 1,-1, 0, 1, 1, 0, & - 1, 0, 1, 1, 0,-1, & - 1, 0,-1, 1, 0, 1, & - 0, 1, 1, 0, 1,-1, & - 0, 1,-1, 0, 1, 1 & - ],pReal),shape(LATTICE_FCC_SYSTEMSLIP)) !< Slip system <110>{111} directions. Sorted according to Eisenlohr & Hantcherli - - character(len=*), dimension(2), parameter, private :: LATTICE_FCC_SLIPFAMILY_NAME = & - ['<0 1 -1>{1 1 1}', & - '<0 1 -1>{0 1 1}'] - - real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter, private :: & - LATTICE_FCC_SYSTEMTWIN = reshape(real( [& - -2, 1, 1, 1, 1, 1, & - 1,-2, 1, 1, 1, 1, & - 1, 1,-2, 1, 1, 1, & - 2,-1, 1, -1,-1, 1, & - -1, 2, 1, -1,-1, 1, & - -1,-1,-2, -1,-1, 1, & - -2,-1,-1, 1,-1,-1, & - 1, 2,-1, 1,-1,-1, & - 1,-1, 2, 1,-1,-1, & - 2, 1,-1, -1, 1,-1, & - -1,-2,-1, -1, 1,-1, & - -1, 1, 2, -1, 1,-1 & - ],pReal),shape(LATTICE_FCC_SYSTEMTWIN)) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli - - character(len=*), dimension(1), parameter, private :: LATTICE_FCC_TWINFAMILY_NAME = & - ['<-2 1 1>{1 1 1}'] - - - integer, dimension(2,LATTICE_FCC_NTWIN), parameter, public :: & - LATTICE_FCC_TWINNUCLEATIONSLIPPAIR = reshape( [& - 2,3, & - 1,3, & - 1,2, & - 5,6, & - 4,6, & - 4,5, & - 8,9, & - 7,9, & - 7,8, & - 11,12, & - 10,12, & - 10,11 & - ],shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR)) - - real(pReal), dimension(3+3,LATTICE_FCC_NCLEAVAGE), parameter, private :: & - LATTICE_FCC_SYSTEMCLEAVAGE = reshape(real([& - ! Cleavage direction Plane normal - 0, 1, 0, 1, 0, 0, & - 0, 0, 1, 0, 1, 0, & - 1, 0, 0, 0, 0, 1, & - 0, 1,-1, 1, 1, 1, & - 0,-1,-1, -1,-1, 1, & - -1, 0,-1, 1,-1,-1, & - 0, 1, 1, -1, 1,-1 & - ],pReal),shape(LATTICE_FCC_SYSTEMCLEAVAGE)) - + integer, dimension(2), parameter, private :: & + LATTICE_FCC_NSLIPSYSTEM = [12, 6] !< # of slip systems per family for fcc + + integer, dimension(1), parameter, private :: & + LATTICE_FCC_NTWINSYSTEM = [12] !< # of twin systems per family for fcc + + integer, dimension(1), parameter, private :: & + LATTICE_FCC_NTRANSSYSTEM = [12] !< # of transformation systems per family for fcc + + integer, dimension(2), parameter, private :: & + LATTICE_FCC_NCLEAVAGESYSTEM = [3, 4] !< # of cleavage systems per family for fcc + + integer, parameter, private :: & + LATTICE_FCC_NSLIP = sum(LATTICE_FCC_NSLIPSYSTEM), & !< total # of slip systems for fcc + LATTICE_FCC_NTWIN = sum(LATTICE_FCC_NTWINSYSTEM), & !< total # of twin systems for fcc + LATTICE_FCC_NTRANS = sum(LATTICE_FCC_NTRANSSYSTEM), & !< total # of transformation systems for fcc + LATTICE_FCC_NCLEAVAGE = sum(LATTICE_FCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for fcc + + real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter, private :: & + LATTICE_FCC_SYSTEMSLIP = reshape(real([& + ! Slip direction Plane normal ! SCHMID-BOAS notation + 0, 1,-1, 1, 1, 1, & ! B2 + -1, 0, 1, 1, 1, 1, & ! B4 + 1,-1, 0, 1, 1, 1, & ! B5 + 0,-1,-1, -1,-1, 1, & ! C1 + 1, 0, 1, -1,-1, 1, & ! C3 + -1, 1, 0, -1,-1, 1, & ! C5 + 0,-1, 1, 1,-1,-1, & ! A2 + -1, 0,-1, 1,-1,-1, & ! A3 + 1, 1, 0, 1,-1,-1, & ! A6 + 0, 1, 1, -1, 1,-1, & ! D1 + 1, 0,-1, -1, 1,-1, & ! D4 + -1,-1, 0, -1, 1,-1, & ! D6 + ! Slip system <110>{110} + 1, 1, 0, 1,-1, 0, & + 1,-1, 0, 1, 1, 0, & + 1, 0, 1, 1, 0,-1, & + 1, 0,-1, 1, 0, 1, & + 0, 1, 1, 0, 1,-1, & + 0, 1,-1, 0, 1, 1 & + ],pReal),shape(LATTICE_FCC_SYSTEMSLIP)) !< Slip system <110>{111} directions. Sorted according to Eisenlohr & Hantcherli + + character(len=*), dimension(2), parameter, private :: LATTICE_FCC_SLIPFAMILY_NAME = & + ['<0 1 -1>{1 1 1}', & + '<0 1 -1>{0 1 1}'] + + real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter, private :: & + LATTICE_FCC_SYSTEMTWIN = reshape(real( [& + -2, 1, 1, 1, 1, 1, & + 1,-2, 1, 1, 1, 1, & + 1, 1,-2, 1, 1, 1, & + 2,-1, 1, -1,-1, 1, & + -1, 2, 1, -1,-1, 1, & + -1,-1,-2, -1,-1, 1, & + -2,-1,-1, 1,-1,-1, & + 1, 2,-1, 1,-1,-1, & + 1,-1, 2, 1,-1,-1, & + 2, 1,-1, -1, 1,-1, & + -1,-2,-1, -1, 1,-1, & + -1, 1, 2, -1, 1,-1 & + ],pReal),shape(LATTICE_FCC_SYSTEMTWIN)) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli + + character(len=*), dimension(1), parameter, private :: LATTICE_FCC_TWINFAMILY_NAME = & + ['<-2 1 1>{1 1 1}'] + + + integer, dimension(2,LATTICE_FCC_NTWIN), parameter, public :: & + LATTICE_FCC_TWINNUCLEATIONSLIPPAIR = reshape( [& + 2,3, & + 1,3, & + 1,2, & + 5,6, & + 4,6, & + 4,5, & + 8,9, & + 7,9, & + 7,8, & + 11,12, & + 10,12, & + 10,11 & + ],shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR)) + + real(pReal), dimension(3+3,LATTICE_FCC_NCLEAVAGE), parameter, private :: & + LATTICE_FCC_SYSTEMCLEAVAGE = reshape(real([& + ! Cleavage direction Plane normal + 0, 1, 0, 1, 0, 0, & + 0, 0, 1, 0, 1, 0, & + 1, 0, 0, 0, 0, 1, & + 0, 1,-1, 1, 1, 1, & + 0,-1,-1, -1,-1, 1, & + -1, 0,-1, 1,-1,-1, & + 0, 1, 1, -1, 1,-1 & + ],pReal),shape(LATTICE_FCC_SYSTEMCLEAVAGE)) + !-------------------------------------------------------------------------------------------------- ! body centered cubic - integer, dimension(2), parameter, private :: & - LATTICE_BCC_NSLIPSYSTEM = [12, 12] !< # of slip systems per family for bcc - - integer, dimension(1), parameter, private :: & - LATTICE_BCC_NTWINSYSTEM = [12] !< # of twin systems per family for bcc - - integer, dimension(2), parameter, private :: & - LATTICE_BCC_NCLEAVAGESYSTEM = [3, 6] !< # of cleavage systems per family for bcc - - integer, parameter, private :: & - LATTICE_BCC_NSLIP = sum(LATTICE_BCC_NSLIPSYSTEM), & !< total # of slip systems for bcc - LATTICE_BCC_NTWIN = sum(LATTICE_BCC_NTWINSYSTEM), & !< total # of twin systems for bcc - LATTICE_BCC_NCLEAVAGE = sum(LATTICE_BCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for bcc - - real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: & - LATTICE_BCC_SYSTEMSLIP = reshape(real([& - ! Slip direction Plane normal - ! Slip system <111>{110} - 1,-1, 1, 0, 1, 1, & - -1,-1, 1, 0, 1, 1, & - 1, 1, 1, 0,-1, 1, & - -1, 1, 1, 0,-1, 1, & - -1, 1, 1, 1, 0, 1, & - -1,-1, 1, 1, 0, 1, & - 1, 1, 1, -1, 0, 1, & - 1,-1, 1, -1, 0, 1, & - -1, 1, 1, 1, 1, 0, & - -1, 1,-1, 1, 1, 0, & - 1, 1, 1, -1, 1, 0, & - 1, 1,-1, -1, 1, 0, & - ! Slip system <111>{112} - -1, 1, 1, 2, 1, 1, & - 1, 1, 1, -2, 1, 1, & - 1, 1,-1, 2,-1, 1, & - 1,-1, 1, 2, 1,-1, & - 1,-1, 1, 1, 2, 1, & - 1, 1,-1, -1, 2, 1, & - 1, 1, 1, 1,-2, 1, & - -1, 1, 1, 1, 2,-1, & - 1, 1,-1, 1, 1, 2, & - 1,-1, 1, -1, 1, 2, & - -1, 1, 1, 1,-1, 2, & - 1, 1, 1, 1, 1,-2 & - ],pReal),shape(LATTICE_BCC_SYSTEMSLIP)) - - character(len=*), dimension(2), parameter, private :: LATTICE_BCC_SLIPFAMILY_NAME = & - ['<1 -1 1>{0 1 1}', & - '<1 -1 1>{2 1 1}'] - - real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter, private :: & - LATTICE_BCC_SYSTEMTWIN = reshape(real([& - ! Twin system <111>{112} - -1, 1, 1, 2, 1, 1, & - 1, 1, 1, -2, 1, 1, & - 1, 1,-1, 2,-1, 1, & - 1,-1, 1, 2, 1,-1, & - 1,-1, 1, 1, 2, 1, & - 1, 1,-1, -1, 2, 1, & - 1, 1, 1, 1,-2, 1, & - -1, 1, 1, 1, 2,-1, & - 1, 1,-1, 1, 1, 2, & - 1,-1, 1, -1, 1, 2, & - -1, 1, 1, 1,-1, 2, & - 1, 1, 1, 1, 1,-2 & - ],pReal),shape(LATTICE_BCC_SYSTEMTWIN)) - - character(len=*), dimension(1), parameter, private :: LATTICE_BCC_TWINFAMILY_NAME = & - ['<1 1 1>{2 1 1}'] - - real(pReal), dimension(3+3,LATTICE_BCC_NCLEAVAGE), parameter, private :: & - LATTICE_BCC_SYSTEMCLEAVAGE = reshape(real([& - ! Cleavage direction Plane normal - 0, 1, 0, 1, 0, 0, & - 0, 0, 1, 0, 1, 0, & - 1, 0, 0, 0, 0, 1, & - 1,-1, 1, 0, 1, 1, & - 1, 1, 1, 0,-1, 1, & - -1, 1, 1, 1, 0, 1, & - 1, 1, 1, -1, 0, 1, & - -1, 1, 1, 1, 1, 0, & - 1, 1, 1, -1, 1, 0 & - ],pReal),shape(LATTICE_BCC_SYSTEMCLEAVAGE)) - + integer, dimension(2), parameter, private :: & + LATTICE_BCC_NSLIPSYSTEM = [12, 12] !< # of slip systems per family for bcc + + integer, dimension(1), parameter, private :: & + LATTICE_BCC_NTWINSYSTEM = [12] !< # of twin systems per family for bcc + + integer, dimension(2), parameter, private :: & + LATTICE_BCC_NCLEAVAGESYSTEM = [3, 6] !< # of cleavage systems per family for bcc + + integer, parameter, private :: & + LATTICE_BCC_NSLIP = sum(LATTICE_BCC_NSLIPSYSTEM), & !< total # of slip systems for bcc + LATTICE_BCC_NTWIN = sum(LATTICE_BCC_NTWINSYSTEM), & !< total # of twin systems for bcc + LATTICE_BCC_NCLEAVAGE = sum(LATTICE_BCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for bcc + + real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: & + LATTICE_BCC_SYSTEMSLIP = reshape(real([& + ! Slip direction Plane normal + ! Slip system <111>{110} + 1,-1, 1, 0, 1, 1, & + -1,-1, 1, 0, 1, 1, & + 1, 1, 1, 0,-1, 1, & + -1, 1, 1, 0,-1, 1, & + -1, 1, 1, 1, 0, 1, & + -1,-1, 1, 1, 0, 1, & + 1, 1, 1, -1, 0, 1, & + 1,-1, 1, -1, 0, 1, & + -1, 1, 1, 1, 1, 0, & + -1, 1,-1, 1, 1, 0, & + 1, 1, 1, -1, 1, 0, & + 1, 1,-1, -1, 1, 0, & + ! Slip system <111>{112} + -1, 1, 1, 2, 1, 1, & + 1, 1, 1, -2, 1, 1, & + 1, 1,-1, 2,-1, 1, & + 1,-1, 1, 2, 1,-1, & + 1,-1, 1, 1, 2, 1, & + 1, 1,-1, -1, 2, 1, & + 1, 1, 1, 1,-2, 1, & + -1, 1, 1, 1, 2,-1, & + 1, 1,-1, 1, 1, 2, & + 1,-1, 1, -1, 1, 2, & + -1, 1, 1, 1,-1, 2, & + 1, 1, 1, 1, 1,-2 & + ],pReal),shape(LATTICE_BCC_SYSTEMSLIP)) + + character(len=*), dimension(2), parameter, private :: LATTICE_BCC_SLIPFAMILY_NAME = & + ['<1 -1 1>{0 1 1}', & + '<1 -1 1>{2 1 1}'] + + real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter, private :: & + LATTICE_BCC_SYSTEMTWIN = reshape(real([& + ! Twin system <111>{112} + -1, 1, 1, 2, 1, 1, & + 1, 1, 1, -2, 1, 1, & + 1, 1,-1, 2,-1, 1, & + 1,-1, 1, 2, 1,-1, & + 1,-1, 1, 1, 2, 1, & + 1, 1,-1, -1, 2, 1, & + 1, 1, 1, 1,-2, 1, & + -1, 1, 1, 1, 2,-1, & + 1, 1,-1, 1, 1, 2, & + 1,-1, 1, -1, 1, 2, & + -1, 1, 1, 1,-1, 2, & + 1, 1, 1, 1, 1,-2 & + ],pReal),shape(LATTICE_BCC_SYSTEMTWIN)) + + character(len=*), dimension(1), parameter, private :: LATTICE_BCC_TWINFAMILY_NAME = & + ['<1 1 1>{2 1 1}'] + + real(pReal), dimension(3+3,LATTICE_BCC_NCLEAVAGE), parameter, private :: & + LATTICE_BCC_SYSTEMCLEAVAGE = reshape(real([& + ! Cleavage direction Plane normal + 0, 1, 0, 1, 0, 0, & + 0, 0, 1, 0, 1, 0, & + 1, 0, 0, 0, 0, 1, & + 1,-1, 1, 0, 1, 1, & + 1, 1, 1, 0,-1, 1, & + -1, 1, 1, 1, 0, 1, & + 1, 1, 1, -1, 0, 1, & + -1, 1, 1, 1, 1, 0, & + 1, 1, 1, -1, 1, 0 & + ],pReal),shape(LATTICE_BCC_SYSTEMCLEAVAGE)) + !-------------------------------------------------------------------------------------------------- ! hexagonal - integer, dimension(6), parameter, private :: & - LATTICE_HEX_NSLIPSYSTEM = [3, 3, 3, 6, 12, 6] !< # of slip systems per family for hex - - integer, dimension(4), parameter, private :: & - LATTICE_HEX_NTWINSYSTEM = [6, 6, 6, 6] !< # of slip systems per family for hex - - integer, dimension(1), parameter, private :: & - LATTICE_HEX_NCLEAVAGESYSTEM = [3] !< # of cleavage systems per family for hex - - integer, parameter, private :: & - LATTICE_HEX_NSLIP = sum(LATTICE_HEX_NSLIPSYSTEM), & !< total # of slip systems for hex - LATTICE_HEX_NTWIN = sum(LATTICE_HEX_NTWINSYSTEM), & !< total # of twin systems for hex - LATTICE_HEX_NCLEAVAGE = sum(LATTICE_HEX_NCLEAVAGESYSTEM) !< total # of cleavage systems for hex - - real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter, private :: & - LATTICE_HEX_SYSTEMSLIP = reshape(real([& - ! Slip direction Plane normal - ! Basal systems <11.0>{00.1} (independent of c/a-ratio, Bravais notation (4 coordinate base)) - 2, -1, -1, 0, 0, 0, 0, 1, & - -1, 2, -1, 0, 0, 0, 0, 1, & - -1, -1, 2, 0, 0, 0, 0, 1, & - ! 1st type prismatic systems <11.0>{10.0} (independent of c/a-ratio) - 2, -1, -1, 0, 0, 1, -1, 0, & - -1, 2, -1, 0, -1, 0, 1, 0, & - -1, -1, 2, 0, 1, -1, 0, 0, & - ! 2nd type prismatic systems <10.0>{11.0} -- a slip; plane normals independent of c/a-ratio - 0, 1, -1, 0, 2, -1, -1, 0, & - -1, 0, 1, 0, -1, 2, -1, 0, & - 1, -1, 0, 0, -1, -1, 2, 0, & - ! 1st type 1st order pyramidal systems <11.0>{-11.1} -- plane normals depend on the c/a-ratio - 2, -1, -1, 0, 0, 1, -1, 1, & - -1, 2, -1, 0, -1, 0, 1, 1, & - -1, -1, 2, 0, 1, -1, 0, 1, & - 1, 1, -2, 0, -1, 1, 0, 1, & - -2, 1, 1, 0, 0, -1, 1, 1, & - 1, -2, 1, 0, 1, 0, -1, 1, & - ! pyramidal system: c+a slip <11.3>{-10.1} -- plane normals depend on the c/a-ratio - 2, -1, -1, 3, -1, 1, 0, 1, & - 1, -2, 1, 3, -1, 1, 0, 1, & - -1, -1, 2, 3, 1, 0, -1, 1, & - -2, 1, 1, 3, 1, 0, -1, 1, & - -1, 2, -1, 3, 0, -1, 1, 1, & - 1, 1, -2, 3, 0, -1, 1, 1, & - -2, 1, 1, 3, 1, -1, 0, 1, & - -1, 2, -1, 3, 1, -1, 0, 1, & - 1, 1, -2, 3, -1, 0, 1, 1, & - 2, -1, -1, 3, -1, 0, 1, 1, & - 1, -2, 1, 3, 0, 1, -1, 1, & - -1, -1, 2, 3, 0, 1, -1, 1, & - ! pyramidal system: c+a slip <11.3>{-1-1.2} -- as for hexagonal ice (Castelnau et al. 1996, similar to twin system found below) - 2, -1, -1, 3, -2, 1, 1, 2, & ! sorted according to similar twin system - -1, 2, -1, 3, 1, -2, 1, 2, & ! <11.3>{-1-1.2} shear = 2((c/a)^2-2)/(3 c/a) - -1, -1, 2, 3, 1, 1, -2, 2, & - -2, 1, 1, 3, 2, -1, -1, 2, & - 1, -2, 1, 3, -1, 2, -1, 2, & - 1, 1, -2, 3, -1, -1, 2, 2 & - ],pReal),shape(LATTICE_HEX_SYSTEMSLIP)) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr - - character(len=*), dimension(6), parameter, private :: LATTICE_HEX_SLIPFAMILY_NAME = & - ['<1 1 . 1>{0 0 . 1} ', & - '<1 1 . 1>{1 0 . 0} ', & - '<1 0 . 0>{1 1 . 0} ', & - '<1 1 . 0>{-1 1 . 1} ', & - '<1 1 . 3>{-1 0 . 1} ', & - '<1 1 . 3>{-1 -1 . 2}'] - - real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter, private :: & - LATTICE_HEX_SYSTEMTWIN = reshape(real([& - ! Compression or Tension =f(twinning shear=f(c/a)) for each metal ! (according to Yoo 1981) - 1, -1, 0, 1, -1, 1, 0, 2, & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a) - -1, 0, 1, 1, 1, 0, -1, 2, & - 0, 1, -1, 1, 0, -1, 1, 2, & - -1, 1, 0, 1, 1, -1, 0, 2, & - 1, 0, -1, 1, -1, 0, 1, 2, & - 0, -1, 1, 1, 0, 1, -1, 2, & + integer, dimension(6), parameter, private :: & + LATTICE_HEX_NSLIPSYSTEM = [3, 3, 3, 6, 12, 6] !< # of slip systems per family for hex + + integer, dimension(4), parameter, private :: & + LATTICE_HEX_NTWINSYSTEM = [6, 6, 6, 6] !< # of slip systems per family for hex + + integer, dimension(1), parameter, private :: & + LATTICE_HEX_NCLEAVAGESYSTEM = [3] !< # of cleavage systems per family for hex + + integer, parameter, private :: & + LATTICE_HEX_NSLIP = sum(LATTICE_HEX_NSLIPSYSTEM), & !< total # of slip systems for hex + LATTICE_HEX_NTWIN = sum(LATTICE_HEX_NTWINSYSTEM), & !< total # of twin systems for hex + LATTICE_HEX_NCLEAVAGE = sum(LATTICE_HEX_NCLEAVAGESYSTEM) !< total # of cleavage systems for hex + + real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter, private :: & + LATTICE_HEX_SYSTEMSLIP = reshape(real([& + ! Slip direction Plane normal + ! Basal systems <11.0>{00.1} (independent of c/a-ratio, Bravais notation (4 coordinate base)) + 2, -1, -1, 0, 0, 0, 0, 1, & + -1, 2, -1, 0, 0, 0, 0, 1, & + -1, -1, 2, 0, 0, 0, 0, 1, & + ! 1st type prismatic systems <11.0>{10.0} (independent of c/a-ratio) + 2, -1, -1, 0, 0, 1, -1, 0, & + -1, 2, -1, 0, -1, 0, 1, 0, & + -1, -1, 2, 0, 1, -1, 0, 0, & + ! 2nd type prismatic systems <10.0>{11.0} -- a slip; plane normals independent of c/a-ratio + 0, 1, -1, 0, 2, -1, -1, 0, & + -1, 0, 1, 0, -1, 2, -1, 0, & + 1, -1, 0, 0, -1, -1, 2, 0, & + ! 1st type 1st order pyramidal systems <11.0>{-11.1} -- plane normals depend on the c/a-ratio + 2, -1, -1, 0, 0, 1, -1, 1, & + -1, 2, -1, 0, -1, 0, 1, 1, & + -1, -1, 2, 0, 1, -1, 0, 1, & + 1, 1, -2, 0, -1, 1, 0, 1, & + -2, 1, 1, 0, 0, -1, 1, 1, & + 1, -2, 1, 0, 1, 0, -1, 1, & + ! pyramidal system: c+a slip <11.3>{-10.1} -- plane normals depend on the c/a-ratio + 2, -1, -1, 3, -1, 1, 0, 1, & + 1, -2, 1, 3, -1, 1, 0, 1, & + -1, -1, 2, 3, 1, 0, -1, 1, & + -2, 1, 1, 3, 1, 0, -1, 1, & + -1, 2, -1, 3, 0, -1, 1, 1, & + 1, 1, -2, 3, 0, -1, 1, 1, & + -2, 1, 1, 3, 1, -1, 0, 1, & + -1, 2, -1, 3, 1, -1, 0, 1, & + 1, 1, -2, 3, -1, 0, 1, 1, & + 2, -1, -1, 3, -1, 0, 1, 1, & + 1, -2, 1, 3, 0, 1, -1, 1, & + -1, -1, 2, 3, 0, 1, -1, 1, & + ! pyramidal system: c+a slip <11.3>{-1-1.2} -- as for hexagonal ice (Castelnau et al. 1996, similar to twin system found below) + 2, -1, -1, 3, -2, 1, 1, 2, & ! sorted according to similar twin system + -1, 2, -1, 3, 1, -2, 1, 2, & ! <11.3>{-1-1.2} shear = 2((c/a)^2-2)/(3 c/a) + -1, -1, 2, 3, 1, 1, -2, 2, & + -2, 1, 1, 3, 2, -1, -1, 2, & + 1, -2, 1, 3, -1, 2, -1, 2, & + 1, 1, -2, 3, -1, -1, 2, 2 & + ],pReal),shape(LATTICE_HEX_SYSTEMSLIP)) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr + + character(len=*), dimension(6), parameter, private :: LATTICE_HEX_SLIPFAMILY_NAME = & + ['<1 1 . 1>{0 0 . 1} ', & + '<1 1 . 1>{1 0 . 0} ', & + '<1 0 . 0>{1 1 . 0} ', & + '<1 1 . 0>{-1 1 . 1} ', & + '<1 1 . 3>{-1 0 . 1} ', & + '<1 1 . 3>{-1 -1 . 2}'] + + real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter, private :: & + LATTICE_HEX_SYSTEMTWIN = reshape(real([& + ! Compression or Tension =f(twinning shear=f(c/a)) for each metal ! (according to Yoo 1981) + 1, -1, 0, 1, -1, 1, 0, 2, & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a) + -1, 0, 1, 1, 1, 0, -1, 2, & + 0, 1, -1, 1, 0, -1, 1, 2, & + -1, 1, 0, 1, 1, -1, 0, 2, & + 1, 0, -1, 1, -1, 0, 1, 2, & + 0, -1, 1, 1, 0, 1, -1, 2, & ! - 2, -1, -1, 6, -2, 1, 1, 1, & ! <11.6>{-1-1.1} shear = 1/(c/a) - -1, 2, -1, 6, 1, -2, 1, 1, & - -1, -1, 2, 6, 1, 1, -2, 1, & - -2, 1, 1, 6, 2, -1, -1, 1, & - 1, -2, 1, 6, -1, 2, -1, 1, & - 1, 1, -2, 6, -1, -1, 2, 1, & + 2, -1, -1, 6, -2, 1, 1, 1, & ! <11.6>{-1-1.1} shear = 1/(c/a) + -1, 2, -1, 6, 1, -2, 1, 1, & + -1, -1, 2, 6, 1, 1, -2, 1, & + -2, 1, 1, 6, 2, -1, -1, 1, & + 1, -2, 1, 6, -1, 2, -1, 1, & + 1, 1, -2, 6, -1, -1, 2, 1, & ! - -1, 1, 0, -2, -1, 1, 0, 1, & !! <10.-2>{10.1} shear = (4(c/a)^2-9)/(4 sqrt(3) c/a) - 1, 0, -1, -2, 1, 0, -1, 1, & - 0, -1, 1, -2, 0, -1, 1, 1, & - 1, -1, 0, -2, 1, -1, 0, 1, & - -1, 0, 1, -2, -1, 0, 1, 1, & - 0, 1, -1, -2, 0, 1, -1, 1, & + -1, 1, 0, -2, -1, 1, 0, 1, & !! <10.-2>{10.1} shear = (4(c/a)^2-9)/(4 sqrt(3) c/a) + 1, 0, -1, -2, 1, 0, -1, 1, & + 0, -1, 1, -2, 0, -1, 1, 1, & + 1, -1, 0, -2, 1, -1, 0, 1, & + -1, 0, 1, -2, -1, 0, 1, 1, & + 0, 1, -1, -2, 0, 1, -1, 1, & ! - 2, -1, -1, -3, 2, -1, -1, 2, & ! <11.-3>{11.2} shear = 2((c/a)^2-2)/(3 c/a) - -1, 2, -1, -3, -1, 2, -1, 2, & - -1, -1, 2, -3, -1, -1, 2, 2, & - -2, 1, 1, -3, -2, 1, 1, 2, & - 1, -2, 1, -3, 1, -2, 1, 2, & - 1, 1, -2, -3, 1, 1, -2, 2 & - ],pReal),shape(LATTICE_HEX_SYSTEMTWIN)) !< twin systems for hex, order follows Prof. Tom Bieler's scheme - - character(len=*), dimension(4), parameter, private :: LATTICE_HEX_TWINFAMILY_NAME = & - ['<-1 0 . 1>{1 0 . 2} ', & - '<1 1 . 6>{-1 -1 . 1}', & - '<1 0 . -2>{1 0 . 1} ', & - '<1 1 . -3>{1 1 . 2} '] - - real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter, private :: & - LATTICE_HEX_SYSTEMCLEAVAGE = reshape(real([& - ! Cleavage direction Plane normal - 2,-1,-1, 0, 0, 0, 0, 1, & - 0, 0, 0, 1, 2,-1,-1, 0, & - 0, 0, 0, 1, 0, 1,-1, 0 & - ],pReal),shape(LATTICE_HEX_SYSTEMCLEAVAGE)) - - + 2, -1, -1, -3, 2, -1, -1, 2, & ! <11.-3>{11.2} shear = 2((c/a)^2-2)/(3 c/a) + -1, 2, -1, -3, -1, 2, -1, 2, & + -1, -1, 2, -3, -1, -1, 2, 2, & + -2, 1, 1, -3, -2, 1, 1, 2, & + 1, -2, 1, -3, 1, -2, 1, 2, & + 1, 1, -2, -3, 1, 1, -2, 2 & + ],pReal),shape(LATTICE_HEX_SYSTEMTWIN)) !< twin systems for hex, order follows Prof. Tom Bieler's scheme + + character(len=*), dimension(4), parameter, private :: LATTICE_HEX_TWINFAMILY_NAME = & + ['<-1 0 . 1>{1 0 . 2} ', & + '<1 1 . 6>{-1 -1 . 1}', & + '<1 0 . -2>{1 0 . 1} ', & + '<1 1 . -3>{1 1 . 2} '] + + real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter, private :: & + LATTICE_HEX_SYSTEMCLEAVAGE = reshape(real([& + ! Cleavage direction Plane normal + 2,-1,-1, 0, 0, 0, 0, 1, & + 0, 0, 0, 1, 2,-1,-1, 0, & + 0, 0, 0, 1, 0, 1,-1, 0 & + ],pReal),shape(LATTICE_HEX_SYSTEMCLEAVAGE)) + + !-------------------------------------------------------------------------------------------------- ! body centered tetragonal - integer, dimension(13), parameter, private :: & - LATTICE_BCT_NSLIPSYSTEM = [2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ] !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009 - - integer, parameter, private :: & - LATTICE_BCT_NSLIP = sum(LATTICE_BCT_NSLIPSYSTEM) !< total # of slip systems for bct - - real(pReal), dimension(3+3,LATTICE_BCT_NSLIP), parameter, private :: & - LATTICE_BCT_SYSTEMSLIP = reshape(real([& - ! Slip direction Plane normal - ! Slip family 1 {100)<001] (Bravais notation {hkl) @brief Module initialization !-------------------------------------------------------------------------------------------------- subroutine lattice_init - use IO, only: & - IO_error - use config, only: & - config_phase - - implicit none - integer :: Nphases - character(len=65536) :: & - tag = '' - integer :: i,p - real(pReal), dimension(:), allocatable :: & - temp, & - CoverA !< c/a ratio for low symmetry type lattice - - write(6,'(/,a)') ' <<<+- lattice init -+>>>' - - Nphases = size(config_phase) - - allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID) - allocate(trans_lattice_structure(Nphases),source = LATTICE_undefined_ID) - allocate(lattice_C66(6,6,Nphases), source=0.0_pReal) - allocate(lattice_C3333(3,3,3,3,Nphases), source=0.0_pReal) + use IO, only: & + IO_error + use config, only: & + config_phase + + integer :: Nphases + character(len=65536) :: & + tag = '' + integer :: i,p + real(pReal), dimension(:), allocatable :: & + temp, & + CoverA !< c/a ratio for low symmetry type lattice + + write(6,'(/,a)') ' <<<+- lattice init -+>>>' + + Nphases = size(config_phase) + + allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID) + allocate(trans_lattice_structure(Nphases),source = LATTICE_undefined_ID) + allocate(lattice_C66(6,6,Nphases), source=0.0_pReal) + allocate(lattice_C3333(3,3,3,3,Nphases), source=0.0_pReal) + + allocate(lattice_thermalExpansion33 (3,3,3,Nphases), source=0.0_pReal) ! constant, linear, quadratic coefficients + allocate(lattice_thermalConductivity33 (3,3,Nphases), source=0.0_pReal) + allocate(lattice_damageDiffusion33 (3,3,Nphases), source=0.0_pReal) + allocate(lattice_damageMobility ( Nphases), source=0.0_pReal) + allocate(lattice_massDensity ( Nphases), source=0.0_pReal) + allocate(lattice_specificHeat ( Nphases), source=0.0_pReal) + allocate(lattice_referenceTemperature ( Nphases), source=300.0_pReal) + + allocate(lattice_mu(Nphases), source=0.0_pReal) + allocate(lattice_nu(Nphases), source=0.0_pReal) + + + allocate(lattice_Scleavage(3,3,3,lattice_maxNcleavage,Nphases),source=0.0_pReal) + allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0) + + allocate(CoverA(Nphases),source=0.0_pReal) + + do p = 1, size(config_phase) + tag = config_phase(p)%getString('lattice_structure') + select case(trim(tag(1:3))) + case('iso') + lattice_structure(p) = LATTICE_iso_ID + case('fcc') + lattice_structure(p) = LATTICE_fcc_ID + case('bcc') + lattice_structure(p) = LATTICE_bcc_ID + case('hex') + lattice_structure(p) = LATTICE_hex_ID + case('bct') + lattice_structure(p) = LATTICE_bct_ID + case('ort') + lattice_structure(p) = LATTICE_ort_ID + end select + + tag = 'undefined' + tag = config_phase(p)%getString('trans_lattice_structure',defaultVal=tag) + select case(trim(tag)) + case('bcc') + trans_lattice_structure(p) = LATTICE_bcc_ID + case('hex','hexagonal') + trans_lattice_structure(p) = LATTICE_hex_ID + end select + + lattice_C66(1,1,p) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) + lattice_C66(1,2,p) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) + lattice_C66(1,3,p) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) + lattice_C66(2,2,p) = config_phase(p)%getFloat('c22',defaultVal=0.0_pReal) + lattice_C66(2,3,p) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) + lattice_C66(3,3,p) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) + lattice_C66(4,4,p) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) + lattice_C66(5,5,p) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) + lattice_C66(6,6,p) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) + + + CoverA(p) = config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal) + + lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11',defaultVal=0.0_pReal) + lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22',defaultVal=0.0_pReal) + lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33',defaultVal=0.0_pReal) + + temp = config_phase(p)%getFloats('thermal_expansion11',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(1,1,1:size(temp),p) = temp + temp = config_phase(p)%getFloats('thermal_expansion22',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(2,2,1:size(temp),p) = temp + temp = config_phase(p)%getFloats('thermal_expansion33',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(3,3,1:size(temp),p) = temp + + lattice_specificHeat(p) = config_phase(p)%getFloat( 'specific_heat',defaultVal=0.0_pReal) + lattice_massDensity(p) = config_phase(p)%getFloat( 'mass_density',defaultVal=0.0_pReal) + lattice_referenceTemperature(p) = config_phase(p)%getFloat( 'reference_temperature',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(1,1,p) = config_phase(p)%getFloat( 'damage_diffusion11',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(2,2,p) = config_phase(p)%getFloat( 'damage_diffusion22',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(3,3,p) = config_phase(p)%getFloat( 'damage_diffusion33',defaultVal=0.0_pReal) + lattice_DamageMobility(p) = config_phase(p)%getFloat( 'damage_mobility',defaultVal=0.0_pReal) + enddo + + do i = 1,Nphases + if ((CoverA(i) < 1.0_pReal .or. CoverA(i) > 2.0_pReal) & + .and. lattice_structure(i) == LATTICE_hex_ID) call IO_error(131,el=i) ! checking physical significance of c/a + if ((CoverA(i) > 2.0_pReal) & + .and. lattice_structure(i) == LATTICE_bct_ID) call IO_error(131,el=i) ! checking physical significance of c/a + call lattice_initializeStructure(i, CoverA(i)) + enddo - allocate(lattice_thermalExpansion33 (3,3,3,Nphases), source=0.0_pReal) ! constant, linear, quadratic coefficients - allocate(lattice_thermalConductivity33 (3,3,Nphases), source=0.0_pReal) - allocate(lattice_damageDiffusion33 (3,3,Nphases), source=0.0_pReal) - allocate(lattice_damageMobility ( Nphases), source=0.0_pReal) - allocate(lattice_massDensity ( Nphases), source=0.0_pReal) - allocate(lattice_specificHeat ( Nphases), source=0.0_pReal) - allocate(lattice_referenceTemperature ( Nphases), source=300.0_pReal) - - allocate(lattice_mu(Nphases), source=0.0_pReal) - allocate(lattice_nu(Nphases), source=0.0_pReal) - - - allocate(lattice_Scleavage(3,3,3,lattice_maxNcleavage,Nphases),source=0.0_pReal) - allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0) - - allocate(CoverA(Nphases),source=0.0_pReal) - - do p = 1, size(config_phase) - tag = config_phase(p)%getString('lattice_structure') - select case(trim(tag(1:3))) - case('iso') - lattice_structure(p) = LATTICE_iso_ID - case('fcc') - lattice_structure(p) = LATTICE_fcc_ID - case('bcc') - lattice_structure(p) = LATTICE_bcc_ID - case('hex') - lattice_structure(p) = LATTICE_hex_ID - case('bct') - lattice_structure(p) = LATTICE_bct_ID - case('ort') - lattice_structure(p) = LATTICE_ort_ID - end select - - tag = 'undefined' - tag = config_phase(p)%getString('trans_lattice_structure',defaultVal=tag) - select case(trim(tag)) - case('bcc') - trans_lattice_structure(p) = LATTICE_bcc_ID - case('hex','hexagonal') - trans_lattice_structure(p) = LATTICE_hex_ID - end select - - lattice_C66(1,1,p) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) - lattice_C66(1,2,p) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) - lattice_C66(1,3,p) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) - lattice_C66(2,2,p) = config_phase(p)%getFloat('c22',defaultVal=0.0_pReal) - lattice_C66(2,3,p) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) - lattice_C66(3,3,p) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) - lattice_C66(4,4,p) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) - lattice_C66(5,5,p) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) - lattice_C66(6,6,p) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) - - - CoverA(p) = config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal) - - lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11',defaultVal=0.0_pReal) - lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22',defaultVal=0.0_pReal) - lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33',defaultVal=0.0_pReal) - - temp = config_phase(p)%getFloats('thermal_expansion11',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(1,1,1:size(temp),p) = temp - temp = config_phase(p)%getFloats('thermal_expansion22',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(2,2,1:size(temp),p) = temp - temp = config_phase(p)%getFloats('thermal_expansion33',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(3,3,1:size(temp),p) = temp - - lattice_specificHeat(p) = config_phase(p)%getFloat( 'specific_heat',defaultVal=0.0_pReal) - lattice_massDensity(p) = config_phase(p)%getFloat( 'mass_density',defaultVal=0.0_pReal) - lattice_referenceTemperature(p) = config_phase(p)%getFloat( 'reference_temperature',defaultVal=0.0_pReal) - lattice_DamageDiffusion33(1,1,p) = config_phase(p)%getFloat( 'damage_diffusion11',defaultVal=0.0_pReal) - lattice_DamageDiffusion33(2,2,p) = config_phase(p)%getFloat( 'damage_diffusion22',defaultVal=0.0_pReal) - lattice_DamageDiffusion33(3,3,p) = config_phase(p)%getFloat( 'damage_diffusion33',defaultVal=0.0_pReal) - lattice_DamageMobility(p) = config_phase(p)%getFloat( 'damage_mobility',defaultVal=0.0_pReal) - enddo - - do i = 1,Nphases - if ((CoverA(i) < 1.0_pReal .or. CoverA(i) > 2.0_pReal) & - .and. lattice_structure(i) == LATTICE_hex_ID) call IO_error(131,el=i) ! checking physical significance of c/a - if ((CoverA(i) > 2.0_pReal) & - .and. lattice_structure(i) == LATTICE_bct_ID) call IO_error(131,el=i) ! checking physical significance of c/a - call lattice_initializeStructure(i, CoverA(i)) - enddo - end subroutine lattice_init - - + + !-------------------------------------------------------------------------------------------------- !> @brief !!!!!!!DEPRECTATED!!!!!! !-------------------------------------------------------------------------------------------------- subroutine lattice_initializeStructure(myPhase,CoverA) - use prec, only: & - tol_math_check - use math, only: & - math_sym3333to66, & - math_Voigt66to3333, & - math_cross - use IO, only: & - IO_error - - implicit none - integer, intent(in) :: myPhase - real(pReal), intent(in) :: & - CoverA - - integer :: & - i, & - myNcleavage - - lattice_C66(1:6,1:6,myPhase) = lattice_symmetrizeC66(lattice_structure(myPhase),& - lattice_C66(1:6,1:6,myPhase)) - - lattice_mu(myPhase) = 0.2_pReal *( lattice_C66(1,1,myPhase) & - - lattice_C66(1,2,myPhase) & - + 3.0_pReal*lattice_C66(4,4,myPhase)) ! (C11iso-C12iso)/2 with C11iso=(3*C11+2*C12+4*C44)/5 and C12iso=(C11+4*C12-2*C44)/5 - lattice_nu(myPhase) = ( lattice_C66(1,1,myPhase) & - + 4.0_pReal*lattice_C66(1,2,myPhase) & - - 2.0_pReal*lattice_C66(4,4,myPhase)) & - /( 4.0_pReal*lattice_C66(1,1,myPhase) & - + 6.0_pReal*lattice_C66(1,2,myPhase) & - + 2.0_pReal*lattice_C66(4,4,myPhase))! C12iso/(C11iso+C12iso) with C11iso=(3*C11+2*C12+4*C44)/5 and C12iso=(C11+4*C12-2*C44)/5 - lattice_C3333(1:3,1:3,1:3,1:3,myPhase) = math_Voigt66to3333(lattice_C66(1:6,1:6,myPhase)) ! Literature data is Voigt - lattice_C66(1:6,1:6,myPhase) = math_sym3333to66(lattice_C3333(1:3,1:3,1:3,1:3,myPhase)) ! DAMASK uses Mandel-weighting - do i = 1, 6 - if (abs(lattice_C66(i,i,myPhase)) @brief Symmetrizes stiffness matrix according to lattice type !> @details J. A. Rayne and B. S. Chandrasekhar Phys. Rev. 120, 1658 Erratum Phys. Rev. 122, 1962 !-------------------------------------------------------------------------------------------------- pure function lattice_symmetrizeC66(struct,C66) - - implicit none - integer(kind(LATTICE_undefined_ID)), intent(in) :: struct - real(pReal), dimension(6,6), intent(in) :: C66 - real(pReal), dimension(6,6) :: lattice_symmetrizeC66 - integer :: j,k - - lattice_symmetrizeC66 = 0.0_pReal - - select case(struct) - case (LATTICE_iso_ID) - forall(k=1:3) - forall(j=1:3) lattice_symmetrizeC66(k,j) = C66(1,2) - lattice_symmetrizeC66(k,k) = C66(1,1) - lattice_symmetrizeC66(k+3,k+3) = 0.5_pReal*(C66(1,1)-C66(1,2)) - end forall - case (LATTICE_fcc_ID,LATTICE_bcc_ID) - forall(k=1:3) - forall(j=1:3) lattice_symmetrizeC66(k,j) = C66(1,2) - lattice_symmetrizeC66(k,k) = C66(1,1) - lattice_symmetrizeC66(k+3,k+3) = C66(4,4) - end forall - case (LATTICE_hex_ID) - lattice_symmetrizeC66(1,1) = C66(1,1) - lattice_symmetrizeC66(2,2) = C66(1,1) - lattice_symmetrizeC66(3,3) = C66(3,3) - lattice_symmetrizeC66(1,2) = C66(1,2) - lattice_symmetrizeC66(2,1) = C66(1,2) - lattice_symmetrizeC66(1,3) = C66(1,3) - lattice_symmetrizeC66(3,1) = C66(1,3) - lattice_symmetrizeC66(2,3) = C66(1,3) - lattice_symmetrizeC66(3,2) = C66(1,3) - lattice_symmetrizeC66(4,4) = C66(4,4) - lattice_symmetrizeC66(5,5) = C66(4,4) - lattice_symmetrizeC66(6,6) = 0.5_pReal*(C66(1,1)-C66(1,2)) - case (LATTICE_ort_ID) - lattice_symmetrizeC66(1,1) = C66(1,1) - lattice_symmetrizeC66(2,2) = C66(2,2) - lattice_symmetrizeC66(3,3) = C66(3,3) - lattice_symmetrizeC66(1,2) = C66(1,2) - lattice_symmetrizeC66(2,1) = C66(1,2) - lattice_symmetrizeC66(1,3) = C66(1,3) - lattice_symmetrizeC66(3,1) = C66(1,3) - lattice_symmetrizeC66(2,3) = C66(2,3) - lattice_symmetrizeC66(3,2) = C66(2,3) - lattice_symmetrizeC66(4,4) = C66(4,4) - lattice_symmetrizeC66(5,5) = C66(5,5) - lattice_symmetrizeC66(6,6) = C66(6,6) - case (LATTICE_bct_ID) - lattice_symmetrizeC66(1,1) = C66(1,1) - lattice_symmetrizeC66(2,2) = C66(1,1) - lattice_symmetrizeC66(3,3) = C66(3,3) - lattice_symmetrizeC66(1,2) = C66(1,2) - lattice_symmetrizeC66(2,1) = C66(1,2) - lattice_symmetrizeC66(1,3) = C66(1,3) - lattice_symmetrizeC66(3,1) = C66(1,3) - lattice_symmetrizeC66(2,3) = C66(1,3) - lattice_symmetrizeC66(3,2) = C66(1,3) - lattice_symmetrizeC66(4,4) = C66(4,4) - lattice_symmetrizeC66(5,5) = C66(4,4) - lattice_symmetrizeC66(6,6) = C66(6,6) - case default - lattice_symmetrizeC66 = C66 - end select - - end function lattice_symmetrizeC66 - - + + integer(kind(LATTICE_undefined_ID)), intent(in) :: struct + real(pReal), dimension(6,6), intent(in) :: C66 + real(pReal), dimension(6,6) :: lattice_symmetrizeC66 + integer :: j,k + + lattice_symmetrizeC66 = 0.0_pReal + + select case(struct) + case (LATTICE_iso_ID) + forall(k=1:3) + forall(j=1:3) lattice_symmetrizeC66(k,j) = C66(1,2) + lattice_symmetrizeC66(k,k) = C66(1,1) + lattice_symmetrizeC66(k+3,k+3) = 0.5_pReal*(C66(1,1)-C66(1,2)) + end forall + case (LATTICE_fcc_ID,LATTICE_bcc_ID) + forall(k=1:3) + forall(j=1:3) lattice_symmetrizeC66(k,j) = C66(1,2) + lattice_symmetrizeC66(k,k) = C66(1,1) + lattice_symmetrizeC66(k+3,k+3) = C66(4,4) + end forall + case (LATTICE_hex_ID) + lattice_symmetrizeC66(1,1) = C66(1,1) + lattice_symmetrizeC66(2,2) = C66(1,1) + lattice_symmetrizeC66(3,3) = C66(3,3) + lattice_symmetrizeC66(1,2) = C66(1,2) + lattice_symmetrizeC66(2,1) = C66(1,2) + lattice_symmetrizeC66(1,3) = C66(1,3) + lattice_symmetrizeC66(3,1) = C66(1,3) + lattice_symmetrizeC66(2,3) = C66(1,3) + lattice_symmetrizeC66(3,2) = C66(1,3) + lattice_symmetrizeC66(4,4) = C66(4,4) + lattice_symmetrizeC66(5,5) = C66(4,4) + lattice_symmetrizeC66(6,6) = 0.5_pReal*(C66(1,1)-C66(1,2)) + case (LATTICE_ort_ID) + lattice_symmetrizeC66(1,1) = C66(1,1) + lattice_symmetrizeC66(2,2) = C66(2,2) + lattice_symmetrizeC66(3,3) = C66(3,3) + lattice_symmetrizeC66(1,2) = C66(1,2) + lattice_symmetrizeC66(2,1) = C66(1,2) + lattice_symmetrizeC66(1,3) = C66(1,3) + lattice_symmetrizeC66(3,1) = C66(1,3) + lattice_symmetrizeC66(2,3) = C66(2,3) + lattice_symmetrizeC66(3,2) = C66(2,3) + lattice_symmetrizeC66(4,4) = C66(4,4) + lattice_symmetrizeC66(5,5) = C66(5,5) + lattice_symmetrizeC66(6,6) = C66(6,6) + case (LATTICE_bct_ID) + lattice_symmetrizeC66(1,1) = C66(1,1) + lattice_symmetrizeC66(2,2) = C66(1,1) + lattice_symmetrizeC66(3,3) = C66(3,3) + lattice_symmetrizeC66(1,2) = C66(1,2) + lattice_symmetrizeC66(2,1) = C66(1,2) + lattice_symmetrizeC66(1,3) = C66(1,3) + lattice_symmetrizeC66(3,1) = C66(1,3) + lattice_symmetrizeC66(2,3) = C66(1,3) + lattice_symmetrizeC66(3,2) = C66(1,3) + lattice_symmetrizeC66(4,4) = C66(4,4) + lattice_symmetrizeC66(5,5) = C66(4,4) + lattice_symmetrizeC66(6,6) = C66(6,6) + case default + lattice_symmetrizeC66 = C66 + end select + +end function lattice_symmetrizeC66 + + !-------------------------------------------------------------------------------------------------- !> @brief Symmetrizes 2nd order tensor according to lattice type !-------------------------------------------------------------------------------------------------- pure function lattice_symmetrize33(struct,T33) - - implicit none - integer(kind(LATTICE_undefined_ID)), intent(in) :: struct - real(pReal), dimension(3,3), intent(in) :: T33 - real(pReal), dimension(3,3) :: lattice_symmetrize33 - integer :: k - - lattice_symmetrize33 = 0.0_pReal - - select case(struct) - case (LATTICE_iso_ID,LATTICE_fcc_ID,LATTICE_bcc_ID) - forall(k=1:3) lattice_symmetrize33(k,k) = T33(1,1) - case (LATTICE_hex_ID) - lattice_symmetrize33(1,1) = T33(1,1) - lattice_symmetrize33(2,2) = T33(1,1) - lattice_symmetrize33(3,3) = T33(3,3) - case (LATTICE_ort_ID,lattice_bct_ID) - lattice_symmetrize33(1,1) = T33(1,1) - lattice_symmetrize33(2,2) = T33(2,2) - lattice_symmetrize33(3,3) = T33(3,3) - case default - lattice_symmetrize33 = T33 - end select - - end function lattice_symmetrize33 - - + + integer(kind(LATTICE_undefined_ID)), intent(in) :: struct + real(pReal), dimension(3,3), intent(in) :: T33 + real(pReal), dimension(3,3) :: lattice_symmetrize33 + integer :: k + + lattice_symmetrize33 = 0.0_pReal + + select case(struct) + case (LATTICE_iso_ID,LATTICE_fcc_ID,LATTICE_bcc_ID) + forall(k=1:3) lattice_symmetrize33(k,k) = T33(1,1) + case (LATTICE_hex_ID) + lattice_symmetrize33(1,1) = T33(1,1) + lattice_symmetrize33(2,2) = T33(1,1) + lattice_symmetrize33(3,3) = T33(3,3) + case (LATTICE_ort_ID,lattice_bct_ID) + lattice_symmetrize33(1,1) = T33(1,1) + lattice_symmetrize33(2,2) = T33(2,2) + lattice_symmetrize33(3,3) = T33(3,3) + case default + lattice_symmetrize33 = T33 + end select + +end function lattice_symmetrize33 + + !-------------------------------------------------------------------------------------------------- !> @brief figures whether unit quat falls into stereographic standard triangle !-------------------------------------------------------------------------------------------------- logical pure function lattice_qInSST(Q, struct) - use, intrinsic :: & - IEEE_arithmetic - use math, only: & - math_qToRodrig - - implicit none - real(pReal), dimension(4), intent(in) :: Q ! orientation - integer(kind(LATTICE_undefined_ID)), intent(in) :: struct ! lattice structure - real(pReal), dimension(3) :: Rodrig ! Rodrigues vector of Q - - Rodrig = math_qToRodrig(Q) - if (any(IEEE_is_NaN(Rodrig))) then - lattice_qInSST = .false. - else - select case (struct) - case (LATTICE_bcc_ID,LATTICE_fcc_ID) - lattice_qInSST = Rodrig(1) > Rodrig(2) .and. & - Rodrig(2) > Rodrig(3) .and. & - Rodrig(3) > 0.0_pReal - case (LATTICE_hex_ID) - lattice_qInSST = Rodrig(1) > sqrt(3.0_pReal)*Rodrig(2) .and. & - Rodrig(2) > 0.0_pReal .and. & - Rodrig(3) > 0.0_pReal - case default - lattice_qInSST = .true. - end select - endif - + use, intrinsic :: & + IEEE_arithmetic + use math, only: & + math_qToRodrig + + real(pReal), dimension(4), intent(in) :: Q ! orientation + integer(kind(LATTICE_undefined_ID)), intent(in) :: struct ! lattice structure + real(pReal), dimension(3) :: Rodrig ! Rodrigues vector of Q + + Rodrig = math_qToRodrig(Q) + if (any(IEEE_is_NaN(Rodrig))) then + lattice_qInSST = .false. + else + select case (struct) + case (LATTICE_bcc_ID,LATTICE_fcc_ID) + lattice_qInSST = Rodrig(1) > Rodrig(2) .and. & + Rodrig(2) > Rodrig(3) .and. & + Rodrig(3) > 0.0_pReal + case (LATTICE_hex_ID) + lattice_qInSST = Rodrig(1) > sqrt(3.0_pReal)*Rodrig(2) .and. & + Rodrig(2) > 0.0_pReal .and. & + Rodrig(3) > 0.0_pReal + case default + lattice_qInSST = .true. + end select + endif + end function lattice_qInSST - - + + !-------------------------------------------------------------------------------------------------- !> @brief calculates the disorientation for 2 unit quaternions !-------------------------------------------------------------------------------------------------- pure function lattice_qDisorientation(Q1, Q2, struct) - use prec, only: & - tol_math_check - use math, only: & - math_qMul, & - math_qConj - - implicit none - real(pReal), dimension(4) :: lattice_qDisorientation - real(pReal), dimension(4), intent(in) :: & - Q1, & ! 1st orientation - Q2 ! 2nd orientation - integer(kind(LATTICE_undefined_ID)), optional, intent(in) :: & ! if given, symmetries between the two orientation will be considered - struct - - real(pReal), dimension(4) :: dQ,dQsymA,mis - integer :: i,j,k,s,symmetry - integer(kind(LATTICE_undefined_ID)) :: myStruct - - integer, dimension(2), parameter :: & - NsymOperations = [24,12] - -real(pReal), dimension(4,36), parameter :: & - symOperations = reshape([& - 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! cubic symmetry operations - 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), & ! 2-fold symmetry - 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & ! 3-fold symmetry - -0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & - 0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & - -0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & - 0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & - -0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & - 0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & - -0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & - 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & ! 4-fold symmetry - 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & - -1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & - 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & - -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal, & - -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & -! - 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! hexagonal symmetry operations - 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & ! 2-fold symmetry - 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & - 0.0_pReal, 0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & - 0.0_pReal, -0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & - 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & - 0.0_pReal, -2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & - 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & ! 6-fold symmetry - -2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & - 0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & - -0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & - 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal & - ],[4,36]) !< Symmetry operations as quaternions 24 for cubic, 12 for hexagonal = 36 - + use prec, only: & + tol_math_check + use math, only: & + math_qMul, & + math_qConj + + real(pReal), dimension(4) :: lattice_qDisorientation + real(pReal), dimension(4), intent(in) :: & + Q1, & !< 1st orientation + Q2 !< 2nd orientation + integer(kind(LATTICE_undefined_ID)), optional, intent(in) :: & !< if given, symmetries between the two orientation will be considered + struct + + real(pReal), dimension(4) :: dQ,dQsymA,mis + integer :: i,j,k,s,symmetry + integer(kind(LATTICE_undefined_ID)) :: myStruct + + integer, dimension(2), parameter :: & + NsymOperations = [24,12] + + real(pReal), dimension(4,36), parameter :: & + symOperations = reshape([& + 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! cubic symmetry operations + 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), & ! 2-fold symmetry + 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & ! 3-fold symmetry + -0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & + 0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & + -0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & + 0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & + -0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & + 0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & + -0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & + 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & ! 4-fold symmetry + 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & + -1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & + 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & + -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal, & + -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & + ! + 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! hexagonal symmetry operations + 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & ! 2-fold symmetry + 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & + 0.0_pReal, 0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & + 0.0_pReal, -0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & + 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & + 0.0_pReal, -2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & + 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & ! 6-fold symmetry + -2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & + 0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & + -0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & + 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal & + ],[4,36]) !< Symmetry operations as quaternions 24 for cubic, 12 for hexagonal = 36 + !-------------------------------------------------------------------------------------------------- ! check if a structure with known symmetries is given - if (present(struct)) then - myStruct = struct - select case (struct) - case(LATTICE_fcc_ID,LATTICE_bcc_ID) - symmetry = 1 - case(LATTICE_hex_ID) - symmetry = 2 - case default - symmetry = 0 - end select - else - symmetry = 0 - myStruct = LATTICE_undefined_ID - endif - - + if (present(struct)) then + myStruct = struct + select case (struct) + case(LATTICE_fcc_ID,LATTICE_bcc_ID) + symmetry = 1 + case(LATTICE_hex_ID) + symmetry = 2 + case default + symmetry = 0 + end select + else + symmetry = 0 + myStruct = LATTICE_undefined_ID + endif + + !-------------------------------------------------------------------------------------------------- ! calculate misorientation, for cubic and hexagonal structure find symmetries - dQ = math_qMul(math_qConj(Q1),Q2) - lattice_qDisorientation = dQ - - select case(symmetry) - - case (1,2) - s = sum(NsymOperations(1:symmetry-1)) - do i = 1,2 - dQ = math_qConj(dQ) ! switch order of "from -- to" - do j = 1,NsymOperations(symmetry) ! run through first crystal's symmetries - dQsymA = math_qMul(symOperations(1:4,s+j),dQ) ! apply sym - do k = 1,NsymOperations(symmetry) ! run through 2nd crystal's symmetries - mis = math_qMul(dQsymA,symOperations(1:4,s+k)) ! apply sym - if (mis(1) < 0.0_pReal) & ! want positive angle - mis = -mis - if (mis(1)-lattice_qDisorientation(1) > -tol_math_check & - .and. lattice_qInSST(mis,LATTICE_undefined_ID)) lattice_qDisorientation = mis ! found better one - enddo; enddo; enddo - case (0) - if (lattice_qDisorientation(1) < 0.0_pReal) lattice_qDisorientation = -lattice_qDisorientation ! keep omega within 0 to 180 deg - end select - + dQ = math_qMul(math_qConj(Q1),Q2) + lattice_qDisorientation = dQ + + select case(symmetry) + + case (1,2) + s = sum(NsymOperations(1:symmetry-1)) + do i = 1,2 + dQ = math_qConj(dQ) ! switch order of "from -- to" + do j = 1,NsymOperations(symmetry) ! run through first crystal's symmetries + dQsymA = math_qMul(symOperations(1:4,s+j),dQ) ! apply sym + do k = 1,NsymOperations(symmetry) ! run through 2nd crystal's symmetries + mis = math_qMul(dQsymA,symOperations(1:4,s+k)) ! apply sym + if (mis(1) < 0.0_pReal) & ! want positive angle + mis = -mis + if (mis(1)-lattice_qDisorientation(1) > -tol_math_check & + .and. lattice_qInSST(mis,LATTICE_undefined_ID)) lattice_qDisorientation = mis ! found better one + enddo; enddo; enddo + case (0) + if (lattice_qDisorientation(1) < 0.0_pReal) lattice_qDisorientation = -lattice_qDisorientation ! keep omega within 0 to 180 deg + end select + end function lattice_qDisorientation - - + + !-------------------------------------------------------------------------------------------------- !> @brief Characteristic shear for twinning !-------------------------------------------------------------------------------------------------- function lattice_characteristicShear_Twin(Ntwin,structure,CoverA) result(characteristicShear) - use IO, only: & - IO_error - - implicit none - integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA !< c/a ratio - real(pReal), dimension(sum(Ntwin)) :: characteristicShear + use IO, only: & + IO_error + + integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(sum(Ntwin)) :: characteristicShear + + integer :: & + a, & !< index of active system + c, & !< index in complete system list + mf, & !< index of my family + ms !< index of my system in current family + + integer, dimension(LATTICE_HEX_NTWIN), parameter :: & + HEX_SHEARTWIN = reshape( [& + 1, & ! <-10.1>{10.2} + 1, & + 1, & + 1, & + 1, & + 1, & + 2, & ! <11.6>{-1-1.1} + 2, & + 2, & + 2, & + 2, & + 2, & + 3, & ! <10.-2>{10.1} + 3, & + 3, & + 3, & + 3, & + 3, & + 4, & ! <11.-3>{11.2} + 4, & + 4, & + 4, & + 4, & + 4 & + ],[LATTICE_HEX_NTWIN]) ! indicator to formulas below + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='lattice_characteristicShear_Twin: '//trim(structure)) + + a = 0 + myFamilies: do mf = 1,size(Ntwin,1) + mySystems: do ms = 1,Ntwin(mf) + a = a + 1 + select case(structure(1:3)) + case('fcc','bcc') + characteristicShear(a) = 0.5_pReal*sqrt(2.0_pReal) + case('hex') + if (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal) & + call IO_error(131,ext_msg='lattice_characteristicShear_Twin') + c = sum(LATTICE_HEX_NTWINSYSTEM(1:mf-1))+ms + select case(HEX_SHEARTWIN(c)) ! from Christian & Mahajan 1995 p.29 + case (1) ! <-10.1>{10.2} + characteristicShear(a) = (3.0_pReal-cOverA**2.0_pReal)/sqrt(3.0_pReal)/CoverA + case (2) ! <11.6>{-1-1.1} + characteristicShear(a) = 1.0_pReal/cOverA + case (3) ! <10.-2>{10.1} + characteristicShear(a) = (4.0_pReal*cOverA**2.0_pReal-9.0_pReal)/sqrt(48.0_pReal)/cOverA + case (4) ! <11.-3>{11.2} + characteristicShear(a) = 2.0_pReal*(cOverA**2.0_pReal-2.0_pReal)/3.0_pReal/cOverA + end select + case default + call IO_error(137,ext_msg='lattice_characteristicShear_Twin: '//trim(structure)) + end select + enddo mySystems + enddo myFamilies - integer :: & - a, & !< index of active system - c, & !< index in complete system list - mf, & !< index of my family - ms !< index of my system in current family - - integer, dimension(LATTICE_HEX_NTWIN), parameter :: & - HEX_SHEARTWIN = reshape( [& - 1, & ! <-10.1>{10.2} - 1, & - 1, & - 1, & - 1, & - 1, & - 2, & ! <11.6>{-1-1.1} - 2, & - 2, & - 2, & - 2, & - 2, & - 3, & ! <10.-2>{10.1} - 3, & - 3, & - 3, & - 3, & - 3, & - 4, & ! <11.-3>{11.2} - 4, & - 4, & - 4, & - 4, & - 4 & - ],[LATTICE_HEX_NTWIN]) ! indicator to formulas below - - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='lattice_characteristicShear_Twin: '//trim(structure)) - - a = 0 - myFamilies: do mf = 1,size(Ntwin,1) - mySystems: do ms = 1,Ntwin(mf) - a = a + 1 - select case(structure(1:3)) - case('fcc','bcc') - characteristicShear(a) = 0.5_pReal*sqrt(2.0_pReal) - case('hex') - if (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal) & - call IO_error(131,ext_msg='lattice_characteristicShear_Twin') - c = sum(LATTICE_HEX_NTWINSYSTEM(1:mf-1))+ms - select case(HEX_SHEARTWIN(c)) ! from Christian & Mahajan 1995 p.29 - case (1) ! <-10.1>{10.2} - characteristicShear(a) = (3.0_pReal-cOverA**2.0_pReal)/sqrt(3.0_pReal)/CoverA - case (2) ! <11.6>{-1-1.1} - characteristicShear(a) = 1.0_pReal/cOverA - case (3) ! <10.-2>{10.1} - characteristicShear(a) = (4.0_pReal*cOverA**2.0_pReal-9.0_pReal)/sqrt(48.0_pReal)/cOverA - case (4) ! <11.-3>{11.2} - characteristicShear(a) = 2.0_pReal*(cOverA**2.0_pReal-2.0_pReal)/3.0_pReal/cOverA - end select - case default - call IO_error(137,ext_msg='lattice_characteristicShear_Twin: '//trim(structure)) - end select - enddo mySystems - enddo myFamilies - end function lattice_characteristicShear_Twin - - + + !-------------------------------------------------------------------------------------------------- !> @brief Rotated elasticity matrices for twinning in 66-vector notation !-------------------------------------------------------------------------------------------------- function lattice_C66_twin(Ntwin,C66,structure,CoverA) - use IO, only: & - IO_error - use math, only: & - PI, & - math_axisAngleToR, & - math_sym3333to66, & - math_66toSym3333, & - math_rotate_forward3333 - - implicit none - integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(6,6), intent(in) :: C66 !< unrotated parent stiffness matrix - real(pReal), intent(in) :: cOverA !< c/a ratio - real(pReal), dimension(6,6,sum(Ntwin)) :: lattice_C66_twin - - real(pReal),dimension(3,3,sum(Ntwin)) :: coordinateSystem - real(pReal), dimension(3,3) :: R - integer :: i + use IO, only: & + IO_error + use math, only: & + PI, & + math_axisAngleToR, & + math_sym3333to66, & + math_66toSym3333, & + math_rotate_forward3333 - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='lattice_C66_twin: '//trim(structure)) - - select case(structure(1:3)) - case('fcc') - coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_FCC_NSLIPSYSTEM,LATTICE_FCC_SYSTEMTWIN,& - trim(structure),0.0_pReal) - case('bcc') - coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMTWIN,& - trim(structure),0.0_pReal) - case('hex') - coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_HEX_NSLIPSYSTEM,LATTICE_HEX_SYSTEMTWIN,& - 'hex',cOverA) - case default - call IO_error(137,ext_msg='lattice_C66_twin: '//trim(structure)) - end select - - do i = 1, sum(Ntwin) - R = math_axisAngleToR(coordinateSystem(1:3,2,i), PI) ! ToDo: Why always 180 deg? - lattice_C66_twin(1:6,1:6,i) = math_sym3333to66(math_rotate_forward3333(math_66toSym3333(C66),R)) - enddo + integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), dimension(6,6), intent(in) :: C66 !< unrotated parent stiffness matrix + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(6,6,sum(Ntwin)) :: lattice_C66_twin + + real(pReal),dimension(3,3,sum(Ntwin)) :: coordinateSystem + real(pReal), dimension(3,3) :: R + integer :: i + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='lattice_C66_twin: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_FCC_NSLIPSYSTEM,LATTICE_FCC_SYSTEMTWIN,& + trim(structure),0.0_pReal) + case('bcc') + coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMTWIN,& + trim(structure),0.0_pReal) + case('hex') + coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_HEX_NSLIPSYSTEM,LATTICE_HEX_SYSTEMTWIN,& + 'hex',cOverA) + case default + call IO_error(137,ext_msg='lattice_C66_twin: '//trim(structure)) + end select + + do i = 1, sum(Ntwin) + R = math_axisAngleToR(coordinateSystem(1:3,2,i), PI) ! ToDo: Why always 180 deg? + lattice_C66_twin(1:6,1:6,i) = math_sym3333to66(math_rotate_forward3333(math_66toSym3333(C66),R)) + enddo end function lattice_C66_twin - - + + !-------------------------------------------------------------------------------------------------- !> @brief Rotated elasticity matrices for transformation in 66-vector notation !-------------------------------------------------------------------------------------------------- function lattice_C66_trans(Ntrans,C_parent66,structure_target, & CoverA_trans,a_bcc,a_fcc) - use prec, only: & - tol_math_check - use IO, only: & - IO_error - use math, only: & - INRAD, & - MATH_I3, & - math_axisAngleToR, & - math_sym3333to66, & - math_66toSym3333, & - math_rotate_forward3333 - - implicit none - integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family - character(len=*), intent(in) :: structure_target !< lattice structure - real(pReal), dimension(6,6), intent(in) :: C_parent66 - real(pReal), dimension(6,6,sum(Ntrans)) :: lattice_C66_trans - - real(pReal), dimension(6,6) :: C_bar66, C_target_unrotated66 - real(pReal), dimension(3,3,3,3) :: C_target_unrotated - real(pReal), dimension(3,3,sum(Ntrans)) :: Q,S - real(pReal) :: a_bcc, a_fcc, CoverA_trans - integer :: i - - if (len_trim(structure_target) /= 3) & - call IO_error(137,ext_msg='lattice_C66_trans (target): '//trim(structure_target)) - - !ToDo: add checks for CoverA_trans,a_fcc,a_bcc + use prec, only: & + tol_math_check + use IO, only: & + IO_error + use math, only: & + INRAD, & + MATH_I3, & + math_axisAngleToR, & + math_sym3333to66, & + math_66toSym3333, & + math_rotate_forward3333 + + integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family + character(len=*), intent(in) :: structure_target !< lattice structure + real(pReal), dimension(6,6), intent(in) :: C_parent66 + real(pReal), dimension(6,6,sum(Ntrans)) :: lattice_C66_trans -!-------------------------------------------------------------------------------------------------- -! elasticity matrix of the target phase in cube orientation - if (structure_target(1:3) == 'hex') then - C_bar66(1,1) = (C_parent66(1,1) + C_parent66(1,2) + 2.0_pReal*C_parent66(4,4))/2.0_pReal - C_bar66(1,2) = (C_parent66(1,1) + 5.0_pReal*C_parent66(1,2) - 2.0_pReal*C_parent66(4,4))/6.0_pReal - C_bar66(3,3) = (C_parent66(1,1) + 2.0_pReal*C_parent66(1,2) + 4.0_pReal*C_parent66(4,4))/3.0_pReal - C_bar66(1,3) = (C_parent66(1,1) + 2.0_pReal*C_parent66(1,2) - 2.0_pReal*C_parent66(4,4))/3.0_pReal - C_bar66(4,4) = (C_parent66(1,1) - C_parent66(1,2) + C_parent66(4,4))/3.0_pReal - C_bar66(1,4) = (C_parent66(1,1) - C_parent66(1,2) - 2.0_pReal*C_parent66(4,4)) /(3.0_pReal*sqrt(2.0_pReal)) - - C_target_unrotated66 = 0.0_pReal - C_target_unrotated66(1,1) = C_bar66(1,1) - C_bar66(1,4)**2.0_pReal/C_bar66(4,4) - C_target_unrotated66(1,2) = C_bar66(1,2) + C_bar66(1,4)**2.0_pReal/C_bar66(4,4) - C_target_unrotated66(1,3) = C_bar66(1,3) - C_target_unrotated66(3,3) = C_bar66(3,3) - C_target_unrotated66(4,4) = C_bar66(4,4) - C_bar66(1,4)**2.0_pReal/(0.5_pReal*(C_bar66(1,1) - C_bar66(1,2))) - C_target_unrotated66 = lattice_symmetrizeC66(LATTICE_HEX_ID,C_target_unrotated66) - elseif (structure_target(1:3) == 'bcc') then - C_target_unrotated66 = C_parent66 - else - call IO_error(137,ext_msg='lattice_C66_trans (target): '//trim(structure_target)) - endif - - - do i = 1, 6 - if (abs(C_target_unrotated66(i,i)) @brief Non-schmid projections for bcc with up to 6 coefficients ! Koester et al. 2012, Acta Materialia 60 (2012) 3894–3901, eq. (17) ! Gröger et al. 2008, Acta Materialia 56 (2008) 5412–5425, table 1 !-------------------------------------------------------------------------------------------------- function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSchmidMatrix) - use IO, only: & - IO_error - use math, only: & - INRAD, & - math_outer, & - math_cross, & - math_axisAngleToR - implicit none - integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family - real(pReal), dimension(:), intent(in) :: nonSchmidCoefficients !< non-Schmid coefficients for projections - integer, intent(in) :: sense !< sense (-1,+1) - real(pReal), dimension(1:3,1:3,sum(Nslip)) :: nonSchmidMatrix + use IO, only: & + IO_error + use math, only: & + INRAD, & + math_outer, & + math_cross, & + math_axisAngleToR - real(pReal), dimension(1:3,1:3,sum(Nslip)) :: coordinateSystem !< coordinate system of slip system - real(pReal), dimension(:), allocatable :: direction, normal, np - integer :: i - - if (abs(sense) /= 1) call IO_error(0,ext_msg='lattice_nonSchmidMatrix') - - coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMSLIP,& - 'bcc',0.0_pReal) - coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip)) *real(sense,pReal) ! convert unidirectional coordinate system - nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'bcc',0.0_pReal) ! Schmid contribution - - do i = 1,sum(Nslip) - direction = coordinateSystem(1:3,1,i) - normal = coordinateSystem(1:3,2,i) - np = matmul(math_axisAngleToR(direction,60.0_pReal*INRAD), normal) - if (size(nonSchmidCoefficients)>0) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(1) * math_outer(direction, np) - if (size(nonSchmidCoefficients)>1) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(2) * math_outer(math_cross(normal, direction), normal) - if (size(nonSchmidCoefficients)>2) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(3) * math_outer(math_cross(np, direction), np) - if (size(nonSchmidCoefficients)>3) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(4) * math_outer(normal, normal) - if (size(nonSchmidCoefficients)>4) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(5) * math_outer(math_cross(normal, direction), & - math_cross(normal, direction)) - if (size(nonSchmidCoefficients)>5) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & - + nonSchmidCoefficients(6) * math_outer(direction, direction) - enddo + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family + real(pReal), dimension(:), intent(in) :: nonSchmidCoefficients !< non-Schmid coefficients for projections + integer, intent(in) :: sense !< sense (-1,+1) + real(pReal), dimension(1:3,1:3,sum(Nslip)) :: nonSchmidMatrix + + real(pReal), dimension(1:3,1:3,sum(Nslip)) :: coordinateSystem !< coordinate system of slip system + real(pReal), dimension(:), allocatable :: direction, normal, np + integer :: i + + if (abs(sense) /= 1) call IO_error(0,ext_msg='lattice_nonSchmidMatrix') + + coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMSLIP,& + 'bcc',0.0_pReal) + coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip)) *real(sense,pReal) ! convert unidirectional coordinate system + nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'bcc',0.0_pReal) ! Schmid contribution + + do i = 1,sum(Nslip) + direction = coordinateSystem(1:3,1,i) + normal = coordinateSystem(1:3,2,i) + np = matmul(math_axisAngleToR(direction,60.0_pReal*INRAD), normal) + if (size(nonSchmidCoefficients)>0) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & + + nonSchmidCoefficients(1) * math_outer(direction, np) + if (size(nonSchmidCoefficients)>1) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & + + nonSchmidCoefficients(2) * math_outer(math_cross(normal, direction), normal) + if (size(nonSchmidCoefficients)>2) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & + + nonSchmidCoefficients(3) * math_outer(math_cross(np, direction), np) + if (size(nonSchmidCoefficients)>3) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & + + nonSchmidCoefficients(4) * math_outer(normal, normal) + if (size(nonSchmidCoefficients)>4) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & + + nonSchmidCoefficients(5) * math_outer(math_cross(normal, direction), & + math_cross(normal, direction)) + if (size(nonSchmidCoefficients)>5) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) & + + nonSchmidCoefficients(6) * math_outer(direction, direction) + enddo end function lattice_nonSchmidMatrix - - + + !-------------------------------------------------------------------------------------------------- !> @brief Slip-slip interaction matrix !> details only active slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipBySlip(Nslip,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error - - implicit none - integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-slip interaction - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(sum(Nslip),sum(Nslip)) :: interactionMatrix - - integer, dimension(:), allocatable :: NslipMax - integer, dimension(:,:), allocatable :: interactionTypes + use IO, only: & + IO_error - integer, dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NSLIP), parameter :: & - FCC_INTERACTIONSLIPSLIP = reshape( [& - 1, 2, 2, 4, 6, 5, 3, 5, 5, 4, 5, 6, 9,10, 9,10,11,12, & - 2, 1, 2, 6, 4, 5, 5, 4, 6, 5, 3, 5, 9,10,11,12, 9,10, & - 2, 2, 1, 5, 5, 3, 5, 6, 4, 6, 5, 4, 11,12, 9,10, 9,10, & - 4, 6, 5, 1, 2, 2, 4, 5, 6, 3, 5, 5, 9,10,10, 9,12,11, & - 6, 4, 5, 2, 1, 2, 5, 3, 5, 5, 4, 6, 9,10,12,11,10, 9, & - 5, 5, 3, 2, 2, 1, 6, 5, 4, 5, 6, 4, 11,12,10, 9,10, 9, & - 3, 5, 5, 4, 5, 6, 1, 2, 2, 4, 6, 5, 10, 9,10, 9,11,12, & - 5, 4, 6, 5, 3, 5, 2, 1, 2, 6, 4, 5, 10, 9,12,11, 9,10, & - 5, 6, 4, 6, 5, 4, 2, 2, 1, 5, 5, 3, 12,11,10, 9, 9,10, & - 4, 5, 6, 3, 5, 5, 4, 6, 5, 1, 2, 2, 10, 9, 9,10,12,11, & - 5, 3, 5, 5, 4, 6, 6, 4, 5, 2, 1, 2, 10, 9,11,12,10, 9, & - 6, 5, 4, 5, 6, 4, 5, 5, 3, 2, 2, 1, 12,11, 9,10,10, 9, & - - 9, 9,11, 9, 9,11,10,10,12,10,10,12, 1, 7, 8, 8, 8, 8, & - 10,10,12,10,10,12, 9, 9,11, 9, 9,11, 7, 1, 8, 8, 8, 8, & - 9,11, 9,10,12,10,10,12,10, 9,11, 9, 8, 8, 1, 7, 8, 8, & - 10,12,10, 9,11, 9, 9,11, 9,10,12,10, 8, 8, 7, 1, 8, 8, & - 11, 9, 9,12,10,10,11, 9, 9,12,10,10, 8, 8, 8, 8, 1, 7, & - 12,10,10,11, 9, 9,12,10,10,11, 9, 9, 8, 8, 8, 8, 7, 1 & - ],shape(FCC_INTERACTIONSLIPSLIP)) !< Slip--slip interaction types for fcc + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-slip interaction + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), dimension(sum(Nslip),sum(Nslip)) :: interactionMatrix + + integer, dimension(:), allocatable :: NslipMax + integer, dimension(:,:), allocatable :: interactionTypes + + integer, dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NSLIP), parameter :: & + FCC_INTERACTIONSLIPSLIP = reshape( [& + 1, 2, 2, 4, 6, 5, 3, 5, 5, 4, 5, 6, 9,10, 9,10,11,12, & ! -----> acting + 2, 1, 2, 6, 4, 5, 5, 4, 6, 5, 3, 5, 9,10,11,12, 9,10, & ! | + 2, 2, 1, 5, 5, 3, 5, 6, 4, 6, 5, 4, 11,12, 9,10, 9,10, & ! | + 4, 6, 5, 1, 2, 2, 4, 5, 6, 3, 5, 5, 9,10,10, 9,12,11, & ! v + 6, 4, 5, 2, 1, 2, 5, 3, 5, 5, 4, 6, 9,10,12,11,10, 9, & ! reacting + 5, 5, 3, 2, 2, 1, 6, 5, 4, 5, 6, 4, 11,12,10, 9,10, 9, & + 3, 5, 5, 4, 5, 6, 1, 2, 2, 4, 6, 5, 10, 9,10, 9,11,12, & + 5, 4, 6, 5, 3, 5, 2, 1, 2, 6, 4, 5, 10, 9,12,11, 9,10, & + 5, 6, 4, 6, 5, 4, 2, 2, 1, 5, 5, 3, 12,11,10, 9, 9,10, & + 4, 5, 6, 3, 5, 5, 4, 6, 5, 1, 2, 2, 10, 9, 9,10,12,11, & + 5, 3, 5, 5, 4, 6, 6, 4, 5, 2, 1, 2, 10, 9,11,12,10, 9, & + 6, 5, 4, 5, 6, 4, 5, 5, 3, 2, 2, 1, 12,11, 9,10,10, 9, & + + 9, 9,11, 9, 9,11,10,10,12,10,10,12, 1, 7, 8, 8, 8, 8, & + 10,10,12,10,10,12, 9, 9,11, 9, 9,11, 7, 1, 8, 8, 8, 8, & + 9,11, 9,10,12,10,10,12,10, 9,11, 9, 8, 8, 1, 7, 8, 8, & + 10,12,10, 9,11, 9, 9,11, 9,10,12,10, 8, 8, 7, 1, 8, 8, & + 11, 9, 9,12,10,10,11, 9, 9,12,10,10, 8, 8, 8, 8, 1, 7, & + 12,10,10,11, 9, 9,12,10,10,11, 9, 9, 8, 8, 8, 8, 7, 1 & + ],shape(FCC_INTERACTIONSLIPSLIP)) !< Slip--slip interaction types for fcc !< 1: self interaction !< 2: coplanar interaction !< 3: collinear interaction @@ -1301,1094 +1291,1078 @@ function lattice_interaction_SlipBySlip(Nslip,interactionValues,structure) resul !<10: similar to glissile junctions in <110>{111} btw one {110} and one {111} plane !<11: crossing btw one {110} and one {111} plane !<12: collinear btw one {110} and one {111} plane - - integer, dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NSLIP), parameter :: & - BCC_INTERACTIONSLIPSLIP = reshape( [& - 1,2,6,6,5,4,4,3,4,3,5,4, 6,6,4,3,3,4,6,6,4,3,6,6, & - 2,1,6,6,4,3,5,4,5,4,4,3, 6,6,3,4,4,3,6,6,3,4,6,6, & - 6,6,1,2,4,5,3,4,4,5,3,4, 4,3,6,6,6,6,3,4,6,6,4,3, & - 6,6,2,1,3,4,4,5,3,4,4,5, 3,4,6,6,6,6,4,3,6,6,3,4, & - 5,4,4,3,1,2,6,6,3,4,5,4, 3,6,4,6,6,4,6,3,4,6,3,6, & - 4,3,5,4,2,1,6,6,4,5,4,3, 4,6,3,6,6,3,6,4,3,6,4,6, & - 4,5,3,4,6,6,1,2,5,4,3,4, 6,3,6,4,4,6,3,6,6,4,6,3, & - 3,4,4,5,6,6,2,1,4,3,4,5, 6,4,6,3,3,6,4,6,6,3,6,4, & - 4,5,4,3,3,4,5,4,1,2,6,6, 3,6,6,4,4,6,6,3,6,4,3,6, & - 3,4,5,4,4,5,4,3,2,1,6,6, 4,6,6,3,3,6,6,4,6,3,4,6, & - 5,4,3,4,5,4,3,4,6,6,1,2, 6,3,4,6,6,4,3,6,4,6,6,3, & - 4,3,4,5,4,3,4,5,6,6,2,1, 6,4,3,6,6,3,4,6,3,6,6,4, & - ! - 6,6,4,3,3,4,6,6,3,4,6,6, 1,5,6,6,5,6,6,3,5,6,3,6, & - 6,6,3,4,6,6,3,4,6,6,3,4, 5,1,6,6,6,5,3,6,6,5,6,3, & - 4,3,6,6,4,3,6,6,6,6,4,3, 6,6,1,5,6,3,5,6,3,6,5,6, & - 3,4,6,6,6,6,4,3,4,3,6,6, 6,6,5,1,3,6,6,5,6,3,6,5, & - 3,4,6,6,6,6,4,3,4,3,6,6, 5,6,6,3,1,6,5,6,5,3,6,6, & - 4,3,6,6,4,3,6,6,6,6,4,3, 6,5,3,6,6,1,6,5,3,5,6,6, & - 6,6,3,4,6,6,3,4,6,6,3,4, 6,3,5,6,5,6,1,6,6,6,5,3, & - 6,6,4,3,3,4,6,6,3,4,6,6, 3,6,6,5,6,5,6,1,6,6,3,5, & - 4,3,6,6,4,3,6,6,6,6,4,3, 5,6,3,6,5,3,6,6,1,6,6,5, & - 3,4,6,6,6,6,4,3,4,3,6,6, 6,5,6,3,3,5,6,6,6,1,5,6, & - 6,6,4,3,3,4,6,6,3,4,6,6, 3,6,5,6,6,6,5,3,6,5,1,6, & - 6,6,3,4,6,6,3,4,6,6,3,4, 6,3,6,5,6,6,3,5,5,6,6,1 & - ],shape(BCC_INTERACTIONSLIPSLIP)) !< Slip--slip interaction types for bcc from Queyreau et al. Int J Plast 25 (2009) 361–377 + + integer, dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NSLIP), parameter :: & + BCC_INTERACTIONSLIPSLIP = reshape( [& + 1,2,6,6,5,4,4,3,4,3,5,4, 6,6,4,3,3,4,6,6,4,3,6,6, & ! -----> acting + 2,1,6,6,4,3,5,4,5,4,4,3, 6,6,3,4,4,3,6,6,3,4,6,6, & ! | + 6,6,1,2,4,5,3,4,4,5,3,4, 4,3,6,6,6,6,3,4,6,6,4,3, & ! | + 6,6,2,1,3,4,4,5,3,4,4,5, 3,4,6,6,6,6,4,3,6,6,3,4, & ! v + 5,4,4,3,1,2,6,6,3,4,5,4, 3,6,4,6,6,4,6,3,4,6,3,6, & ! reacting + 4,3,5,4,2,1,6,6,4,5,4,3, 4,6,3,6,6,3,6,4,3,6,4,6, & + 4,5,3,4,6,6,1,2,5,4,3,4, 6,3,6,4,4,6,3,6,6,4,6,3, & + 3,4,4,5,6,6,2,1,4,3,4,5, 6,4,6,3,3,6,4,6,6,3,6,4, & + 4,5,4,3,3,4,5,4,1,2,6,6, 3,6,6,4,4,6,6,3,6,4,3,6, & + 3,4,5,4,4,5,4,3,2,1,6,6, 4,6,6,3,3,6,6,4,6,3,4,6, & + 5,4,3,4,5,4,3,4,6,6,1,2, 6,3,4,6,6,4,3,6,4,6,6,3, & + 4,3,4,5,4,3,4,5,6,6,2,1, 6,4,3,6,6,3,4,6,3,6,6,4, & + ! + 6,6,4,3,3,4,6,6,3,4,6,6, 1,5,6,6,5,6,6,3,5,6,3,6, & + 6,6,3,4,6,6,3,4,6,6,3,4, 5,1,6,6,6,5,3,6,6,5,6,3, & + 4,3,6,6,4,3,6,6,6,6,4,3, 6,6,1,5,6,3,5,6,3,6,5,6, & + 3,4,6,6,6,6,4,3,4,3,6,6, 6,6,5,1,3,6,6,5,6,3,6,5, & + 3,4,6,6,6,6,4,3,4,3,6,6, 5,6,6,3,1,6,5,6,5,3,6,6, & + 4,3,6,6,4,3,6,6,6,6,4,3, 6,5,3,6,6,1,6,5,3,5,6,6, & + 6,6,3,4,6,6,3,4,6,6,3,4, 6,3,5,6,5,6,1,6,6,6,5,3, & + 6,6,4,3,3,4,6,6,3,4,6,6, 3,6,6,5,6,5,6,1,6,6,3,5, & + 4,3,6,6,4,3,6,6,6,6,4,3, 5,6,3,6,5,3,6,6,1,6,6,5, & + 3,4,6,6,6,6,4,3,4,3,6,6, 6,5,6,3,3,5,6,6,6,1,5,6, & + 6,6,4,3,3,4,6,6,3,4,6,6, 3,6,5,6,6,6,5,3,6,5,1,6, & + 6,6,3,4,6,6,3,4,6,6,3,4, 6,3,6,5,6,6,3,5,5,6,6,1 & + ],shape(BCC_INTERACTIONSLIPSLIP)) !< Slip--slip interaction types for bcc from Queyreau et al. Int J Plast 25 (2009) 361–377 !< 1: self interaction !< 2: coplanar interaction !< 3: collinear interaction !< 4: mixed-asymmetrical junction !< 5: mixed-symmetrical junction !< 6: edge junction - - integer, dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NSLIP), parameter :: & - HEX_INTERACTIONSLIPSLIP = reshape( [& - 1, 2, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & - 2, 1, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & - 2, 2, 1, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & - ! - 6, 6, 6, 4, 5, 5, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & - 6, 6, 6, 5, 4, 5, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & - 6, 6, 6, 5, 5, 4, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & - ! - 12,12,12, 11,11,11, 9,10,10, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & - 12,12,12, 11,11,11, 10, 9,10, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & - 12,12,12, 11,11,11, 10,10, 9, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & - ! - 20,20,20, 19,19,19, 18,18,18, 16,17,17,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - 20,20,20, 19,19,19, 18,18,18, 17,16,17,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - 20,20,20, 19,19,19, 18,18,18, 17,17,16,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - 20,20,20, 19,19,19, 18,18,18, 17,17,17,16,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - 20,20,20, 19,19,19, 18,18,18, 17,17,17,17,16,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - 20,20,20, 19,19,19, 18,18,18, 17,17,17,17,17,16, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & - ! - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 25,26,26,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,25,26,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,25,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,25,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,25,26,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,25,26,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,25,26,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,25,26,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,25,26,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,25,26,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,26,25,26, 35,35,35,35,35,35, & - 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,26,26,25, 35,35,35,35,35,35, & - ! - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 36,37,37,37,37,37, & - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,36,37,37,37,37, & - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,36,37,37,37, & - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,36,37,37, & - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,36,37, & - 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,37,36 & - ],shape(HEX_INTERACTIONSLIPSLIP)) !< Slip--slip interaction types for hex (onion peel naming scheme) - - integer, dimension(LATTICE_BCT_NSLIP,LATTICE_BCT_NSLIP), parameter :: & - BCT_INTERACTIONSLIPSLIP = reshape( [& - 1, 2, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & - 2, 1, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & - ! - 6, 6, 4, 5, 8, 8, 14, 14, 14, 14, 22, 22, 32, 32, 32, 32, 44, 44, 58, 58, 74, 74, 74, 74, 92, 92, 92, 92, 92, 92, 92, 92, 112, 112, 112, 112, 134,134,134,134,134,134,134,134, 158,158,158,158,158,158,158,158, & - 6, 6, 5, 4, 8, 8, 14, 14, 14, 14, 22, 22, 32, 32, 32, 32, 44, 44, 58, 58, 74, 74, 74, 74, 92, 92, 92, 92, 92, 92, 92, 92, 112, 112, 112, 112, 134,134,134,134,134,134,134,134, 158,158,158,158,158,158,158,158, & - ! - 12, 12, 11, 11, 9, 10, 15, 15, 15, 15, 23, 23, 33, 33, 33, 33, 45, 45, 59, 59, 75, 75, 75, 75, 93, 93, 93, 93, 93, 93, 93, 93, 113, 113, 113, 113, 135,135,135,135,135,135,135,135, 159,159,159,159,159,159,159,159, & - 12, 12, 11, 11, 10, 9, 15, 15, 15, 15, 23, 23, 33, 33, 33, 33, 45, 45, 59, 59, 75, 75, 75, 75, 93, 93, 93, 93, 93, 93, 93, 93, 113, 113, 113, 113, 135,135,135,135,135,135,135,135, 159,159,159,159,159,159,159,159, & - ! - 20, 20, 19, 19, 18, 18, 16, 17, 17, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & - 20, 20, 19, 19, 18, 18, 17, 16, 17, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & - 20, 20, 19, 19, 18, 18, 17, 17, 16, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & - 20, 20, 19, 19, 18, 18, 17, 17, 17, 16, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & - ! - 30, 30, 29, 29, 28, 28, 27, 27, 27, 27, 25, 26, 35, 35, 35, 35, 47, 47, 61, 61, 77, 77, 77, 77, 95, 95, 95, 95, 95, 95, 95, 95, 115, 115, 115, 115, 137,137,137,137,137,137,137,137, 161,161,161,161,161,161,161,161, & - 30, 30, 29, 29, 28, 28, 27, 27, 27, 27, 26, 25, 35, 35, 35, 35, 47, 47, 61, 61, 77, 77, 77, 77, 95, 95, 95, 95, 95, 95, 95, 95, 115, 115, 115, 115, 137,137,137,137,137,137,137,137, 161,161,161,161,161,161,161,161, & - ! - 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 36, 37, 37, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & - 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 36, 37, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & - 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 37, 36, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & - 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 37, 37, 36, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & - ! - 56, 56, 55, 55, 54, 54, 53, 53, 53, 53, 52, 52, 51, 51, 51, 51, 49, 50, 63, 63, 79, 79, 79, 79, 97, 97, 97, 97, 97, 97, 97, 97, 117, 117, 117, 117, 139,139,139,139,139,139,139,139, 163,163,163,163,163,163,163,163, & - 56, 56, 55, 55, 54, 54, 53, 53, 53, 53, 52, 52, 51, 51, 51, 51, 50, 49, 63, 63, 79, 79, 79, 79, 97, 97, 97, 97, 97, 97, 97, 97, 117, 117, 117, 117, 139,139,139,139,139,139,139,139, 163,163,163,163,163,163,163,163, & - ! - 72, 72, 71, 71, 70, 70, 69, 69, 69, 69, 68, 68, 67, 67, 67, 67, 66, 66, 64, 65, 80, 80, 80, 80, 98, 98, 98, 98, 98, 98, 98, 98, 118, 118, 118, 118, 140,140,140,140,140,140,140,140, 164,164,164,164,164,164,164,164, & - 72, 72, 71, 71, 70, 70, 69, 69, 69, 69, 68, 68, 67, 67, 67, 67, 66, 66, 65, 64, 80, 80, 80, 80, 98, 98, 98, 98, 98, 98, 98, 98, 118, 118, 118, 118, 140,140,140,140,140,140,140,140, 164,164,164,164,164,164,164,164, & - ! - 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 81, 82, 82, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & - 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 81, 82, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & - 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 82, 81, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & - 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 82, 82, 81, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & - ! - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 100,101,101,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,100,101,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,100,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,100,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,100,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,100,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,101,100,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,101,101,100, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & - ! - 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 122, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & - 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 121, 122, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & - 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 121, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & - 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 122, 121, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & - ! - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 144,145,145,145,145,145,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,144,145,145,145,145,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,144,145,145,145,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,144,145,145,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,144,145,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,144,145,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,145,144,145, 168,168,168,168,168,168,168,168, & - 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,145,145,144, 168,168,168,168,168,168,168,168, & - ! - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,169,170,170,170,170,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,169,170,170,170,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,170,169,170,170,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,170,170,169,170,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,169,170,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,169,170, & - 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,170,169 & - ],shape(BCT_INTERACTIONSLIPSLIP)) - - - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='lattice_interaction_SlipBySlip: '//trim(structure)) - - select case(structure(1:3)) - case('fcc') - interactionTypes = FCC_INTERACTIONSLIPSLIP - NslipMax = LATTICE_FCC_NSLIPSYSTEM - case('bcc') - interactionTypes = BCC_INTERACTIONSLIPSLIP - NslipMax = LATTICE_BCC_NSLIPSYSTEM - case('hex') - interactionTypes = HEX_INTERACTIONSLIPSLIP - NslipMax = LATTICE_HEX_NSLIPSYSTEM - case('bct') - interactionTypes = BCT_INTERACTIONSLIPSLIP - NslipMax = LATTICE_BCT_NSLIPSYSTEM - case default - call IO_error(137,ext_msg='lattice_interaction_SlipBySlip: '//trim(structure)) - end select - - interactionMatrix = buildInteraction(Nslip,Nslip,NslipMax,NslipMax,interactionValues,interactionTypes) - + + integer, dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NSLIP), parameter :: & + HEX_INTERACTIONSLIPSLIP = reshape( [& + 1, 2, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! -----> acting + 2, 1, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! | + 2, 2, 1, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! | + ! ! v + 6, 6, 6, 4, 5, 5, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & ! reacting + 6, 6, 6, 5, 4, 5, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & + 6, 6, 6, 5, 5, 4, 8, 8, 8, 14,14,14,14,14,14, 22,22,22,22,22,22,22,22,22,22,22,22, 32,32,32,32,32,32, & + ! + 12,12,12, 11,11,11, 9,10,10, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & + 12,12,12, 11,11,11, 10, 9,10, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & + 12,12,12, 11,11,11, 10,10, 9, 15,15,15,15,15,15, 23,23,23,23,23,23,23,23,23,23,23,23, 33,33,33,33,33,33, & + ! + 20,20,20, 19,19,19, 18,18,18, 16,17,17,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + 20,20,20, 19,19,19, 18,18,18, 17,16,17,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + 20,20,20, 19,19,19, 18,18,18, 17,17,16,17,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + 20,20,20, 19,19,19, 18,18,18, 17,17,17,16,17,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + 20,20,20, 19,19,19, 18,18,18, 17,17,17,17,16,17, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + 20,20,20, 19,19,19, 18,18,18, 17,17,17,17,17,16, 24,24,24,24,24,24,24,24,24,24,24,24, 34,34,34,34,34,34, & + ! + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 25,26,26,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,25,26,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,25,26,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,25,26,26,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,25,26,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,25,26,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,25,26,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,25,26,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,25,26,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,25,26,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,26,25,26, 35,35,35,35,35,35, & + 30,30,30, 29,29,29, 28,28,28, 27,27,27,27,27,27, 26,26,26,26,26,26,26,26,26,26,26,25, 35,35,35,35,35,35, & + ! + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 36,37,37,37,37,37, & + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,36,37,37,37,37, & + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,36,37,37,37, & + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,36,37,37, & + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,36,37, & + 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,37,36 & + ],shape(HEX_INTERACTIONSLIPSLIP)) !< Slip--slip interaction types for hex (onion peel naming scheme) + + integer, dimension(LATTICE_BCT_NSLIP,LATTICE_BCT_NSLIP), parameter :: & + BCT_INTERACTIONSLIPSLIP = reshape( [& + 1, 2, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & ! -----> acting + 2, 1, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & ! | + ! | + 6, 6, 4, 5, 8, 8, 14, 14, 14, 14, 22, 22, 32, 32, 32, 32, 44, 44, 58, 58, 74, 74, 74, 74, 92, 92, 92, 92, 92, 92, 92, 92, 112, 112, 112, 112, 134,134,134,134,134,134,134,134, 158,158,158,158,158,158,158,158, & ! v + 6, 6, 5, 4, 8, 8, 14, 14, 14, 14, 22, 22, 32, 32, 32, 32, 44, 44, 58, 58, 74, 74, 74, 74, 92, 92, 92, 92, 92, 92, 92, 92, 112, 112, 112, 112, 134,134,134,134,134,134,134,134, 158,158,158,158,158,158,158,158, & ! reacting + ! + 12, 12, 11, 11, 9, 10, 15, 15, 15, 15, 23, 23, 33, 33, 33, 33, 45, 45, 59, 59, 75, 75, 75, 75, 93, 93, 93, 93, 93, 93, 93, 93, 113, 113, 113, 113, 135,135,135,135,135,135,135,135, 159,159,159,159,159,159,159,159, & + 12, 12, 11, 11, 10, 9, 15, 15, 15, 15, 23, 23, 33, 33, 33, 33, 45, 45, 59, 59, 75, 75, 75, 75, 93, 93, 93, 93, 93, 93, 93, 93, 113, 113, 113, 113, 135,135,135,135,135,135,135,135, 159,159,159,159,159,159,159,159, & + ! + 20, 20, 19, 19, 18, 18, 16, 17, 17, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & + 20, 20, 19, 19, 18, 18, 17, 16, 17, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & + 20, 20, 19, 19, 18, 18, 17, 17, 16, 17, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & + 20, 20, 19, 19, 18, 18, 17, 17, 17, 16, 24, 24, 34, 34, 34, 34, 46, 46, 60, 60, 76, 76, 76, 76, 94, 94, 94, 94, 94, 94, 94, 94, 114, 114, 114, 114, 136,136,136,136,136,136,136,136, 160,160,160,160,160,160,160,160, & + ! + 30, 30, 29, 29, 28, 28, 27, 27, 27, 27, 25, 26, 35, 35, 35, 35, 47, 47, 61, 61, 77, 77, 77, 77, 95, 95, 95, 95, 95, 95, 95, 95, 115, 115, 115, 115, 137,137,137,137,137,137,137,137, 161,161,161,161,161,161,161,161, & + 30, 30, 29, 29, 28, 28, 27, 27, 27, 27, 26, 25, 35, 35, 35, 35, 47, 47, 61, 61, 77, 77, 77, 77, 95, 95, 95, 95, 95, 95, 95, 95, 115, 115, 115, 115, 137,137,137,137,137,137,137,137, 161,161,161,161,161,161,161,161, & + ! + 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 36, 37, 37, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & + 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 36, 37, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & + 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 37, 36, 37, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & + 42, 42, 41, 41, 40, 40, 39, 39, 39, 39, 38, 38, 37, 37, 37, 36, 48, 48, 62, 62, 78, 78, 78, 78, 96, 96, 96, 96, 96, 96, 96, 96, 116, 116, 116, 116, 138,138,138,138,138,138,138,138, 162,162,162,162,162,162,162,162, & + ! + 56, 56, 55, 55, 54, 54, 53, 53, 53, 53, 52, 52, 51, 51, 51, 51, 49, 50, 63, 63, 79, 79, 79, 79, 97, 97, 97, 97, 97, 97, 97, 97, 117, 117, 117, 117, 139,139,139,139,139,139,139,139, 163,163,163,163,163,163,163,163, & + 56, 56, 55, 55, 54, 54, 53, 53, 53, 53, 52, 52, 51, 51, 51, 51, 50, 49, 63, 63, 79, 79, 79, 79, 97, 97, 97, 97, 97, 97, 97, 97, 117, 117, 117, 117, 139,139,139,139,139,139,139,139, 163,163,163,163,163,163,163,163, & + ! + 72, 72, 71, 71, 70, 70, 69, 69, 69, 69, 68, 68, 67, 67, 67, 67, 66, 66, 64, 65, 80, 80, 80, 80, 98, 98, 98, 98, 98, 98, 98, 98, 118, 118, 118, 118, 140,140,140,140,140,140,140,140, 164,164,164,164,164,164,164,164, & + 72, 72, 71, 71, 70, 70, 69, 69, 69, 69, 68, 68, 67, 67, 67, 67, 66, 66, 65, 64, 80, 80, 80, 80, 98, 98, 98, 98, 98, 98, 98, 98, 118, 118, 118, 118, 140,140,140,140,140,140,140,140, 164,164,164,164,164,164,164,164, & + ! + 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 81, 82, 82, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & + 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 81, 82, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & + 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 82, 81, 82, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & + 90, 90, 89, 89, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85, 85, 85, 84, 84, 83, 83, 82, 82, 82, 81, 99, 99, 99, 99, 99, 99, 99, 99, 119, 119, 119, 119, 141,141,141,141,141,141,141,141, 165,165,165,165,165,165,165,165, & + ! + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 100,101,101,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,100,101,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,100,101,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,100,101,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,100,101,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,100,101,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,101,100,101, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + 110,110, 109,109, 108,108, 107,107,107,107, 106,106, 105,105,105,105, 104,104, 103,103, 102,102,102,102, 101,101,101,101,101,101,101,100, 120, 120, 120, 120, 142,142,142,142,142,142,142,142, 166,166,166,166,166,166,166,166, & + ! + 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 122, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & + 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 121, 122, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & + 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 121, 122, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & + 132,132, 131,131, 130,130, 129,129,129,129, 128,128, 127,127,127,127, 126,126, 125,125, 124,124,124,124, 123,123,123,123,123,123,123,123, 121, 122, 122, 121, 143,143,143,143,143,143,143,143, 167,167,167,167,167,167,167,167, & + ! + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 144,145,145,145,145,145,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,144,145,145,145,145,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,144,145,145,145,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,144,145,145,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,144,145,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,144,145,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,145,144,145, 168,168,168,168,168,168,168,168, & + 156,156, 155,155, 154,154, 153,153,153,153, 152,152, 151,151,151,151, 150,150, 149,149, 148,148,148,148, 147,147,147,147,147,147,147,147, 146, 146, 146, 146, 145,145,145,145,145,145,145,144, 168,168,168,168,168,168,168,168, & + ! + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,169,170,170,170,170,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,169,170,170,170,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,170,169,170,170,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 170,170,170,170,169,170,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,169,170,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,169,170, & + 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,170,169 & + ],shape(BCT_INTERACTIONSLIPSLIP)) + + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='lattice_interaction_SlipBySlip: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + interactionTypes = FCC_INTERACTIONSLIPSLIP + NslipMax = LATTICE_FCC_NSLIPSYSTEM + case('bcc') + interactionTypes = BCC_INTERACTIONSLIPSLIP + NslipMax = LATTICE_BCC_NSLIPSYSTEM + case('hex') + interactionTypes = HEX_INTERACTIONSLIPSLIP + NslipMax = LATTICE_HEX_NSLIPSYSTEM + case('bct') + interactionTypes = BCT_INTERACTIONSLIPSLIP + NslipMax = LATTICE_BCT_NSLIPSYSTEM + case default + call IO_error(137,ext_msg='lattice_interaction_SlipBySlip: '//trim(structure)) + end select + + interactionMatrix = buildInteraction(Nslip,Nslip,NslipMax,NslipMax,interactionValues,interactionTypes) + end function lattice_interaction_SlipBySlip - - + + !-------------------------------------------------------------------------------------------------- !> @brief Twin-twin interaction matrix !> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TwinByTwin(Ntwin,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error - - implicit none - integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(sum(Ntwin),sum(Ntwin)) :: interactionMatrix - - integer, dimension(:), allocatable :: NtwinMax - integer, dimension(:,:), allocatable :: interactionTypes - - integer, dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NTWIN), parameter :: & - FCC_INTERACTIONTWINTWIN = reshape( [& - 1,1,1,2,2,2,2,2,2,2,2,2, & - 1,1,1,2,2,2,2,2,2,2,2,2, & - 1,1,1,2,2,2,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1 & - ],shape(FCC_INTERACTIONTWINTWIN)) !< Twin-twin interaction types for fcc - - integer, dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NTWIN), parameter :: & - BCC_INTERACTIONTWINTWIN = reshape( [& - 1,3,3,3,3,3,3,2,3,3,2,3, & - 3,1,3,3,3,3,2,3,3,3,3,2, & - 3,3,1,3,3,2,3,3,2,3,3,3, & - 3,3,3,1,2,3,3,3,3,2,3,3, & - 3,3,3,2,1,3,3,3,3,2,3,3, & - 3,3,2,3,3,1,3,3,2,3,3,3, & - 3,2,3,3,3,3,1,3,3,3,3,2, & - 2,3,3,3,3,3,3,1,3,3,2,3, & - 3,3,2,3,3,2,3,3,1,3,3,3, & - 3,3,3,2,2,3,3,3,3,1,3,3, & - 2,3,3,3,3,3,3,2,3,3,1,3, & - 3,2,3,3,3,3,2,3,3,3,3,1 & - ],shape(BCC_INTERACTIONTWINTWIN)) !< Twin-twin interaction types for bcc + use IO, only: & + IO_error + + integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), dimension(sum(Ntwin),sum(Ntwin)) :: interactionMatrix + + integer, dimension(:), allocatable :: NtwinMax + integer, dimension(:,:), allocatable :: interactionTypes + + integer, dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NTWIN), parameter :: & + FCC_INTERACTIONTWINTWIN = reshape( [& + 1,1,1,2,2,2,2,2,2,2,2,2, & ! -----> acting + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 2,2,2,1,1,1,2,2,2,2,2,2, & ! v + 2,2,2,1,1,1,2,2,2,2,2,2, & ! reacting + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1 & + ],shape(FCC_INTERACTIONTWINTWIN)) !< Twin-twin interaction types for fcc + + integer, dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NTWIN), parameter :: & + BCC_INTERACTIONTWINTWIN = reshape( [& + 1,3,3,3,3,3,3,2,3,3,2,3, & ! -----> acting + 3,1,3,3,3,3,2,3,3,3,3,2, & ! | + 3,3,1,3,3,2,3,3,2,3,3,3, & ! | + 3,3,3,1,2,3,3,3,3,2,3,3, & ! v + 3,3,3,2,1,3,3,3,3,2,3,3, & ! reacting + 3,3,2,3,3,1,3,3,2,3,3,3, & + 3,2,3,3,3,3,1,3,3,3,3,2, & + 2,3,3,3,3,3,3,1,3,3,2,3, & + 3,3,2,3,3,2,3,3,1,3,3,3, & + 3,3,3,2,2,3,3,3,3,1,3,3, & + 2,3,3,3,3,3,3,2,3,3,1,3, & + 3,2,3,3,3,3,2,3,3,3,3,1 & + ],shape(BCC_INTERACTIONTWINTWIN)) !< Twin-twin interaction types for bcc !< 1: self interaction !< 2: collinear interaction !< 3: other interaction - integer, dimension(LATTICE_HEX_NTWIN,LATTICE_HEX_NTWIN), parameter :: & - HEX_INTERACTIONTWINTWIN = reshape( [& - 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & - 2, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & - 2, 2, 1, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & - 2, 2, 2, 1, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & - 2, 2, 2, 2, 1, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & - 2, 2, 2, 2, 2, 1, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & - ! - 6, 6, 6, 6, 6, 6, 4, 5, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 4, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 4, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 5, 4, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 4, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 5, 4, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - ! - 12,12,12,12,12,12, 11,11,11,11,11,11, 9,10,10,10,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10, 9,10,10,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10, 9,10,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10, 9,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10, 9,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10,10, 9, 15,15,15,15,15,15, & - ! - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 16,17,17,17,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,16,17,17,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,16,17,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,16,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,16,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,17,16 & - ],shape(HEX_INTERACTIONTWINTWIN)) !< Twin-twin interaction types for hex - - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='lattice_interaction_TwinByTwin: '//trim(structure)) - - select case(structure(1:3)) - case('fcc') - interactionTypes = FCC_INTERACTIONTWINTWIN - NtwinMax = LATTICE_FCC_NTWINSYSTEM - case('bcc') - interactionTypes = BCC_INTERACTIONTWINTWIN - NtwinMax = LATTICE_BCC_NTWINSYSTEM - case('hex') - interactionTypes = HEX_INTERACTIONTWINTWIN - NtwinMax = LATTICE_HEX_NTWINSYSTEM - case default - call IO_error(137,ext_msg='lattice_interaction_TwinByTwin: '//trim(structure)) - end select - - interactionMatrix = buildInteraction(Ntwin,Ntwin,NtwinMax,NtwinMax,interactionValues,interactionTypes) - + integer, dimension(LATTICE_HEX_NTWIN,LATTICE_HEX_NTWIN), parameter :: & + HEX_INTERACTIONTWINTWIN = reshape( [& + 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! -----> acting + 2, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! | + 2, 2, 1, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! | + 2, 2, 2, 1, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! v + 2, 2, 2, 2, 1, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! reacting + 2, 2, 2, 2, 2, 1, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & + ! + 6, 6, 6, 6, 6, 6, 4, 5, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 4, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 4, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 5, 4, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 4, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 5, 4, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + ! + 12,12,12,12,12,12, 11,11,11,11,11,11, 9,10,10,10,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10, 9,10,10,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10, 9,10,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10, 9,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10, 9,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10,10, 9, 15,15,15,15,15,15, & + ! + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 16,17,17,17,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,16,17,17,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,16,17,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,16,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,16,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,17,16 & + ],shape(HEX_INTERACTIONTWINTWIN)) !< Twin-twin interaction types for hex + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='lattice_interaction_TwinByTwin: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + interactionTypes = FCC_INTERACTIONTWINTWIN + NtwinMax = LATTICE_FCC_NTWINSYSTEM + case('bcc') + interactionTypes = BCC_INTERACTIONTWINTWIN + NtwinMax = LATTICE_BCC_NTWINSYSTEM + case('hex') + interactionTypes = HEX_INTERACTIONTWINTWIN + NtwinMax = LATTICE_HEX_NTWINSYSTEM + case default + call IO_error(137,ext_msg='lattice_interaction_TwinByTwin: '//trim(structure)) + end select + + interactionMatrix = buildInteraction(Ntwin,Ntwin,NtwinMax,NtwinMax,interactionValues,interactionTypes) + end function lattice_interaction_TwinByTwin - - + + !-------------------------------------------------------------------------------------------------- !> @brief Trans-trans interaction matrix !> details only active trans systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TransByTrans(Ntrans,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error - - implicit none - integer, dimension(:), intent(in) :: Ntrans !< number of active trans systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< values for trans-trans interaction - character(len=*), intent(in) :: structure !< lattice structure (parent crystal) - real(pReal), dimension(sum(Ntrans),sum(Ntrans)) :: interactionMatrix - - integer, dimension(:), allocatable :: NtransMax - integer, dimension(:,:), allocatable :: interactionTypes - - integer, dimension(LATTICE_FCC_NTRANS,LATTICE_FCC_NTRANS), parameter :: & - FCC_INTERACTIONTRANSTRANS = reshape( [& - 1,1,1,2,2,2,2,2,2,2,2,2, & - 1,1,1,2,2,2,2,2,2,2,2,2, & - 1,1,1,2,2,2,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1 & - ],shape(FCC_INTERACTIONTRANSTRANS)) !< Trans-trans interaction types for fcc - - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='lattice_interaction_TransByTrans: '//trim(structure)) - - if(structure(1:3) == 'fcc') then - interactionTypes = FCC_INTERACTIONTRANSTRANS - NtransMax = LATTICE_FCC_NTRANSSYSTEM - else - call IO_error(137,ext_msg='lattice_interaction_TransByTrans: '//trim(structure)) - end if - - interactionMatrix = buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTypes) - + use IO, only: & + IO_error + + integer, dimension(:), intent(in) :: Ntrans !< number of active trans systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< values for trans-trans interaction + character(len=*), intent(in) :: structure !< lattice structure (parent crystal) + real(pReal), dimension(sum(Ntrans),sum(Ntrans)) :: interactionMatrix + + integer, dimension(:), allocatable :: NtransMax + integer, dimension(:,:), allocatable :: interactionTypes + + integer, dimension(LATTICE_FCC_NTRANS,LATTICE_FCC_NTRANS), parameter :: & + FCC_INTERACTIONTRANSTRANS = reshape( [& + 1,1,1,2,2,2,2,2,2,2,2,2, & ! -----> acting + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 2,2,2,1,1,1,2,2,2,2,2,2, & ! v + 2,2,2,1,1,1,2,2,2,2,2,2, & ! reacting + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1 & + ],shape(FCC_INTERACTIONTRANSTRANS)) !< Trans-trans interaction types for fcc + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='lattice_interaction_TransByTrans: '//trim(structure)) + + if(structure(1:3) == 'fcc') then + interactionTypes = FCC_INTERACTIONTRANSTRANS + NtransMax = LATTICE_FCC_NTRANSSYSTEM + else + call IO_error(137,ext_msg='lattice_interaction_TransByTrans: '//trim(structure)) + end if + + interactionMatrix = buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTypes) + end function lattice_interaction_TransByTrans - - + + !-------------------------------------------------------------------------------------------------- !> @brief Slip-twin interaction matrix !> details only active slip and twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error - - implicit none - integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family - Ntwin !< number of active twin systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-twin interaction - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(sum(Ntwin),sum(Nslip)) :: interactionMatrix - - integer, dimension(:), allocatable :: NslipMax, & - NtwinMax - integer, dimension(:,:), allocatable :: interactionTypes - - integer, dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NSLIP), parameter :: & - FCC_INTERACTIONSLIPTWIN = reshape( [& - 1,1,1,3,3,3,2,2,2,3,3,3, & ! -----> twin - 1,1,1,3,3,3,3,3,3,2,2,2, & ! | - 1,1,1,2,2,2,3,3,3,3,3,3, & ! | - 3,3,3,1,1,1,3,3,3,2,2,2, & ! v slip - 3,3,3,1,1,1,2,2,2,3,3,3, & - 2,2,2,1,1,1,3,3,3,3,3,3, & - 2,2,2,3,3,3,1,1,1,3,3,3, & - 3,3,3,2,2,2,1,1,1,3,3,3, & - 3,3,3,3,3,3,1,1,1,2,2,2, & - 3,3,3,2,2,2,3,3,3,1,1,1, & - 2,2,2,3,3,3,3,3,3,1,1,1, & - 3,3,3,3,3,3,2,2,2,1,1,1, & - - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4 & - ],shape(FCC_INTERACTIONSLIPTWIN)) !< Slip-twin interaction types for fcc + use IO, only: & + IO_error + + integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family + Ntwin !< number of active twin systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-twin interaction + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), dimension(sum(Nslip),sum(Ntwin)) :: interactionMatrix + + integer, dimension(:), allocatable :: NslipMax, & + NtwinMax + integer, dimension(:,:), allocatable :: interactionTypes + + integer, dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NSLIP), parameter :: & + FCC_INTERACTIONSLIPTWIN = reshape( [& + 1,1,1,3,3,3,2,2,2,3,3,3, & ! -----> twin (acting) + 1,1,1,3,3,3,3,3,3,2,2,2, & ! | + 1,1,1,2,2,2,3,3,3,3,3,3, & ! | + 3,3,3,1,1,1,3,3,3,2,2,2, & ! v + 3,3,3,1,1,1,2,2,2,3,3,3, & ! slip (reacting) + 2,2,2,1,1,1,3,3,3,3,3,3, & + 2,2,2,3,3,3,1,1,1,3,3,3, & + 3,3,3,2,2,2,1,1,1,3,3,3, & + 3,3,3,3,3,3,1,1,1,2,2,2, & + 3,3,3,2,2,2,3,3,3,1,1,1, & + 2,2,2,3,3,3,3,3,3,1,1,1, & + 3,3,3,3,3,3,2,2,2,1,1,1, & + + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4 & + ],shape(FCC_INTERACTIONSLIPTWIN)) !< Slip-twin interaction types for fcc !< 1: coplanar interaction !< 2: screw trace between slip system and twin habit plane (easy cross slip) !< 3: other interaction - integer, dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NSLIP), parameter :: & - BCC_INTERACTIONSLIPTWIN = reshape( [& - 3,3,3,2,2,3,3,3,3,2,3,3, & ! -----> twin - 3,3,2,3,3,2,3,3,2,3,3,3, & ! | - 3,2,3,3,3,3,2,3,3,3,3,2, & ! | - 2,3,3,3,3,3,3,2,3,3,2,3, & ! v slip - 2,3,3,3,3,3,3,2,3,3,2,3, & - 3,3,2,3,3,2,3,3,2,3,3,3, & - 3,2,3,3,3,3,2,3,3,3,3,2, & - 3,3,3,2,2,3,3,3,3,2,3,3, & - 2,3,3,3,3,3,3,2,3,3,2,3, & - 3,3,3,2,2,3,3,3,3,2,3,3, & - 3,2,3,3,3,3,2,3,3,3,3,2, & - 3,3,2,3,3,2,3,3,2,3,3,3, & + integer, dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NSLIP), parameter :: & + BCC_INTERACTIONSLIPTWIN = reshape( [& + 3,3,3,2,2,3,3,3,3,2,3,3, & ! -----> twin (acting) + 3,3,2,3,3,2,3,3,2,3,3,3, & ! | + 3,2,3,3,3,3,2,3,3,3,3,2, & ! | + 2,3,3,3,3,3,3,2,3,3,2,3, & ! v + 2,3,3,3,3,3,3,2,3,3,2,3, & ! slip (reacting) + 3,3,2,3,3,2,3,3,2,3,3,3, & + 3,2,3,3,3,3,2,3,3,3,3,2, & + 3,3,3,2,2,3,3,3,3,2,3,3, & + 2,3,3,3,3,3,3,2,3,3,2,3, & + 3,3,3,2,2,3,3,3,3,2,3,3, & + 3,2,3,3,3,3,2,3,3,3,3,2, & + 3,3,2,3,3,2,3,3,2,3,3,3, & + ! + 1,3,3,3,3,3,3,2,3,3,2,3, & + 3,1,3,3,3,3,2,3,3,3,3,2, & + 3,3,1,3,3,2,3,3,2,3,3,3, & + 3,3,3,1,2,3,3,3,3,2,3,3, & + 3,3,3,2,1,3,3,3,3,2,3,3, & + 3,3,2,3,3,1,3,3,2,3,3,3, & + 3,2,3,3,3,3,1,3,3,3,3,2, & + 2,3,3,3,3,3,3,1,3,3,2,3, & + 3,3,2,3,3,2,3,3,1,3,3,3, & + 3,3,3,2,2,3,3,3,3,1,3,3, & + 2,3,3,3,3,3,3,2,3,3,1,3, & + 3,2,3,3,3,3,2,3,3,3,3,1 & + ],shape(BCC_INTERACTIONSLIPTWIN)) !< Slip-twin interaction types for bcc + !< 1: coplanar interaction + !< 2: screw trace between slip system and twin habit plane (easy cross slip) + !< 3: other interaction + integer, dimension(LATTICE_HEX_NTWIN,LATTICE_HEX_NSLIP), parameter :: & + HEX_INTERACTIONSLIPTWIN = reshape( [& + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! ----> twin (acting) + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | + ! v + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & ! slip (reacting) + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & ! - 1,3,3,3,3,3,3,2,3,3,2,3, & - 3,1,3,3,3,3,2,3,3,3,3,2, & - 3,3,1,3,3,2,3,3,2,3,3,3, & - 3,3,3,1,2,3,3,3,3,2,3,3, & - 3,3,3,2,1,3,3,3,3,2,3,3, & - 3,3,2,3,3,1,3,3,2,3,3,3, & - 3,2,3,3,3,3,1,3,3,3,3,2, & - 2,3,3,3,3,3,3,1,3,3,2,3, & - 3,3,2,3,3,2,3,3,1,3,3,3, & - 3,3,3,2,2,3,3,3,3,1,3,3, & - 2,3,3,3,3,3,3,2,3,3,1,3, & - 3,2,3,3,3,3,2,3,3,3,3,1 & - ],shape(BCC_INTERACTIONSLIPTWIN)) !< Slip-twin interaction types for bcc - !< 1: coplanar interaction - !< 2: screw trace between slip system and twin habit plane (easy cross slip) - !< 3: other interaction - integer, dimension(LATTICE_HEX_NTWIN,LATTICE_HEX_NSLIP), parameter :: & - HEX_INTERACTIONSLIPTWIN = reshape( [& - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! ----> twin - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | - ! v - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & ! slip - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & - ! - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - ! - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - ! - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - ! - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24 & - ! - ],shape(HEX_INTERACTIONSLIPTWIN)) !< Slip-twin interaction types for hex - - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='lattice_interaction_SlipByTwin: '//trim(structure)) - - select case(structure(1:3)) - case('fcc') - interactionTypes = FCC_INTERACTIONSLIPTWIN - NslipMax = LATTICE_FCC_NSLIPSYSTEM - NtwinMax = LATTICE_FCC_NTWINSYSTEM - case('bcc') - interactionTypes = BCC_INTERACTIONSLIPTWIN - NslipMax = LATTICE_BCC_NSLIPSYSTEM - NtwinMax = LATTICE_BCC_NTWINSYSTEM - case('hex') - interactionTypes = HEX_INTERACTIONSLIPTWIN - NslipMax = LATTICE_HEX_NSLIPSYSTEM - NtwinMax = LATTICE_HEX_NTWINSYSTEM - case default - call IO_error(137,ext_msg='lattice_interaction_SlipByTwin: '//trim(structure)) - end select - - interactionMatrix = buildInteraction(Ntwin,Nslip,NtwinMax,NslipMax,interactionValues,interactionTypes) - + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + ! + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + ! + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + ! + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24 & + ! + ],shape(HEX_INTERACTIONSLIPTWIN)) !< Slip-twin interaction types for hex + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='lattice_interaction_SlipByTwin: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + interactionTypes = FCC_INTERACTIONSLIPTWIN + NslipMax = LATTICE_FCC_NSLIPSYSTEM + NtwinMax = LATTICE_FCC_NTWINSYSTEM + case('bcc') + interactionTypes = BCC_INTERACTIONSLIPTWIN + NslipMax = LATTICE_BCC_NSLIPSYSTEM + NtwinMax = LATTICE_BCC_NTWINSYSTEM + case('hex') + interactionTypes = HEX_INTERACTIONSLIPTWIN + NslipMax = LATTICE_HEX_NSLIPSYSTEM + NtwinMax = LATTICE_HEX_NTWINSYSTEM + case default + call IO_error(137,ext_msg='lattice_interaction_SlipByTwin: '//trim(structure)) + end select + + interactionMatrix = buildInteraction(Nslip,Ntwin,NslipMax,NtwinMax,interactionValues,interactionTypes) + end function lattice_interaction_SlipByTwin - - + + !-------------------------------------------------------------------------------------------------- !> @brief Slip-trans interaction matrix !> details only active slip and trans systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error - - implicit none - integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family - Ntrans !< number of active trans systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-trans interaction - character(len=*), intent(in) :: structure !< lattice structure (parent crystal) - real(pReal), dimension(sum(Ntrans),sum(Nslip)) :: interactionMatrix - - integer, dimension(:), allocatable :: NslipMax, & - NtransMax - integer, dimension(:,:), allocatable :: interactionTypes - - integer, dimension(LATTICE_FCC_NTRANS,LATTICE_FCC_NSLIP), parameter :: & - FCC_INTERACTIONSLIPTRANS = reshape( [& - 1,1,1,3,3,3,2,2,2,3,3,3, & ! -----> trans - 1,1,1,3,3,3,3,3,3,2,2,2, & ! | - 1,1,1,2,2,2,3,3,3,3,3,3, & ! | - 3,3,3,1,1,1,3,3,3,2,2,2, & ! v slip - 3,3,3,1,1,1,2,2,2,3,3,3, & - 2,2,2,1,1,1,3,3,3,3,3,3, & - 2,2,2,3,3,3,1,1,1,3,3,3, & - 3,3,3,2,2,2,1,1,1,3,3,3, & - 3,3,3,3,3,3,1,1,1,2,2,2, & - 3,3,3,2,2,2,3,3,3,1,1,1, & - 2,2,2,3,3,3,3,3,3,1,1,1, & - 3,3,3,3,3,3,2,2,2,1,1,1, & - - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4 & - ],shape(FCC_INTERACTIONSLIPTRANS)) !< Slip-trans interaction types for fcc - - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='lattice_interaction_SlipByTrans: '//trim(structure)) - - select case(structure(1:3)) - case('fcc') - interactionTypes = FCC_INTERACTIONSLIPTRANS - NslipMax = LATTICE_FCC_NSLIPSYSTEM - NtransMax = LATTICE_FCC_NTRANSSYSTEM - case default - call IO_error(137,ext_msg='lattice_interaction_SlipByTrans: '//trim(structure)) - end select - - interactionMatrix = buildInteraction(Ntrans,Nslip,NtransMax,NslipMax,interactionValues,interactionTypes) - -end function lattice_interaction_SlipByTrans - - + use IO, only: & + IO_error + + integer, dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family + Ntrans !< number of active trans systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-trans interaction + character(len=*), intent(in) :: structure !< lattice structure (parent crystal) + real(pReal), dimension(sum(Nslip),sum(Ntrans)) :: interactionMatrix + + integer, dimension(:), allocatable :: NslipMax, & + NtransMax + integer, dimension(:,:), allocatable :: interactionTypes + + integer, dimension(LATTICE_FCC_NTRANS,LATTICE_FCC_NSLIP), parameter :: & + FCC_INTERACTIONSLIPTRANS = reshape( [& + 1,1,1,3,3,3,2,2,2,3,3,3, & ! -----> trans (acting) + 1,1,1,3,3,3,3,3,3,2,2,2, & ! | + 1,1,1,2,2,2,3,3,3,3,3,3, & ! | + 3,3,3,1,1,1,3,3,3,2,2,2, & ! v + 3,3,3,1,1,1,2,2,2,3,3,3, & ! slip (reacting) + 2,2,2,1,1,1,3,3,3,3,3,3, & + 2,2,2,3,3,3,1,1,1,3,3,3, & + 3,3,3,2,2,2,1,1,1,3,3,3, & + 3,3,3,3,3,3,1,1,1,2,2,2, & + 3,3,3,2,2,2,3,3,3,1,1,1, & + 2,2,2,3,3,3,3,3,3,1,1,1, & + 3,3,3,3,3,3,2,2,2,1,1,1, & + + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4 & + ],shape(FCC_INTERACTIONSLIPTRANS)) !< Slip-trans interaction types for fcc + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='lattice_interaction_SlipByTrans: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + interactionTypes = FCC_INTERACTIONSLIPTRANS + NslipMax = LATTICE_FCC_NSLIPSYSTEM + NtransMax = LATTICE_FCC_NTRANSSYSTEM + case default + call IO_error(137,ext_msg='lattice_interaction_SlipByTrans: '//trim(structure)) + end select + + interactionMatrix = buildInteraction(Nslip,Ntrans,NslipMax,NtransMax,interactionValues,interactionTypes) + + end function lattice_interaction_SlipByTrans + + !-------------------------------------------------------------------------------------------------- !> @brief Twin-slip interaction matrix !> details only active twin and slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error - - implicit none - integer, dimension(:), intent(in) :: Ntwin, & !< number of active twin systems per family - Nslip !< number of active slip systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(sum(Nslip),sum(Ntwin)) :: interactionMatrix - - integer, dimension(:), allocatable :: NtwinMax, & - NslipMax - integer, dimension(:,:), allocatable :: interactionTypes - - integer, dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NTWIN), parameter :: & - FCC_INTERACTIONTWINSLIP = 1 !< Twin-Slip interaction types for fcc - - integer, dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NTWIN), parameter :: & - BCC_INTERACTIONTWINSLIP = 1 !< Twin-slip interaction types for bcc - - integer, dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NTWIN), parameter :: & - HEX_INTERACTIONTWINSLIP = reshape( [& - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! ----> slip - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! v - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! twin - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & - ! - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - ! - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - ! - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24 & - ],shape(HEX_INTERACTIONTWINSLIP)) !< Twin-twin interaction types for hex - - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='lattice_interaction_TwinBySlip: '//trim(structure)) - - select case(structure(1:3)) - case('fcc') - interactionTypes = FCC_INTERACTIONTWINSLIP - NtwinMax = LATTICE_FCC_NTWINSYSTEM - NslipMax = LATTICE_FCC_NSLIPSYSTEM - case('bcc') - interactionTypes = BCC_INTERACTIONTWINSLIP - NtwinMax = LATTICE_BCC_NTWINSYSTEM - NslipMax = LATTICE_BCC_NSLIPSYSTEM - case('hex') - interactionTypes = HEX_INTERACTIONTWINSLIP - NtwinMax = LATTICE_HEX_NTWINSYSTEM - NslipMax = LATTICE_HEX_NSLIPSYSTEM - case default - call IO_error(137,ext_msg='lattice_interaction_TwinBySlip: '//trim(structure)) - end select - - interactionMatrix = buildInteraction(Nslip,Ntwin,NslipMax,NtwinMax,interactionValues,interactionTypes) - + use IO, only: & + IO_error + + integer, dimension(:), intent(in) :: Ntwin, & !< number of active twin systems per family + Nslip !< number of active slip systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), dimension(sum(Ntwin),sum(Nslip)) :: interactionMatrix + + integer, dimension(:), allocatable :: NtwinMax, & + NslipMax + integer, dimension(:,:), allocatable :: interactionTypes + + integer, dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NTWIN), parameter :: & + FCC_INTERACTIONTWINSLIP = 1 !< Twin-slip interaction types for fcc + + integer, dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NTWIN), parameter :: & + BCC_INTERACTIONTWINSLIP = 1 !< Twin-slip interaction types for bcc + + integer, dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NTWIN), parameter :: & + HEX_INTERACTIONTWINSLIP = reshape( [& + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! ----> slip (acting) + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! v + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! twin (reacting) + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & + ! + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + ! + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + ! + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24 & + ],shape(HEX_INTERACTIONTWINSLIP)) !< Twin-slip interaction types for hex + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='lattice_interaction_TwinBySlip: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + interactionTypes = FCC_INTERACTIONTWINSLIP + NtwinMax = LATTICE_FCC_NTWINSYSTEM + NslipMax = LATTICE_FCC_NSLIPSYSTEM + case('bcc') + interactionTypes = BCC_INTERACTIONTWINSLIP + NtwinMax = LATTICE_BCC_NTWINSYSTEM + NslipMax = LATTICE_BCC_NSLIPSYSTEM + case('hex') + interactionTypes = HEX_INTERACTIONTWINSLIP + NtwinMax = LATTICE_HEX_NTWINSYSTEM + NslipMax = LATTICE_HEX_NSLIPSYSTEM + case default + call IO_error(137,ext_msg='lattice_interaction_TwinBySlip: '//trim(structure)) + end select + + interactionMatrix = buildInteraction(Ntwin,Nslip,NtwinMax,NslipMax,interactionValues,interactionTypes) + end function lattice_interaction_TwinBySlip - - + + !-------------------------------------------------------------------------------------------------- !> @brief Schmid matrix for slip !> details only active slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) - use prec, only: & - tol_math_check - use IO, only: & - IO_error - use math, only: & - math_trace33, & - math_outer - - implicit none - integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA - real(pReal), dimension(3,3,sum(Nslip)) :: SchmidMatrix - - real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem - real(pReal), dimension(:,:), allocatable :: slipSystems - integer, dimension(:), allocatable :: NslipMax - integer :: i + use prec, only: & + tol_math_check + use IO, only: & + IO_error + use math, only: & + math_trace33, & + math_outer + + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA + real(pReal), dimension(3,3,sum(Nslip)) :: SchmidMatrix + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + real(pReal), dimension(:,:), allocatable :: slipSystems + integer, dimension(:), allocatable :: NslipMax + integer :: i + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='lattice_SchmidMatrix_slip: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + NslipMax = LATTICE_FCC_NSLIPSYSTEM + slipSystems = LATTICE_FCC_SYSTEMSLIP + case('bcc') + NslipMax = LATTICE_BCC_NSLIPSYSTEM + slipSystems = LATTICE_BCC_SYSTEMSLIP + case('hex') + NslipMax = LATTICE_HEX_NSLIPSYSTEM + slipSystems = LATTICE_HEX_SYSTEMSLIP + case('bct') + NslipMax = LATTICE_BCT_NSLIPSYSTEM + slipSystems = LATTICE_BCT_SYSTEMSLIP + case default + call IO_error(137,ext_msg='lattice_SchmidMatrix_slip: '//trim(structure)) + end select + + if (any(NslipMax(1:size(Nslip)) - Nslip < 0)) & + call IO_error(145,ext_msg='Nslip '//trim(structure)) + if (any(Nslip < 0)) & + call IO_error(144,ext_msg='Nslip '//trim(structure)) + + coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) + + do i = 1, sum(Nslip) + SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & + call IO_error(0,i,ext_msg = 'dilatational Schmid matrix for slip') + enddo - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='lattice_SchmidMatrix_slip: '//trim(structure)) - - select case(structure(1:3)) - case('fcc') - NslipMax = LATTICE_FCC_NSLIPSYSTEM - slipSystems = LATTICE_FCC_SYSTEMSLIP - case('bcc') - NslipMax = LATTICE_BCC_NSLIPSYSTEM - slipSystems = LATTICE_BCC_SYSTEMSLIP - case('hex') - NslipMax = LATTICE_HEX_NSLIPSYSTEM - slipSystems = LATTICE_HEX_SYSTEMSLIP - case('bct') - NslipMax = LATTICE_BCT_NSLIPSYSTEM - slipSystems = LATTICE_BCT_SYSTEMSLIP - case default - call IO_error(137,ext_msg='lattice_SchmidMatrix_slip: '//trim(structure)) - end select - - if (any(NslipMax(1:size(Nslip)) - Nslip < 0)) & - call IO_error(145,ext_msg='Nslip '//trim(structure)) - if (any(Nslip < 0)) & - call IO_error(144,ext_msg='Nslip '//trim(structure)) - - coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) - - do i = 1, sum(Nslip) - SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) - if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & - call IO_error(0,i,ext_msg = 'dilatational Schmid matrix for slip') - enddo - end function lattice_SchmidMatrix_slip - - + + !-------------------------------------------------------------------------------------------------- !> @brief Schmid matrix for twinning !> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) - use prec, only: & - tol_math_check - use IO, only: & - IO_error - use math, only: & - math_trace33, & - math_outer - - implicit none - integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA !< c/a ratio - real(pReal), dimension(3,3,sum(Ntwin)) :: SchmidMatrix - - real(pReal), dimension(3,3,sum(Ntwin)) :: coordinateSystem - real(pReal), dimension(:,:), allocatable :: twinSystems - integer, dimension(:), allocatable :: NtwinMax - integer :: i - - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='lattice_SchmidMatrix_twin: '//trim(structure)) - - select case(structure(1:3)) - case('fcc') - NtwinMax = LATTICE_FCC_NTWINSYSTEM - twinSystems = LATTICE_FCC_SYSTEMTWIN - case('bcc') - NtwinMax = LATTICE_BCC_NTWINSYSTEM - twinSystems = LATTICE_BCC_SYSTEMTWIN - case('hex') - NtwinMax = LATTICE_HEX_NTWINSYSTEM - twinSystems = LATTICE_HEX_SYSTEMTWIN - case default - call IO_error(137,ext_msg='lattice_SchmidMatrix_twin: '//trim(structure)) - end select - - if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0)) & - call IO_error(145,ext_msg='Ntwin '//trim(structure)) - if (any(Ntwin < 0)) & - call IO_error(144,ext_msg='Ntwin '//trim(structure)) - - coordinateSystem = buildCoordinateSystem(Ntwin,NtwinMax,twinSystems,structure,cOverA) - - do i = 1, sum(Ntwin) - SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) - if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & - call IO_error(0,i,ext_msg = 'dilatational Schmid matrix for twin') - enddo - -end function lattice_SchmidMatrix_twin - - + use prec, only: & + tol_math_check + use IO, only: & + IO_error + use math, only: & + math_trace33, & + math_outer + + integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,3,sum(Ntwin)) :: SchmidMatrix + + real(pReal), dimension(3,3,sum(Ntwin)) :: coordinateSystem + real(pReal), dimension(:,:), allocatable :: twinSystems + integer, dimension(:), allocatable :: NtwinMax + integer :: i + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='lattice_SchmidMatrix_twin: '//trim(structure)) + + select case(structure(1:3)) + case('fcc') + NtwinMax = LATTICE_FCC_NTWINSYSTEM + twinSystems = LATTICE_FCC_SYSTEMTWIN + case('bcc') + NtwinMax = LATTICE_BCC_NTWINSYSTEM + twinSystems = LATTICE_BCC_SYSTEMTWIN + case('hex') + NtwinMax = LATTICE_HEX_NTWINSYSTEM + twinSystems = LATTICE_HEX_SYSTEMTWIN + case default + call IO_error(137,ext_msg='lattice_SchmidMatrix_twin: '//trim(structure)) + end select + + if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0)) & + call IO_error(145,ext_msg='Ntwin '//trim(structure)) + if (any(Ntwin < 0)) & + call IO_error(144,ext_msg='Ntwin '//trim(structure)) + + coordinateSystem = buildCoordinateSystem(Ntwin,NtwinMax,twinSystems,structure,cOverA) + + do i = 1, sum(Ntwin) + SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & + call IO_error(0,i,ext_msg = 'dilatational Schmid matrix for twin') + enddo + + end function lattice_SchmidMatrix_twin + + !-------------------------------------------------------------------------------------------------- !> @brief Schmid matrix for twinning !> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc) result(SchmidMatrix) - use IO, only: & - IO_error - - implicit none - integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family - real(pReal), intent(in) :: cOverA !< c/a ratio - character(len=*), intent(in) :: structure_target !< lattice structure - real(pReal), dimension(3,3,sum(Ntrans)) :: SchmidMatrix - - real(pReal), dimension(3,3,sum(Ntrans)):: devNull - real(pReal) :: a_bcc, a_fcc - - if (len_trim(structure_target) /= 3) & - call IO_error(137,ext_msg='lattice_SchmidMatrix_trans (target): '//trim(structure_target)) - if (structure_target(1:3) /= 'bcc' .and. structure_target(1:3) /= 'hex') & - call IO_error(137,ext_msg='lattice_SchmidMatrix_trans (target): '//trim(structure_target)) - - !ToDo: add checks for CoverA_trans,a_fcc,a_bcc - - call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,cOverA,a_fcc,a_bcc) - - end function lattice_SchmidMatrix_trans - - + use IO, only: & + IO_error + + integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family + real(pReal), intent(in) :: cOverA !< c/a ratio + character(len=*), intent(in) :: structure_target !< lattice structure + real(pReal), dimension(3,3,sum(Ntrans)) :: SchmidMatrix + + real(pReal), dimension(3,3,sum(Ntrans)):: devNull + real(pReal) :: a_bcc, a_fcc + + if (len_trim(structure_target) /= 3) & + call IO_error(137,ext_msg='lattice_SchmidMatrix_trans (target): '//trim(structure_target)) + if (structure_target(1:3) /= 'bcc' .and. structure_target(1:3) /= 'hex') & + call IO_error(137,ext_msg='lattice_SchmidMatrix_trans (target): '//trim(structure_target)) + + !ToDo: add checks for CoverA_trans,a_fcc,a_bcc + + call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,cOverA,a_fcc,a_bcc) + +end function lattice_SchmidMatrix_trans + + !-------------------------------------------------------------------------------------------------- !> @brief Schmid matrix for cleavage !> details only active cleavage systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(SchmidMatrix) - use math, only: & - math_outer - use IO, only: & - IO_error - - implicit none - integer, dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA !< c/a ratio - real(pReal), dimension(3,3,3,sum(Ncleavage)) :: SchmidMatrix - - real(pReal), dimension(3,3,sum(Ncleavage)) :: coordinateSystem - real(pReal), dimension(:,:), allocatable :: cleavageSystems - integer, dimension(:), allocatable :: NcleavageMax - integer :: i + use math, only: & + math_outer + use IO, only: & + IO_error + + integer, dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,3,3,sum(Ncleavage)) :: SchmidMatrix + + real(pReal), dimension(3,3,sum(Ncleavage)) :: coordinateSystem + real(pReal), dimension(:,:), allocatable :: cleavageSystems + integer, dimension(:), allocatable :: NcleavageMax + integer :: i + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='lattice_SchmidMatrix_cleavage: '//trim(structure)) + + select case(structure(1:3)) + case('iso') + NcleavageMax = LATTICE_ISO_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_ISO_SYSTEMCLEAVAGE + case('ort') + NcleavageMax = LATTICE_ORT_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_ORT_SYSTEMCLEAVAGE + case('fcc') + NcleavageMax = LATTICE_FCC_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_FCC_SYSTEMCLEAVAGE + case('bcc') + NcleavageMax = LATTICE_BCC_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_BCC_SYSTEMCLEAVAGE + case('hex') + NcleavageMax = LATTICE_HEX_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_HEX_SYSTEMCLEAVAGE + case default + call IO_error(137,ext_msg='lattice_SchmidMatrix_cleavage: '//trim(structure)) + end select + + if (any(NcleavageMax(1:size(Ncleavage)) - Ncleavage < 0)) & + call IO_error(145,ext_msg='Ncleavage '//trim(structure)) + if (any(Ncleavage < 0)) & + call IO_error(144,ext_msg='Ncleavage '//trim(structure)) + + coordinateSystem = buildCoordinateSystem(Ncleavage,NcleavageMax,cleavageSystems,structure,cOverA) + + do i = 1, sum(Ncleavage) + SchmidMatrix(1:3,1:3,1,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,2,i) = math_outer(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,3,i) = math_outer(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i)) + enddo - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='lattice_SchmidMatrix_cleavage: '//trim(structure)) - - select case(structure(1:3)) - case('iso') - NcleavageMax = LATTICE_ISO_NCLEAVAGESYSTEM - cleavageSystems = LATTICE_ISO_SYSTEMCLEAVAGE - case('ort') - NcleavageMax = LATTICE_ORT_NCLEAVAGESYSTEM - cleavageSystems = LATTICE_ORT_SYSTEMCLEAVAGE - case('fcc') - NcleavageMax = LATTICE_FCC_NCLEAVAGESYSTEM - cleavageSystems = LATTICE_FCC_SYSTEMCLEAVAGE - case('bcc') - NcleavageMax = LATTICE_BCC_NCLEAVAGESYSTEM - cleavageSystems = LATTICE_BCC_SYSTEMCLEAVAGE - case('hex') - NcleavageMax = LATTICE_HEX_NCLEAVAGESYSTEM - cleavageSystems = LATTICE_HEX_SYSTEMCLEAVAGE - case default - call IO_error(137,ext_msg='lattice_SchmidMatrix_cleavage: '//trim(structure)) - end select - - if (any(NcleavageMax(1:size(Ncleavage)) - Ncleavage < 0)) & - call IO_error(145,ext_msg='Ncleavage '//trim(structure)) - if (any(Ncleavage < 0)) & - call IO_error(144,ext_msg='Ncleavage '//trim(structure)) - - coordinateSystem = buildCoordinateSystem(Ncleavage,NcleavageMax,cleavageSystems,structure,cOverA) - - do i = 1, sum(Ncleavage) - SchmidMatrix(1:3,1:3,1,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) - SchmidMatrix(1:3,1:3,2,i) = math_outer(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i)) - SchmidMatrix(1:3,1:3,3,i) = math_outer(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i)) - enddo - end function lattice_SchmidMatrix_cleavage - - + + !-------------------------------------------------------------------------------------------------- !> @brief Slip direction of slip systems (|| b) !-------------------------------------------------------------------------------------------------- function lattice_slip_direction(Nslip,structure,cOverA) result(d) - - implicit none - integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA !< c/a ratio - real(pReal), dimension(3,sum(Nslip)) :: d - - real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem - coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) - d = coordinateSystem(1:3,1,1:sum(Nslip)) - + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,sum(Nslip)) :: d + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + + coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) + d = coordinateSystem(1:3,1,1:sum(Nslip)) + end function lattice_slip_direction - - + + !-------------------------------------------------------------------------------------------------- !> @brief Normal direction of slip systems (|| n) !-------------------------------------------------------------------------------------------------- function lattice_slip_normal(Nslip,structure,cOverA) result(n) - - implicit none - integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA !< c/a ratio - real(pReal), dimension(3,sum(Nslip)) :: n - - real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem - coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) - n = coordinateSystem(1:3,2,1:sum(Nslip)) - + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,sum(Nslip)) :: n + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + + coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) + n = coordinateSystem(1:3,2,1:sum(Nslip)) + end function lattice_slip_normal + !-------------------------------------------------------------------------------------------------- !> @brief Transverse direction of slip systems ( || t = b x n) !-------------------------------------------------------------------------------------------------- function lattice_slip_transverse(Nslip,structure,cOverA) result(t) - - implicit none - integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA !< c/a ratio - real(pReal), dimension(3,sum(Nslip)) :: t - - real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem - coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) - t = coordinateSystem(1:3,3,1:sum(Nslip)) - + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,sum(Nslip)) :: t + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + + coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) + t = coordinateSystem(1:3,3,1:sum(Nslip)) + end function lattice_slip_transverse - - + + !-------------------------------------------------------------------------------------------------- !> @brief Projection of the transverse direction onto the slip plane !> @details: This projection is used to calculate forest hardening for edge dislocations !-------------------------------------------------------------------------------------------------- function slipProjection_transverse(Nslip,structure,cOverA) result(projection) - use math, only: & - math_inner - - implicit none - integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA !< c/a ratio - real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection - - real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem - integer :: i, j + use math, only: & + math_inner + + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + integer :: i, j + + coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) + + do i=1, sum(Nslip); do j=1, sum(Nslip) + projection(i,j) = abs(math_inner(coordinateSystem(1:3,2,i),coordinateSystem(1:3,3,j))) + enddo; enddo - coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) - - do i=1, sum(Nslip); do j=1, sum(Nslip) - projection(i,j) = abs(math_inner(coordinateSystem(1:3,2,i),coordinateSystem(1:3,3,j))) - enddo; enddo - end function slipProjection_transverse - - + + !-------------------------------------------------------------------------------------------------- !> @brief Projection of the slip direction onto the slip plane !> @details: This projection is used to calculate forest hardening for screw dislocations !-------------------------------------------------------------------------------------------------- function slipProjection_direction(Nslip,structure,cOverA) result(projection) - use math, only: & - math_inner - - implicit none - integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA !< c/a ratio - real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection - - real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem - integer :: i, j + use math, only: & + math_inner + + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + integer :: i, j + + coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) + + do i=1, sum(Nslip); do j=1, sum(Nslip) + projection(i,j) = abs(math_inner(coordinateSystem(1:3,2,i),coordinateSystem(1:3,1,j))) + enddo; enddo - coordinateSystem = coordinateSystem_slip(Nslip,structure,cOverA) - - do i=1, sum(Nslip); do j=1, sum(Nslip) - projection(i,j) = abs(math_inner(coordinateSystem(1:3,2,i),coordinateSystem(1:3,1,j))) - enddo; enddo - end function slipProjection_direction - - + + !-------------------------------------------------------------------------------------------------- !> @brief build a local coordinate system on slip systems !> @details Order: Direction, plane (normal), and common perpendicular !-------------------------------------------------------------------------------------------------- function coordinateSystem_slip(Nslip,structure,cOverA) result(coordinateSystem) - use IO, only: & - IO_error - - implicit none - integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA !< c/a ratio - real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem - - real(pReal), dimension(:,:), allocatable :: slipSystems - integer, dimension(:), allocatable :: NslipMax - - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='coordinateSystem_slip: '//trim(structure)) - - select case(structure(1:3)) - case('fcc') - NslipMax = LATTICE_FCC_NSLIPSYSTEM - slipSystems = LATTICE_FCC_SYSTEMSLIP - case('bcc') - NslipMax = LATTICE_BCC_NSLIPSYSTEM - slipSystems = LATTICE_BCC_SYSTEMSLIP - case('hex') - NslipMax = LATTICE_HEX_NSLIPSYSTEM - slipSystems = LATTICE_HEX_SYSTEMSLIP - case('bct') - NslipMax = LATTICE_BCT_NSLIPSYSTEM - slipSystems = LATTICE_BCT_SYSTEMSLIP - case default - call IO_error(137,ext_msg='coordinateSystem_slip: '//trim(structure)) - end select - - if (any(NslipMax(1:size(Nslip)) - Nslip < 0)) & - call IO_error(145,ext_msg='Nslip '//trim(structure)) - if (any(Nslip < 0)) & - call IO_error(144,ext_msg='Nslip '//trim(structure)) - - coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) - -end function coordinateSystem_slip - - -!-------------------------------------------------------------------------------------------------- -!> @brief Populates reduced interaction matrix -!-------------------------------------------------------------------------------------------------- -function buildInteraction(acting_used,reacting_used,acting_max,reacting_max,values,matrix) use IO, only: & IO_error - implicit none - integer, dimension(:), intent(in) :: & - acting_used, & !< # of acting systems per family as specified in material.config - reacting_used, & !< # of reacting systems per family as specified in material.config - acting_max, & !< max # of acting systems per family for given lattice - reacting_max !< max # of reacting systems per family for given lattice - real(pReal), dimension(:), intent(in) :: values !< interaction values - integer, dimension(:,:), intent(in) :: matrix !< interaction types - real(pReal), dimension(sum(acting_used),sum(reacting_used)) :: buildInteraction + integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + + real(pReal), dimension(:,:), allocatable :: slipSystems + integer, dimension(:), allocatable :: NslipMax - integer :: & - acting_family_index, acting_family, acting_system, & - reacting_family_index, reacting_family, reacting_system, & - i,j,k,l + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='coordinateSystem_slip: '//trim(structure)) - do acting_family = 1,size(acting_used,1) - acting_family_index = sum(acting_used(1:acting_family-1)) - do acting_system = 1,acting_used(acting_family) + select case(structure(1:3)) + case('fcc') + NslipMax = LATTICE_FCC_NSLIPSYSTEM + slipSystems = LATTICE_FCC_SYSTEMSLIP + case('bcc') + NslipMax = LATTICE_BCC_NSLIPSYSTEM + slipSystems = LATTICE_BCC_SYSTEMSLIP + case('hex') + NslipMax = LATTICE_HEX_NSLIPSYSTEM + slipSystems = LATTICE_HEX_SYSTEMSLIP + case('bct') + NslipMax = LATTICE_BCT_NSLIPSYSTEM + slipSystems = LATTICE_BCT_SYSTEMSLIP + case default + call IO_error(137,ext_msg='coordinateSystem_slip: '//trim(structure)) + end select + + if (any(NslipMax(1:size(Nslip)) - Nslip < 0)) & + call IO_error(145,ext_msg='Nslip '//trim(structure)) + if (any(Nslip < 0)) & + call IO_error(144,ext_msg='Nslip '//trim(structure)) + + coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) + +end function coordinateSystem_slip + + +!-------------------------------------------------------------------------------------------------- +!> @brief Populates reduced interaction matrix +!-------------------------------------------------------------------------------------------------- +function buildInteraction(reacting_used,acting_used,reacting_max,acting_max,values,matrix) + use IO, only: & + IO_error + + integer, dimension(:), intent(in) :: & + reacting_used, & !< # of reacting systems per family as specified in material.config + acting_used, & !< # of acting systems per family as specified in material.config + reacting_max, & !< max # of reacting systems per family for given lattice + acting_max !< max # of acting systems per family for given lattice + real(pReal), dimension(:), intent(in) :: values !< interaction values + integer, dimension(:,:), intent(in) :: matrix !< interaction types + real(pReal), dimension(sum(reacting_used),sum(acting_used)) :: buildInteraction + + integer :: & + acting_family_index, acting_family, acting_system, & + reacting_family_index, reacting_family, reacting_system, & + i,j,k,l + + do acting_family = 1,size(acting_used,1) + acting_family_index = sum(acting_used(1:acting_family-1)) + do acting_system = 1,acting_used(acting_family) + + do reacting_family = 1,size(reacting_used,1) + reacting_family_index = sum(reacting_used(1:reacting_family-1)) + do reacting_system = 1,reacting_used(reacting_family) + + i = sum( acting_max(1: acting_family-1)) + acting_system + j = sum(reacting_max(1:reacting_family-1)) + reacting_system + + k = acting_family_index + acting_system + l = reacting_family_index + reacting_system + + if (matrix(i,j) > size(values)) call IO_error(138,ext_msg='buildInteraction') + + buildInteraction(l,k) = values(matrix(i,j)) + + enddo; enddo + enddo; enddo - do reacting_family = 1,size(reacting_used,1) - reacting_family_index = sum(reacting_used(1:reacting_family-1)) - do reacting_system = 1,reacting_used(reacting_family) - - i = sum( acting_max(1: acting_family-1)) + acting_system - j = sum(reacting_max(1:reacting_family-1)) + reacting_system - - k = acting_family_index + acting_system - l = reacting_family_index + reacting_system - - if (matrix(i,j) > size(values)) call IO_error(138,ext_msg='buildInteraction') - - buildInteraction(k,l) = values(matrix(i,j)) - - enddo; enddo - enddo; enddo - end function buildInteraction - - + + !-------------------------------------------------------------------------------------------------- !> @brief build a local coordinate system on slip, twin, trans, cleavage systems !> @details Order: Direction, plane (normal), and common perpendicular !-------------------------------------------------------------------------------------------------- function buildCoordinateSystem(active,complete,system,structure,cOverA) - use IO, only: & - IO_error - use math, only: & - math_cross - - implicit none - integer, dimension(:), intent(in) :: & - active, & - complete - real(pReal), dimension(:,:), intent(in) :: & - system - character(len=*), intent(in) :: & - structure !< lattice structure - real(pReal), intent(in) :: & - cOverA - real(pReal), dimension(3,3,sum(active)) :: & - buildCoordinateSystem - - real(pReal), dimension(3) :: & - direction, normal - integer :: & - a, & !< index of active system - c, & !< index in complete system matrix - f, & !< index of my family - s !< index of my system in current family - - if (len_trim(structure) /= 3) & - call IO_error(137,ext_msg='buildCoordinateSystem: '//trim(structure)) - if (trim(structure(1:3)) == 'bct' .and. cOverA > 2.0_pReal) & - call IO_error(131,ext_msg='buildCoordinateSystem:'//trim(structure)) - if (trim(structure(1:3)) == 'hex' .and. (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal)) & - call IO_error(131,ext_msg='buildCoordinateSystem:'//trim(structure)) - - a = 0 - activeFamilies: do f = 1,size(active,1) - activeSystems: do s = 1,active(f) - a = a + 1 - c = sum(complete(1:f-1))+s - - select case(trim(structure(1:3))) - - case ('fcc','bcc','iso','ort','bct') - direction = system(1:3,c) - normal = system(4:6,c) - - case ('hex') - direction = [ system(1,c)*1.5_pReal, & - (system(1,c)+2.0_pReal*system(2,c))*sqrt(0.75_pReal), & - system(4,c)*cOverA ] ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]) - normal = [ system(5,c), & - (system(5,c)+2.0_pReal*system(6,c))/sqrt(3.0_pReal), & - system(8,c)/cOverA ] ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) - - case default - call IO_error(137,ext_msg='buildCoordinateSystem: '//trim(structure)) - - end select - - buildCoordinateSystem(1:3,1,a) = direction/norm2(direction) - buildCoordinateSystem(1:3,2,a) = normal/norm2(normal) - buildCoordinateSystem(1:3,3,a) = math_cross(buildCoordinateSystem(1:3,1,a),& - buildCoordinateSystem(1:3,2,a)) - - enddo activeSystems - enddo activeFamilies - + use IO, only: & + IO_error + use math, only: & + math_cross + + integer, dimension(:), intent(in) :: & + active, & + complete + real(pReal), dimension(:,:), intent(in) :: & + system + character(len=*), intent(in) :: & + structure !< lattice structure + real(pReal), intent(in) :: & + cOverA + real(pReal), dimension(3,3,sum(active)) :: & + buildCoordinateSystem + + real(pReal), dimension(3) :: & + direction, normal + integer :: & + a, & !< index of active system + c, & !< index in complete system matrix + f, & !< index of my family + s !< index of my system in current family + + if (len_trim(structure) /= 3) & + call IO_error(137,ext_msg='buildCoordinateSystem: '//trim(structure)) + if (trim(structure(1:3)) == 'bct' .and. cOverA > 2.0_pReal) & + call IO_error(131,ext_msg='buildCoordinateSystem:'//trim(structure)) + if (trim(structure(1:3)) == 'hex' .and. (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal)) & + call IO_error(131,ext_msg='buildCoordinateSystem:'//trim(structure)) + + a = 0 + activeFamilies: do f = 1,size(active,1) + activeSystems: do s = 1,active(f) + a = a + 1 + c = sum(complete(1:f-1))+s + + select case(trim(structure(1:3))) + + case ('fcc','bcc','iso','ort','bct') + direction = system(1:3,c) + normal = system(4:6,c) + + case ('hex') + direction = [ system(1,c)*1.5_pReal, & + (system(1,c)+2.0_pReal*system(2,c))*sqrt(0.75_pReal), & + system(4,c)*cOverA ] ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]) + normal = [ system(5,c), & + (system(5,c)+2.0_pReal*system(6,c))/sqrt(3.0_pReal), & + system(8,c)/cOverA ] ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) + + case default + call IO_error(137,ext_msg='buildCoordinateSystem: '//trim(structure)) + + end select + + buildCoordinateSystem(1:3,1,a) = direction/norm2(direction) + buildCoordinateSystem(1:3,2,a) = normal/norm2(normal) + buildCoordinateSystem(1:3,3,a) = math_cross(buildCoordinateSystem(1:3,1,a),& + buildCoordinateSystem(1:3,2,a)) + + enddo activeSystems + enddo activeFamilies + end function buildCoordinateSystem - - + + !-------------------------------------------------------------------------------------------------- !> @brief Helper function to define transformation systems ! Needed to calculate Schmid matrix and rotated stiffness matrices. @@ -2396,139 +2370,138 @@ end function buildCoordinateSystem ! set a_bcc = 0.0 for fcc -> hex transformation !-------------------------------------------------------------------------------------------------- subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) - use prec, only: & - dEq0 - use math, only: & - math_cross, & - math_outer, & - math_axisAngleToR, & - INRAD, & - MATH_I3 - use IO, only: & - IO_error - - implicit none - integer, dimension(:), intent(in) :: & - Ntrans - real(pReal), dimension(3,3,sum(Ntrans)), intent(out) :: & - Q, & !< Total rotation: Q = R*B - S !< Eigendeformation tensor for phase transformation - real(pReal), intent(in) :: & - cOverA, & !< c/a for target hex structure - a_bcc, & !< lattice parameter a for target bcc structure - a_fcc !< lattice parameter a for parent fcc structure - - real(pReal), dimension(3,3) :: & - R, & !< Pitsch rotation - U, & !< Bain deformation - B, & !< Rotation of fcc to Bain coordinate system - ss, sd - real(pReal), dimension(3) :: & - x, y, z - integer :: & - i - real(pReal), dimension(3+3,LATTICE_FCC_NTRANS), parameter :: & - LATTICE_FCCTOHEX_SYSTEMTRANS = reshape(real( [& - -2, 1, 1, 1, 1, 1, & - 1,-2, 1, 1, 1, 1, & - 1, 1,-2, 1, 1, 1, & - 2,-1, 1, -1,-1, 1, & - -1, 2, 1, -1,-1, 1, & - -1,-1,-2, -1,-1, 1, & - -2,-1,-1, 1,-1,-1, & - 1, 2,-1, 1,-1,-1, & - 1,-1, 2, 1,-1,-1, & - 2, 1,-1, -1, 1,-1, & - -1,-2,-1, -1, 1,-1, & - -1, 1, 2, -1, 1,-1 & - ],pReal),shape(LATTICE_FCCTOHEX_SYSTEMTRANS)) - real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter :: & - LATTICE_FCCTOBCC_SYSTEMTRANS = reshape([& - 0.0, 1.0, 0.0, 10.26, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) - 0.0, 1.0, 0.0, -10.26, & - 0.0, 0.0, 1.0, 10.26, & - 0.0, 0.0, 1.0, -10.26, & - 1.0, 0.0, 0.0, 10.26, & - 1.0, 0.0, 0.0, -10.26, & - 0.0, 0.0, 1.0, 10.26, & - 0.0, 0.0, 1.0, -10.26, & - 1.0, 0.0, 0.0, 10.26, & - 1.0, 0.0, 0.0, -10.26, & - 0.0, 1.0, 0.0, 10.26, & - 0.0, 1.0, 0.0, -10.26 & - ],shape(LATTICE_FCCTOBCC_SYSTEMTRANS)) - - integer, dimension(9,LATTICE_fcc_Ntrans), parameter :: & - LATTICE_FCCTOBCC_BAINVARIANT = reshape( [& - 1, 0, 0, 0, 1, 0, 0, 0, 1, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) - 1, 0, 0, 0, 1, 0, 0, 0, 1, & - 1, 0, 0, 0, 1, 0, 0, 0, 1, & - 1, 0, 0, 0, 1, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 0, 1, 1, 0, 0, 0, 1, 0, & - 0, 0, 1, 1, 0, 0, 0, 1, 0, & - 0, 0, 1, 1, 0, 0, 0, 1, 0, & - 0, 0, 1, 1, 0, 0, 0, 1, 0 & - ],shape(LATTICE_FCCTOBCC_BAINVARIANT)) - - real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter :: & - LATTICE_FCCTOBCC_BAINROT = reshape([& - 1.0, 0.0, 0.0, 45.0, & ! Rotate fcc austensite to bain variant - 1.0, 0.0, 0.0, 45.0, & - 1.0, 0.0, 0.0, 45.0, & - 1.0, 0.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 0.0, 1.0, 45.0, & - 0.0, 0.0, 1.0, 45.0, & - 0.0, 0.0, 1.0, 45.0, & - 0.0, 0.0, 1.0, 45.0 & - ],shape(LATTICE_FCCTOBCC_BAINROT)) - - if (size(Ntrans) < 1 .or. size(Ntrans) > 1) & - call IO_error(0) !ToDo: define error - - if (a_bcc > 0.0_pReal .and. dEq0(cOverA)) then ! fcc -> bcc transformation - do i = 1,sum(Ntrans) - R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & - lattice_fccTobcc_systemTrans(4,i)*INRAD) - B = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & - lattice_fccTobcc_bainRot(4,i)*INRAD) - x = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) - y = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) - z = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) - - U = (a_bcc/a_fcc)*math_outer(x,x) & - + (a_bcc/a_fcc)*math_outer(y,y) * sqrt(2.0_pReal) & - + (a_bcc/a_fcc)*math_outer(z,z) * sqrt(2.0_pReal) - Q(1:3,1:3,i) = matmul(R,B) - S(1:3,1:3,i) = matmul(R,U) - MATH_I3 - enddo - elseif (cOverA > 0.0_pReal .and. dEq0(a_bcc)) then ! fcc -> hex transformation - ss = MATH_I3 - sd = MATH_I3 - ss(1,3) = sqrt(2.0_pReal)/4.0_pReal - if (cOverA > 1.0_pReal .and. cOverA < 2.0_pReal) & - sd(3,3) = cOverA/sqrt(8.0_pReal/3.0_pReal) - - do i = 1,sum(Ntrans) - x = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i)) - z = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i)) - y = -math_cross(x,z) - Q(1:3,1,i) = x - Q(1:3,2,i) = y - Q(1:3,3,i) = z - S(1:3,1:3,i) = matmul(Q(1:3,1:3,i), matmul(matmul(sd,ss), transpose(Q(1:3,1:3,i)))) - MATH_I3 ! ToDo: This is of interest for the Schmid matrix only - enddo - else - call IO_error(0) !ToDo: define error - endif - + use prec, only: & + dEq0 + use math, only: & + math_cross, & + math_outer, & + math_axisAngleToR, & + INRAD, & + MATH_I3 + use IO, only: & + IO_error + + integer, dimension(:), intent(in) :: & + Ntrans + real(pReal), dimension(3,3,sum(Ntrans)), intent(out) :: & + Q, & !< Total rotation: Q = R*B + S !< Eigendeformation tensor for phase transformation + real(pReal), intent(in) :: & + cOverA, & !< c/a for target hex structure + a_bcc, & !< lattice parameter a for target bcc structure + a_fcc !< lattice parameter a for parent fcc structure + + real(pReal), dimension(3,3) :: & + R, & !< Pitsch rotation + U, & !< Bain deformation + B, & !< Rotation of fcc to Bain coordinate system + ss, sd + real(pReal), dimension(3) :: & + x, y, z + integer :: & + i + real(pReal), dimension(3+3,LATTICE_FCC_NTRANS), parameter :: & + LATTICE_FCCTOHEX_SYSTEMTRANS = reshape(real( [& + -2, 1, 1, 1, 1, 1, & + 1,-2, 1, 1, 1, 1, & + 1, 1,-2, 1, 1, 1, & + 2,-1, 1, -1,-1, 1, & + -1, 2, 1, -1,-1, 1, & + -1,-1,-2, -1,-1, 1, & + -2,-1,-1, 1,-1,-1, & + 1, 2,-1, 1,-1,-1, & + 1,-1, 2, 1,-1,-1, & + 2, 1,-1, -1, 1,-1, & + -1,-2,-1, -1, 1,-1, & + -1, 1, 2, -1, 1,-1 & + ],pReal),shape(LATTICE_FCCTOHEX_SYSTEMTRANS)) + real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter :: & + LATTICE_FCCTOBCC_SYSTEMTRANS = reshape([& + 0.0, 1.0, 0.0, 10.26, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) + 0.0, 1.0, 0.0, -10.26, & + 0.0, 0.0, 1.0, 10.26, & + 0.0, 0.0, 1.0, -10.26, & + 1.0, 0.0, 0.0, 10.26, & + 1.0, 0.0, 0.0, -10.26, & + 0.0, 0.0, 1.0, 10.26, & + 0.0, 0.0, 1.0, -10.26, & + 1.0, 0.0, 0.0, 10.26, & + 1.0, 0.0, 0.0, -10.26, & + 0.0, 1.0, 0.0, 10.26, & + 0.0, 1.0, 0.0, -10.26 & + ],shape(LATTICE_FCCTOBCC_SYSTEMTRANS)) + + integer, dimension(9,LATTICE_fcc_Ntrans), parameter :: & + LATTICE_FCCTOBCC_BAINVARIANT = reshape( [& + 1, 0, 0, 0, 1, 0, 0, 0, 1, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) + 1, 0, 0, 0, 1, 0, 0, 0, 1, & + 1, 0, 0, 0, 1, 0, 0, 0, 1, & + 1, 0, 0, 0, 1, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 0, 1, 1, 0, 0, 0, 1, 0, & + 0, 0, 1, 1, 0, 0, 0, 1, 0, & + 0, 0, 1, 1, 0, 0, 0, 1, 0, & + 0, 0, 1, 1, 0, 0, 0, 1, 0 & + ],shape(LATTICE_FCCTOBCC_BAINVARIANT)) + + real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter :: & + LATTICE_FCCTOBCC_BAINROT = reshape([& + 1.0, 0.0, 0.0, 45.0, & ! Rotate fcc austensite to bain variant + 1.0, 0.0, 0.0, 45.0, & + 1.0, 0.0, 0.0, 45.0, & + 1.0, 0.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 0.0, 1.0, 45.0, & + 0.0, 0.0, 1.0, 45.0, & + 0.0, 0.0, 1.0, 45.0, & + 0.0, 0.0, 1.0, 45.0 & + ],shape(LATTICE_FCCTOBCC_BAINROT)) + + if (size(Ntrans) < 1 .or. size(Ntrans) > 1) & + call IO_error(0) !ToDo: define error + + if (a_bcc > 0.0_pReal .and. dEq0(cOverA)) then ! fcc -> bcc transformation + do i = 1,sum(Ntrans) + R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & + lattice_fccTobcc_systemTrans(4,i)*INRAD) + B = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & + lattice_fccTobcc_bainRot(4,i)*INRAD) + x = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) + y = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) + z = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) + + U = (a_bcc/a_fcc)*math_outer(x,x) & + + (a_bcc/a_fcc)*math_outer(y,y) * sqrt(2.0_pReal) & + + (a_bcc/a_fcc)*math_outer(z,z) * sqrt(2.0_pReal) + Q(1:3,1:3,i) = matmul(R,B) + S(1:3,1:3,i) = matmul(R,U) - MATH_I3 + enddo + elseif (cOverA > 0.0_pReal .and. dEq0(a_bcc)) then ! fcc -> hex transformation + ss = MATH_I3 + sd = MATH_I3 + ss(1,3) = sqrt(2.0_pReal)/4.0_pReal + if (cOverA > 1.0_pReal .and. cOverA < 2.0_pReal) & + sd(3,3) = cOverA/sqrt(8.0_pReal/3.0_pReal) + + do i = 1,sum(Ntrans) + x = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i)) + z = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i)) + y = -math_cross(x,z) + Q(1:3,1,i) = x + Q(1:3,2,i) = y + Q(1:3,3,i) = z + S(1:3,1:3,i) = matmul(Q(1:3,1:3,i), matmul(matmul(sd,ss), transpose(Q(1:3,1:3,i)))) - MATH_I3 ! ToDo: This is of interest for the Schmid matrix only + enddo + else + call IO_error(0) !ToDo: define error + endif + end subroutine buildTransformationSystem - + end module lattice diff --git a/src/material.f90 b/src/material.f90 index 0b749c8ef..383462ae1 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -856,34 +856,9 @@ subroutine material_parseTexture if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157_pInt,t) endif - if (config_texture(t)%keyExists('symmetry')) then - select case (config_texture(t)%getString('symmetry')) - case('orthotropic') - texture_symmetry(t) = 4_pInt - case('monoclinic') - texture_symmetry(t) = 2_pInt - case default - texture_symmetry(t) = 1_pInt - end select - endif - - if (config_texture(t)%keyExists('(random)')) then - strings = config_texture(t)%getStrings('(random)',raw=.true.) - do i = 1_pInt, size(strings) - gauss = gauss + 1_pInt - texture_Gauss(1:3,gauss,t) = math_sampleRandomOri() - chunkPos = IO_stringPos(strings(i)) - do j = 1_pInt,3_pInt,2_pInt - select case (IO_stringValue(strings(i),chunkPos,j)) - case('scatter') - texture_Gauss(4,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad - case('fraction') - texture_Gauss(5,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt) - end select - enddo - enddo - endif - + if (config_texture(t)%keyExists('symmetry')) call IO_error(147,ext_msg='symmetry') + if (config_texture(t)%keyExists('(random)')) call IO_error(147,ext_msg='(random)') + if (config_texture(t)%keyExists('(fiber)')) call IO_error(147,ext_msg='(fiber)') if (config_texture(t)%keyExists('(gauss)')) then gauss = gauss + 1_pInt @@ -906,31 +881,6 @@ subroutine material_parseTexture enddo enddo endif - - - if (config_texture(t)%keyExists('(fiber)')) then - fiber = fiber + 1_pInt - strings = config_texture(t)%getStrings('(fiber)',raw= .true.) - do i = 1_pInt, size(strings) - chunkPos = IO_stringPos(strings(i)) - do j = 1_pInt,11_pInt,2_pInt - select case (IO_stringValue(strings(i),chunkPos,j)) - case('alpha1') - texture_Fiber(1,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad - case('alpha2') - texture_Fiber(2,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad - case('beta1') - texture_Fiber(3,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad - case('beta2') - texture_Fiber(4,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad - case('scatter') - texture_Fiber(5,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad - case('fraction') - texture_Fiber(6,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt) - end select - enddo - enddo - endif enddo call config_deallocate('material.config/texture') @@ -1040,11 +990,7 @@ subroutine material_populateGrains math_RtoEuler, & math_EulerToR, & math_mul33x33, & - math_range, & - math_sampleRandomOri, & - math_sampleGaussOri, & - math_sampleFiberOri, & - math_symmetricEulers + math_range use mesh, only: & theMesh, & mesh_ipVolume @@ -1226,28 +1172,12 @@ subroutine material_populateGrains ! has texture components gauss: do t = 1_pInt,texture_Ngauss(textureID) ! loop over Gauss components do g = 1_pInt,int(real(myNorientations,pReal)*texture_Gauss(5,t,textureID),pInt) ! loop over required grain count - orientationOfGrain(:,grain+constituentGrain+g) = & - math_sampleGaussOri(texture_Gauss(1:3,t,textureID),& - texture_Gauss( 4,t,textureID)) + orientationOfGrain(:,grain+constituentGrain+g) = texture_Gauss(1:3,t,textureID) enddo constituentGrain = & constituentGrain + int(real(myNorientations,pReal)*texture_Gauss(5,t,textureID)) ! advance counter for grains of current constituent enddo gauss - fiber: do t = 1_pInt,texture_Nfiber(textureID) ! loop over fiber components - do g = 1_pInt,int(real(myNorientations,pReal)*texture_Fiber(6,t,textureID),pInt) ! loop over required grain count - orientationOfGrain(:,grain+constituentGrain+g) = & - math_sampleFiberOri(texture_Fiber(1:2,t,textureID),& - texture_Fiber(3:4,t,textureID),& - texture_Fiber( 5,t,textureID)) - enddo - constituentGrain = & - constituentGrain + int(real(myNorientations,pReal)*texture_fiber(6,t,textureID),pInt) ! advance counter for grains of current constituent - enddo fiber - - random: do constituentGrain = constituentGrain+1_pInt,myNorientations ! fill remainder with random - orientationOfGrain(:,grain+constituentGrain) = math_sampleRandomOri() - enddo random !-------------------------------------------------------------------------------------------------- ! ...texture transformation @@ -1261,25 +1191,6 @@ subroutine material_populateGrains ) enddo -!-------------------------------------------------------------------------------------------------- -! ...sample symmetry - - symExtension = texture_symmetry(textureID) - 1_pInt - if (symExtension > 0_pInt) then ! sample symmetry (number of additional equivalent orientations) - constituentGrain = myNorientations ! start right after "real" orientations - do j = 1_pInt,myNorientations ! loop over each "real" orientation - symOrientation = math_symmetricEulers(texture_symmetry(textureID), & - orientationOfGrain(1:3,grain+j)) ! get symmetric equivalents - e = min(symExtension,NgrainsOfConstituent(i)-constituentGrain) ! do not overshoot end of constituent grain array - if (e > 0_pInt) then - orientationOfGrain(1:3,grain+constituentGrain+1: & - grain+constituentGrain+e) = & - symOrientation(1:3,1:e) - constituentGrain = constituentGrain + e ! remainder shrinks by e - endif - enddo - endif - !-------------------------------------------------------------------------------------------------- ! shuffle grains within current constituent diff --git a/src/DAMASK_FEM.f90 b/src/mesh/DAMASK_FEM.f90 similarity index 100% rename from src/DAMASK_FEM.f90 rename to src/mesh/DAMASK_FEM.f90 diff --git a/src/FEM_mech.f90 b/src/mesh/FEM_mech.f90 similarity index 100% rename from src/FEM_mech.f90 rename to src/mesh/FEM_mech.f90 diff --git a/src/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 similarity index 100% rename from src/FEM_utilities.f90 rename to src/mesh/FEM_utilities.f90 diff --git a/src/FEM_zoo.f90 b/src/mesh/FEM_zoo.f90 similarity index 100% rename from src/FEM_zoo.f90 rename to src/mesh/FEM_zoo.f90 diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 19df4bdce..efab7bc0b 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -134,7 +134,6 @@ subroutine plastic_disloUCLA_init() config_phase use lattice - implicit none integer :: & Ninstance, & p, i, & @@ -208,9 +207,9 @@ subroutine plastic_disloUCLA_init() prm%nonSchmid_neg = prm%Schmid endif - prm%h_sl_sl = transpose(lattice_interaction_SlipBySlip(prm%N_sl, & + prm%h_sl_sl = lattice_interaction_SlipBySlip(prm%N_sl, & config%getFloats('interaction_slipslip'), & - config%getString('lattice_structure'))) + config%getString('lattice_structure')) prm%forestProjectionEdge = lattice_forestProjection(prm%N_sl,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) @@ -361,7 +360,6 @@ end subroutine plastic_disloUCLA_init !-------------------------------------------------------------------------------------------------- pure subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp, & Mp,T,instance,of) - implicit none real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -411,7 +409,6 @@ subroutine plastic_disloUCLA_dotState(Mp,T,instance,of) PI, & math_clip - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & @@ -472,7 +469,6 @@ end subroutine plastic_disloUCLA_dotState !-------------------------------------------------------------------------------------------------- subroutine plastic_disloUCLA_dependentState(instance,of) - implicit none integer, intent(in) :: & instance, & of @@ -507,7 +503,6 @@ function plastic_disloUCLA_postResults(Mp,T,instance,of) result(postResults) PI, & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & @@ -564,7 +559,6 @@ subroutine plastic_disloUCLA_results(instance,group) use results, only: & results_writeDataset - implicit none integer, intent(in) :: instance character(len=*), intent(in) :: group @@ -616,7 +610,6 @@ pure subroutine kinetics(Mp,T,instance,of, & PI, & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 8e52b3f41..e8aca7f89 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -198,7 +198,6 @@ subroutine plastic_dislotwin_init config_phase use lattice - implicit none integer :: & Ninstance, & p, i, & @@ -268,9 +267,9 @@ subroutine plastic_dislotwin_init slipActive: if (prm%sum_N_sl > 0) then prm%P_sl = lattice_SchmidMatrix_slip(prm%N_sl,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%h_sl_sl = transpose(lattice_interaction_SlipBySlip(prm%N_sl, & + prm%h_sl_sl = lattice_interaction_SlipBySlip(prm%N_sl, & config%getFloats('interaction_slipslip'), & - config%getString('lattice_structure'))) + config%getString('lattice_structure')) prm%forestProjection = lattice_forestProjection (prm%N_sl,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) @@ -332,9 +331,9 @@ subroutine plastic_dislotwin_init if (prm%sum_N_tw > 0) then prm%P_tw = lattice_SchmidMatrix_twin(prm%N_tw,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%h_tw_tw = transpose(lattice_interaction_TwinByTwin(prm%N_tw,& + prm%h_tw_tw = lattice_interaction_TwinByTwin(prm%N_tw,& config%getFloats('interaction_twintwin'), & - config%getString('lattice_structure'))) + config%getString('lattice_structure')) prm%b_tw = config%getFloats('twinburgers', requiredSize=size(prm%N_tw)) prm%t_tw = config%getFloats('twinsize', requiredSize=size(prm%N_tw)) @@ -374,15 +373,15 @@ subroutine plastic_dislotwin_init prm%b_tr = config%getFloats('transburgers') prm%b_tr = math_expand(prm%b_tr,prm%N_tr) - prm%h = config%getFloat('transstackheight', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%i_tr = config%getFloat('cmfptrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%gamma_fcc_hex = config%getFloat('deltag') - prm%xc_trans = config%getFloat('xc_trans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%L_tr = config%getFloat('l0_trans') + prm%h = config%getFloat('transstackheight', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%i_tr = config%getFloat('cmfptrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%gamma_fcc_hex = config%getFloat('deltag') + prm%xc_trans = config%getFloat('xc_trans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%L_tr = config%getFloat('l0_trans') - prm%h_tr_tr = transpose(lattice_interaction_TransByTrans(prm%N_tr,& - config%getFloats('interaction_transtrans'), & - config%getString('lattice_structure'))) + prm%h_tr_tr = lattice_interaction_TransByTrans(prm%N_tr,& + config%getFloats('interaction_transtrans'), & + config%getString('lattice_structure')) prm%C66_tr = lattice_C66_trans(prm%N_tr,prm%C66, & config%getString('trans_lattice_structure'), & @@ -390,7 +389,7 @@ subroutine plastic_dislotwin_init config%getFloat('a_bcc', defaultVal=0.0_pReal), & config%getFloat('a_fcc', defaultVal=0.0_pReal)) - prm%P_tr = lattice_SchmidMatrix_trans(prm%N_tr, & + prm%P_tr = lattice_SchmidMatrix_trans(prm%N_tr, & config%getString('trans_lattice_structure'), & 0.0_pReal, & config%getFloat('a_bcc', defaultVal=0.0_pReal), & @@ -416,16 +415,16 @@ subroutine plastic_dislotwin_init endif if (prm%sum_N_sl > 0 .and. prm%sum_N_tw > 0) then - prm%h_sl_tw = transpose(lattice_interaction_SlipByTwin(prm%N_sl,prm%N_tw,& + prm%h_sl_tw = lattice_interaction_SlipByTwin(prm%N_sl,prm%N_tw,& config%getFloats('interaction_sliptwin'), & - config%getString('lattice_structure'))) + config%getString('lattice_structure')) if (prm%fccTwinTransNucleation .and. prm%sum_N_tw > 12) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if N_tw is [6,6] endif if (prm%sum_N_sl > 0 .and. prm%sum_N_tr > 0) then - prm%h_sl_tr = transpose(lattice_interaction_SlipByTrans(prm%N_sl,prm%N_tr,& + prm%h_sl_tr = lattice_interaction_SlipByTrans(prm%N_sl,prm%N_tr,& config%getFloats('interaction_sliptrans'), & - config%getString('lattice_structure'))) + config%getString('lattice_structure')) if (prm%fccTwinTransNucleation .and. prm%sum_N_tr > 12) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if N_tr is [6,6] endif @@ -605,7 +604,6 @@ function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) phase_plasticityInstance, & phasememberAt - implicit none real(pReal), dimension(6,6) :: & homogenizedC integer, intent(in) :: & @@ -653,7 +651,6 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) math_symmetric33, & math_mul33xx33 - implicit none 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 @@ -776,7 +773,6 @@ subroutine plastic_dislotwin_dotState(Mp,T,instance,of) math_mul33xx33, & PI - implicit none real(pReal), dimension(3,3), intent(in):: & Mp !< Mandel stress real(pReal), intent(in) :: & @@ -869,7 +865,6 @@ subroutine plastic_dislotwin_dependentState(T,instance,of) use math, only: & PI - implicit none integer, intent(in) :: & instance, & of @@ -987,7 +982,6 @@ function plastic_dislotwin_postResults(Mp,T,instance,of) result(postResults) PI, & math_mul33xx33 - implicit none real(pReal), dimension(3,3),intent(in) :: & Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation real(pReal), intent(in) :: & @@ -1067,7 +1061,6 @@ subroutine plastic_dislotwin_results(instance,group) use results, only: & results_writeDataset - implicit none integer, intent(in) :: instance character(len=*) :: group integer :: o @@ -1133,7 +1126,6 @@ pure subroutine kinetics_slip(Mp,T,instance,of, & use math, only: & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & @@ -1212,7 +1204,6 @@ pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,& use math, only: & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & @@ -1284,7 +1275,6 @@ pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,& use math, only: & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index facfa6d80..4f2892f57 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -108,7 +108,6 @@ subroutine plastic_isotropic_init config_phase use lattice - implicit none integer :: & Ninstance, & p, i, & @@ -259,7 +258,6 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) math_deviatoric33, & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -326,7 +324,6 @@ subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of) math_spherical33, & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -383,7 +380,6 @@ subroutine plastic_isotropic_dotState(Mp,instance,of) math_mul33xx33, & math_deviatoric33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & @@ -436,7 +432,6 @@ function plastic_isotropic_postResults(Mp,instance,of) result(postResults) math_mul33xx33, & math_deviatoric33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & @@ -488,7 +483,6 @@ subroutine plastic_isotropic_results(instance,group) use results, only: & results_writeDataset - implicit none integer, intent(in) :: instance character(len=*), intent(in) :: group diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 04927c85b..a255572e1 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -129,7 +129,6 @@ subroutine plastic_kinehardening_init config_phase use lattice - implicit none integer :: & Ninstance, & p, i, o, & @@ -204,9 +203,9 @@ subroutine plastic_kinehardening_init prm%nonSchmid_pos = prm%Schmid prm%nonSchmid_neg = prm%Schmid endif - prm%interaction_SlipSlip = transpose(lattice_interaction_SlipBySlip(prm%Nslip, & + prm%interaction_SlipSlip = lattice_interaction_SlipBySlip(prm%Nslip, & config%getFloats('interaction_slipslip'), & - config%getString('lattice_structure'))) + config%getString('lattice_structure')) prm%crss0 = config%getFloats('crss0', requiredSize=size(prm%Nslip)) prm%tau1 = config%getFloats('tau1', requiredSize=size(prm%Nslip)) @@ -347,7 +346,6 @@ end subroutine plastic_kinehardening_init !-------------------------------------------------------------------------------------------------- pure subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) - implicit none real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -390,7 +388,6 @@ end subroutine plastic_kinehardening_LpAndItsTangent !-------------------------------------------------------------------------------------------------- subroutine plastic_kinehardening_dotState(Mp,instance,of) - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & @@ -443,7 +440,6 @@ subroutine plastic_kinehardening_deltaState(Mp,instance,of) debug_levelSelective #endif - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & @@ -494,7 +490,6 @@ function plastic_kinehardening_postResults(Mp,instance,of) result(postResults) use math, only: & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & @@ -555,7 +550,6 @@ subroutine plastic_kinehardening_results(instance,group) use results, only: & results_writeDataset - implicit none integer, intent(in) :: instance character(len=*) :: group integer :: o @@ -608,7 +602,6 @@ pure subroutine kinetics(Mp,instance,of, & use math, only: & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & diff --git a/src/plastic_none.f90 b/src/plastic_none.f90 index b73bd20ab..6f2ef2230 100644 --- a/src/plastic_none.f90 +++ b/src/plastic_none.f90 @@ -5,13 +5,13 @@ !> @brief Dummy plasticity for purely elastic material !-------------------------------------------------------------------------------------------------- module plastic_none - - implicit none - private - - public :: & - plastic_none_init - + + implicit none + private + + public :: & + plastic_none_init + contains !-------------------------------------------------------------------------------------------------- @@ -19,39 +19,38 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine plastic_none_init - use debug, only: & - debug_level, & - debug_constitutive, & - debug_levelBasic - use material, only: & - phase_plasticity, & - material_allocatePlasticState, & - PLASTICITY_NONE_label, & - PLASTICITY_NONE_ID, & - material_phase, & - plasticState - - implicit none - integer :: & - Ninstance, & - p, & - NipcMyPhase - - write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_NONE_label//' init -+>>>' - - Ninstance = count(phase_plasticity == PLASTICITY_NONE_ID) - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - - do p = 1, size(phase_plasticity) - if (phase_plasticity(p) /= PLASTICITY_NONE_ID) cycle - - NipcMyPhase = count(material_phase == p) - call material_allocatePlasticState(p,NipcMyPhase,0,0,0, & - 0,0,0) - plasticState(p)%sizePostResults = 0 - - enddo + use debug, only: & + debug_level, & + debug_constitutive, & + debug_levelBasic + use material, only: & + phase_plasticity, & + material_allocatePlasticState, & + PLASTICITY_NONE_label, & + PLASTICITY_NONE_ID, & + material_phase, & + plasticState + + integer :: & + Ninstance, & + p, & + NipcMyPhase + + write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_NONE_label//' init -+>>>' + + Ninstance = count(phase_plasticity == PLASTICITY_NONE_ID) + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + + do p = 1, size(phase_plasticity) + if (phase_plasticity(p) /= PLASTICITY_NONE_ID) cycle + + NipcMyPhase = count(material_phase == p) + call material_allocatePlasticState(p,NipcMyPhase,0,0,0, & + 0,0,0) + plasticState(p)%sizePostResults = 0 + + enddo end subroutine plastic_none_init diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index a9ef98b06..caaa0e4a2 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -260,7 +260,6 @@ subroutine plastic_nonlocal_init use config use lattice - implicit none character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer, dimension(0), parameter :: emptyIntArray = [integer::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] @@ -751,7 +750,6 @@ subroutine plastic_nonlocal_init material_phase, & phase_plasticityInstance, & phasememberAt - implicit none integer,intent(in) ::& phase, & @@ -867,7 +865,6 @@ subroutine plastic_nonlocal_dependentState(Fe, Fp, ip, el) LATTICE_fcc_ID, & lattice_structure - implicit none integer, intent(in) :: & ip, & el @@ -1090,7 +1087,6 @@ end subroutine plastic_nonlocal_dependentState !-------------------------------------------------------------------------------------------------- subroutine plastic_nonlocal_kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, & tauThreshold, c, Temperature, instance, of) - implicit none integer, intent(in) :: & c, & !< dislocation character (1:edge, 2:screw) instance, of @@ -1239,7 +1235,6 @@ subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dMp, & phaseAt, phasememberAt, & phase_plasticityInstance - implicit none integer, intent(in) :: & ip, & !< current integration point el !< current element number @@ -1392,7 +1387,6 @@ subroutine plastic_nonlocal_deltaState(Mp,ip,el) phaseAt, phasememberAt, & phase_plasticityInstance - implicit none integer, intent(in) :: & ip, & el @@ -1553,7 +1547,6 @@ subroutine plastic_nonlocal_dotState(Mp, Fe, Fp, Temperature, & LATTICE_bcc_ID, & LATTICE_fcc_ID - implicit none integer, intent(in) :: & ip, & !< current integration point el !< current element number @@ -2027,7 +2020,6 @@ subroutine plastic_nonlocal_updateCompatibility(orientation,i,e) use lattice, only: & lattice_qDisorientation - implicit none integer, intent(in) :: & i, & e @@ -2175,7 +2167,6 @@ function plastic_nonlocal_postResults(ph,instance,of) result(postResults) use material, only: & plasticState - implicit none integer, intent(in) :: & ph, & instance, & @@ -2378,7 +2369,6 @@ end function plastic_nonlocal_postResults function getRho(instance,of,ip,el) use mesh - implicit none integer, intent(in) :: instance, of,ip,el real(pReal), dimension(param(instance)%totalNslip,10) :: getRho @@ -2406,7 +2396,6 @@ subroutine plastic_nonlocal_results(instance,group) use results, only: & results_writeDataset - implicit none integer, intent(in) :: instance character(len=*) :: group integer :: o diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 272c4d631..f8ebae68d 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -129,7 +129,6 @@ subroutine plastic_phenopowerlaw_init config_phase use lattice - implicit none integer :: & Ninstance, & p, i, & @@ -203,9 +202,9 @@ subroutine plastic_phenopowerlaw_init prm%nonSchmid_pos = prm%Schmid_slip prm%nonSchmid_neg = prm%Schmid_slip endif - prm%interaction_SlipSlip = transpose(lattice_interaction_SlipBySlip(prm%Nslip, & + prm%interaction_SlipSlip = lattice_interaction_SlipBySlip(prm%Nslip, & config%getFloats('interaction_slipslip'), & - config%getString('lattice_structure'))) + config%getString('lattice_structure')) prm%xi_slip_0 = config%getFloats('tau0_slip', requiredSize=size(prm%Nslip)) prm%xi_slip_sat = config%getFloats('tausat_slip', requiredSize=size(prm%Nslip)) @@ -240,9 +239,9 @@ subroutine plastic_phenopowerlaw_init twinActive: if (prm%totalNtwin > 0) then prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%interaction_TwinTwin = transpose(lattice_interaction_TwinByTwin(prm%Ntwin,& + prm%interaction_TwinTwin = lattice_interaction_TwinByTwin(prm%Ntwin,& config%getFloats('interaction_twintwin'), & - config%getString('lattice_structure'))) + config%getString('lattice_structure')) prm%gamma_twin_char = lattice_characteristicShear_twin(prm%Ntwin,config%getString('lattice_structure'),& config%getFloat('c/a')) @@ -268,12 +267,12 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! slip-twin related parameters slipAndTwinActive: if (prm%totalNslip > 0 .and. prm%totalNtwin > 0) then - prm%interaction_SlipTwin = transpose(lattice_interaction_SlipByTwin(prm%Nslip,prm%Ntwin,& + prm%interaction_SlipTwin = lattice_interaction_SlipByTwin(prm%Nslip,prm%Ntwin,& config%getFloats('interaction_sliptwin'), & - config%getString('lattice_structure'))) - prm%interaction_TwinSlip = transpose(lattice_interaction_TwinBySlip(prm%Ntwin,prm%Nslip,& + config%getString('lattice_structure')) + prm%interaction_TwinSlip = lattice_interaction_TwinBySlip(prm%Ntwin,prm%Nslip,& config%getFloats('interaction_twinslip'), & - config%getString('lattice_structure'))) + config%getString('lattice_structure')) else slipAndTwinActive allocate(prm%interaction_SlipTwin(prm%TotalNslip,prm%TotalNtwin)) ! at least one dimension is 0 allocate(prm%interaction_TwinSlip(prm%TotalNtwin,prm%TotalNslip)) ! at least one dimension is 0 @@ -387,7 +386,6 @@ end subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) - implicit none real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -439,7 +437,6 @@ end subroutine plastic_phenopowerlaw_LpAndItsTangent !-------------------------------------------------------------------------------------------------- subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & @@ -498,7 +495,6 @@ function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults) use math, only: & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & @@ -567,7 +563,6 @@ subroutine plastic_phenopowerlaw_results(instance,group) use results, only: & results_writeDataset - implicit none integer, intent(in) :: instance character(len=*), intent(in) :: group @@ -616,7 +611,6 @@ pure subroutine kinetics_slip(Mp,instance,of, & use math, only: & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & @@ -693,7 +687,6 @@ pure subroutine kinetics_twin(Mp,instance,of,& use math, only: & math_mul33xx33 - implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & diff --git a/src/quaternions.f90 b/src/quaternions.f90 index 2716817cf..fa9c13f38 100644 --- a/src/quaternions.f90 +++ b/src/quaternions.f90 @@ -77,11 +77,11 @@ module quaternions procedure, private :: pow_scal__ generic, public :: operator(**) => pow_quat__, pow_scal__ - procedure, private :: abs__ - procedure, private :: dot_product__ - procedure, private :: conjg__ - procedure, private :: exp__ - procedure, private :: log__ + procedure, public :: abs__ + procedure, public :: dot_product__ + procedure, public :: conjg__ + procedure, public :: exp__ + procedure, public :: log__ procedure, public :: homomorphed => quat_homomorphed @@ -124,7 +124,6 @@ contains !--------------------------------------------------------------------------------------------------- type(quaternion) pure function init__(array) - implicit none real(pReal), intent(in), dimension(4) :: array init__%w=array(1) @@ -140,7 +139,6 @@ end function init__ !--------------------------------------------------------------------------------------------------- elemental subroutine assign_quat__(self,other) - implicit none type(quaternion), intent(out) :: self type(quaternion), intent(in) :: other @@ -157,7 +155,6 @@ end subroutine assign_quat__ !--------------------------------------------------------------------------------------------------- pure subroutine assign_vec__(self,other) - implicit none type(quaternion), intent(out) :: self real(pReal), intent(in), dimension(4) :: other @@ -174,7 +171,6 @@ end subroutine assign_vec__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function add__(self,other) - implicit none class(quaternion), intent(in) :: self,other add__%w = self%w + other%w @@ -190,7 +186,6 @@ end function add__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pos__(self) - implicit none class(quaternion), intent(in) :: self pos__%w = self%w @@ -206,7 +201,6 @@ end function pos__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function sub__(self,other) - implicit none class(quaternion), intent(in) :: self,other sub__%w = self%w - other%w @@ -222,7 +216,6 @@ end function sub__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function neg__(self) - implicit none class(quaternion), intent(in) :: self neg__%w = -self%w @@ -238,7 +231,6 @@ end function neg__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function mul_quat__(self,other) - implicit none class(quaternion), intent(in) :: self, other mul_quat__%w = self%w*other%w - self%x*other%x - self%y*other%y - self%z*other%z @@ -254,7 +246,6 @@ end function mul_quat__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function mul_scal__(self,scal) - implicit none class(quaternion), intent(in) :: self real(pReal), intent(in) :: scal @@ -271,7 +262,6 @@ end function mul_scal__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function div_quat__(self,other) - implicit none class(quaternion), intent(in) :: self, other div_quat__ = self * (conjg(other)/(abs(other)**2.0_pReal)) @@ -284,7 +274,6 @@ end function div_quat__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function div_scal__(self,scal) - implicit none class(quaternion), intent(in) :: self real(pReal), intent(in) :: scal @@ -300,7 +289,6 @@ logical elemental function eq__(self,other) use prec, only: & dEq - implicit none class(quaternion), intent(in) :: self,other eq__ = all(dEq([ self%w, self%x, self%y, self%z], & @@ -314,7 +302,6 @@ end function eq__ !--------------------------------------------------------------------------------------------------- logical elemental function neq__(self,other) - implicit none class(quaternion), intent(in) :: self,other neq__ = .not. self%eq__(other) @@ -327,7 +314,6 @@ end function neq__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pow_scal__(self,expon) - implicit none class(quaternion), intent(in) :: self real(pReal), intent(in) :: expon @@ -341,7 +327,6 @@ end function pow_scal__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function pow_quat__(self,expon) - implicit none class(quaternion), intent(in) :: self type(quaternion), intent(in) :: expon @@ -356,7 +341,6 @@ end function pow_quat__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function exp__(self) - implicit none class(quaternion), intent(in) :: self real(pReal) :: absImag @@ -376,7 +360,6 @@ end function exp__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function log__(self) - implicit none class(quaternion), intent(in) :: self real(pReal) :: absImag @@ -395,7 +378,6 @@ end function log__ !--------------------------------------------------------------------------------------------------- real(pReal) elemental function abs__(a) - implicit none class(quaternion), intent(in) :: a abs__ = norm2([a%w,a%x,a%y,a%z]) @@ -408,7 +390,6 @@ end function abs__ !--------------------------------------------------------------------------------------------------- real(pReal) elemental function dot_product__(a,b) - implicit none class(quaternion), intent(in) :: a,b dot_product__ = a%w*b%w + a%x*b%x + a%y*b%y + a%z*b%z @@ -421,7 +402,6 @@ end function dot_product__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function conjg__(a) - implicit none class(quaternion), intent(in) :: a conjg__ = quaternion([a%w, -a%x, -a%y, -a%z]) @@ -434,7 +414,6 @@ end function conjg__ !--------------------------------------------------------------------------------------------------- type(quaternion) elemental function quat_homomorphed(a) - implicit none class(quaternion), intent(in) :: a quat_homomorphed = quaternion(-[a%w,a%x,a%y,a%z]) diff --git a/src/results.f90 b/src/results.f90 index 4ed5cc751..516c64552 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -27,6 +27,17 @@ module results module procedure results_writeScalarDataset_rotation end interface results_writeDataset + + interface results_addAttribute + + module procedure results_addAttribute_real + module procedure results_addAttribute_int + module procedure results_addAttribute_str + + module procedure results_addAttribute_int_array + module procedure results_addAttribute_real_array + + end interface results_addAttribute public :: & results_init, & @@ -104,6 +115,9 @@ subroutine results_addIncrement(inc,time) call HDF5_closeGroup(results_addGroup(trim('inc'//trim(adjustl(incChar))))) call results_setLink(trim('inc'//trim(adjustl(incChar))),'current') call HDF5_addAttribute(resultsFile,'time/s',time,trim('inc'//trim(adjustl(incChar)))) + + call HDF5_closeGroup(results_addGroup('current/constituent')) + call HDF5_closeGroup(results_addGroup('current/materialpoint')) end subroutine results_addIncrement @@ -144,15 +158,67 @@ end subroutine results_setLink !-------------------------------------------------------------------------------------------------- -!> @brief adds an attribute to an object +!> @brief adds a string attribute to an object in the results file !-------------------------------------------------------------------------------------------------- -subroutine results_addAttribute(attrLabel,attrValue,path) +subroutine results_addAttribute_str(attrLabel,attrValue,path) - character(len=*), intent(in) :: attrLabel, attrValue, path + character(len=*), intent(in) :: attrLabel, attrValue, path - call HDF5_addAttribute_str(resultsFile,attrLabel, attrValue, path) + call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) -end subroutine results_addAttribute +end subroutine results_addAttribute_str + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds an integer attribute an object in the results file +!-------------------------------------------------------------------------------------------------- +subroutine results_addAttribute_int(attrLabel,attrValue,path) + + character(len=*), intent(in) :: attrLabel, path + integer, intent(in) :: attrValue + + call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) + +end subroutine results_addAttribute_int + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a real attribute an object in the results file +!-------------------------------------------------------------------------------------------------- +subroutine results_addAttribute_real(attrLabel,attrValue,path) + + character(len=*), intent(in) :: attrLabel, path + real(pReal), intent(in) :: attrValue + + call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) + +end subroutine results_addAttribute_real + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds an integer array attribute an object in the results file +!-------------------------------------------------------------------------------------------------- +subroutine results_addAttribute_int_array(attrLabel,attrValue,path) + + character(len=*), intent(in) :: attrLabel, path + integer, intent(in), dimension(:) :: attrValue + + call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) + +end subroutine results_addAttribute_int_array + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a real array attribute an object in the results file +!-------------------------------------------------------------------------------------------------- +subroutine results_addAttribute_real_array(attrLabel,attrValue,path) + + character(len=*), intent(in) :: attrLabel, path + real(pReal), intent(in), dimension(:) :: attrValue + + call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) + +end subroutine results_addAttribute_real_array !-------------------------------------------------------------------------------------------------- @@ -190,6 +256,8 @@ subroutine results_writeScalarDataset_real(group,dataset,label,description,SIuni call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(SIunit)) & call HDF5_addAttribute(groupHandle,'Unit',SIunit,label) + if (HDF5_objectExists(groupHandle,label)) & + call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) call HDF5_closeGroup(groupHandle) end subroutine results_writeScalarDataset_real @@ -215,6 +283,8 @@ subroutine results_writeVectorDataset_real(group,dataset,label,description,SIuni call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(SIunit)) & call HDF5_addAttribute(groupHandle,'Unit',SIunit,label) + if (HDF5_objectExists(groupHandle,label)) & + call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) call HDF5_closeGroup(groupHandle) end subroutine results_writeVectorDataset_real @@ -241,6 +311,8 @@ subroutine results_writeTensorDataset_real(group,dataset,label,description,SIuni call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(SIunit)) & call HDF5_addAttribute(groupHandle,'Unit',SIunit,label) + if (HDF5_objectExists(groupHandle,label)) & + call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) call HDF5_closeGroup(groupHandle) end subroutine results_writeTensorDataset_real @@ -267,6 +339,8 @@ subroutine results_writeVectorDataset_int(group,dataset,label,description,SIunit call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(SIunit)) & call HDF5_addAttribute(groupHandle,'Unit',SIunit,label) + if (HDF5_objectExists(groupHandle,label)) & + call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) call HDF5_closeGroup(groupHandle) end subroutine results_writeVectorDataset_int @@ -293,6 +367,8 @@ subroutine results_writeTensorDataset_int(group,dataset,label,description,SIunit call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(SIunit)) & call HDF5_addAttribute(groupHandle,'Unit',SIunit,label) + if (HDF5_objectExists(groupHandle,label)) & + call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) call HDF5_closeGroup(groupHandle) end subroutine results_writeTensorDataset_int @@ -321,6 +397,8 @@ subroutine results_writeScalarDataset_rotation(group,dataset,label,description,l call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(lattice_structure)) & call HDF5_addAttribute(groupHandle,'Lattice',lattice_structure,label) + if (HDF5_objectExists(groupHandle,label)) & + call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) call HDF5_closeGroup(groupHandle) end subroutine results_writeScalarDataset_rotation @@ -432,7 +510,7 @@ subroutine results_mapping_constituent(phaseAt,memberAt,label) !--------------------------------------------------------------------------------------------------- ! renumber member from my process to all processes do i = 1, size(label) - where(phaseAt_perIP == i) memberAt_total = memberAt + sum(memberOffset(i,0:worldrank-1)) + where(phaseAt_perIP == i) memberAt_total = memberAt + sum(memberOffset(i,0:worldrank-1)) -1 ! convert to 0-based enddo !-------------------------------------------------------------------------------------------------- @@ -570,7 +648,7 @@ subroutine results_mapping_materialpoint(homogenizationAt,memberAt,label) !--------------------------------------------------------------------------------------------------- ! renumber member from my process to all processes do i = 1, size(label) - where(homogenizationAt_perIP == i) memberAt_total = memberAt + sum(memberOffset(i,0:worldrank-1)) + where(homogenizationAt_perIP == i) memberAt_total = memberAt + sum(memberOffset(i,0:worldrank-1)) - 1 ! convert to 0-based enddo !--------------------------------------------------------------------------------------------------