Merge branch '30_parsePhasePartOnce' into 19-NewStylePhenopowerlaw

This commit is contained in:
Martin Diehl 2018-06-19 19:30:01 +02:00
commit d7da70cefb
59 changed files with 1180 additions and 1397 deletions

View File

@ -52,23 +52,23 @@ variables:
IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016"
IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017"
IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018"
GNUCompiler5_3: "Compiler/GNU/5.3"
GNUCompiler7_3: "Compiler/GNU/7.3"
# ------------ Defaults ----------------------------------------------
IntelCompiler: "$IntelCompiler18_1"
GNUCompiler: "$GNUCompiler5_3"
GNUCompiler: "$GNUCompiler7_3"
# ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++
MPICH3_2Intel17_0: "MPI/Intel/17.0/MPICH/3.2"
MPICH3_2Intel18_1: "MPI/Intel/18.1/MPICH/3.2.1"
MPICH3_2GNU5_3: "MPI/GNU/5.3/MPICH/3.2.1"
MPICH3_2GNU7_3: "MPI/GNU/7.3/MPICH/3.2.1"
# ------------ Defaults ----------------------------------------------
MPICH_GNU: "$MPICH3_2GNU5_3"
MPICH_GNU: "$MPICH3_2GNU7_3"
MPICH_Intel: "$MPICH3_2Intel18_1"
# ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++
PETSc3_9_1MPICH3_2Intel18_1: "Libraries/PETSc/3.9.1/Intel-18.1-MPICH-3.2.1"
PETSc3_9_1MPICH3_2GNU5_3: "Libraries/PETSc/3.9.1/GNU-5.3-MPICH-3.2.1"
PETSc3_9_1MPICH3_2GNU7_3: "Libraries/PETSc/3.9.1/GNU-7.3-MPICH-3.2.1"
# ------------ Defaults ----------------------------------------------
PETSc_MPICH_Intel: "$PETSc3_9_1MPICH3_2Intel18_1"
PETSc_MPICH_GNU: "$PETSc3_9_1MPICH3_2GNU5_3"
PETSc_MPICH_GNU: "$PETSc3_9_1MPICH3_2GNU7_3"
# ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++
Abaqus2016: "FEM/Abaqus/2016"
Abaqus2017: "FEM/Abaqus/2017"

View File

@ -5,8 +5,8 @@ cmake_minimum_required (VERSION 2.8.8 FATAL_ERROR)
#---------------------------------------------------------------------------------------
# Find PETSc from system environment
set(PETSC_DIR $ENV{PETSC_DIR})
if ("${PETSC_DIR}" STREQUAL "")
message (FATAL_ERROR "PETSC_DIR is not defined")
if (PETSC_DIR STREQUAL "")
message (FATAL_ERROR "PETSc location (PETSC_DIR) is not defined")
endif ()
set (petsc_conf_variables "${PETSC_DIR}/lib/petsc/conf/variables")
@ -105,52 +105,54 @@ set (CMAKE_C_COMPILER "${PETSC_MPICC}")
# Now start to care about DAMASK
# DAMASK solver defines project to build
if ("${DAMASK_SOLVER}" STREQUAL "SPECTRAL")
if (DAMASK_SOLVER STREQUAL "SPECTRAL")
project (DAMASK_spectral Fortran C)
add_definitions (-DSpectral)
message ("Building Spectral Solver\n")
elseif ("${DAMASK_SOLVER}" STREQUAL "FEM")
elseif (DAMASK_SOLVER STREQUAL "FEM")
project (DAMASK_FEM Fortran C)
add_definitions (-DFEM)
message ("Building FEM Solver\n")
else ()
message (FATAL_ERROR "Build target (DAMASK_SOLVER) is not defined")
endif ()
# set linker commands (needs to be done after defining the project)
set (CMAKE_LINKER "${PETSC_LINKER}")
if ("${CMAKE_BUILD_TYPE}" STREQUAL "")
if (CMAKE_BUILD_TYPE STREQUAL "")
set (CMAKE_BUILD_TYPE "RELEASE")
endif ()
# Predefined sets for OPTIMIZATION/OPENMP based on BUILD_TYPE
if ("${CMAKE_BUILD_TYPE}" STREQUAL "DEBUG" OR "${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY" )
if (CMAKE_BUILD_TYPE STREQUAL "DEBUG" OR CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
set (DEBUG_FLAGS "${DEBUG_FLAGS} -DDEBUG")
set (PARALLEL "OFF")
set (OPTI "OFF")
elseif ("${CMAKE_BUILD_TYPE}" STREQUAL "RELEASE")
elseif (CMAKE_BUILD_TYPE STREQUAL "RELEASE")
set (PARALLEL "ON")
set (OPTI "DEFENSIVE")
elseif ("${CMAKE_BUILD_TYPE}" STREQUAL "PERFORMANCE")
elseif (CMAKE_BUILD_TYPE STREQUAL "PERFORMANCE")
set (PARALLEL "ON")
set (OPTI "AGGRESSIVE")
endif ()
# $OPTIMIZATION takes precedence over $BUILD_TYPE defaults
if ("${OPTIMIZATION}" STREQUAL "")
if (OPTIMIZATION STREQUAL "")
set (OPTIMIZATION "${OPTI}")
else ()
set (OPTIMIZATION "${OPTIMIZATION}")
endif ()
# $OPENMP takes precedence over $BUILD_TYPE defaults
if ("${OPENMP}" STREQUAL "")
if (OPENMP STREQUAL "")
set (OPENMP "${PARALLEL}")
else ()
set(OPENMP "${OPENMP}")
endif ()
# syntax check only (mainly for pre-receive hook, works only with gfortran)
if ("${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY" )
if (CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
set (BUILDCMD_POST "${BUILDCMD_POST} -fsyntax-only")
endif ()
@ -188,19 +190,19 @@ set (DAMASK_INCLUDE_FLAGS "${DAMASK_INCLUDE_FLAGS} ${PETSC_INCLUDES}")
###################################################################################################
# Intel Compiler
###################################################################################################
if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel")
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"
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
@ -308,18 +310,18 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel")
###################################################################################################
# GNU Compiler
###################################################################################################
elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU")
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")
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" )
@ -443,12 +445,15 @@ elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU")
# Additional options
# -fdefault-integer-8: Use it to set precision to 8 bytes for integer, don't use it for the standard case of pInt=4 (there is no -fdefault-integer-4)
else ()
message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized")
endif ()
set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${BUILDCMD_PRE} ${OPENMP_FLAGS} ${STANDARD_CHECK} ${OPTIMIZATION_FLAGS} ${COMPILE_FLAGS} ${PRECISION_FLAGS}")
set (CMAKE_Fortran_LINK_EXECUTABLE "${BUILDCMD_PRE} ${CMAKE_LINKER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}")
if ("${CMAKE_BUILD_TYPE}" STREQUAL "DEBUG")
if (CMAKE_BUILD_TYPE STREQUAL "DEBUG")
set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${DEBUG_FLAGS}")
set (CMAKE_Fortran_LINK_EXECUTABLE "${CMAKE_Fortran_LINK_EXECUTABLE} ${DEBUG_FLAGS}")
endif ()
@ -464,15 +469,15 @@ message ("Fortran Linker Command:\n${CMAKE_Fortran_LINK_EXECUTABLE}\n")
add_subdirectory (src)
# INSTALL BUILT BINARIES
if ("${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY")
if (CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
exec_program (mktemp ARGS -d OUTPUT_VARIABLE BLACK_HOLE)
install (PROGRAMS ${PROJECT_BINARY_DIR}/src/prec.mod
DESTINATION ${BLACK_HOLE})
else ()
if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
if (PROJECT_NAME STREQUAL "DAMASK_spectral")
install (PROGRAMS ${PROJECT_BINARY_DIR}/src/DAMASK_spectral
DESTINATION ${CMAKE_INSTALL_PREFIX})
elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
install (PROGRAMS ${PROJECT_BINARY_DIR}/src/DAMASK_FEM
DESTINATION ${CMAKE_INSTALL_PREFIX})
endif ()

View File

@ -25,7 +25,6 @@ build/FEM:
.PHONY: marc
marc:
@./installation/symLink_Code.sh
@./installation/mods_MarcMentat/apply_DAMASK_modifications.sh ${MAKEFLAGS}
.PHONY: clean

@ -1 +1 @@
Subproject commit 701d63b0e11a653797afe260d1dfc12e2a390d6f
Subproject commit aead92902b3a0cf3404be9c552bfec918d7aaffb

View File

@ -1 +1 @@
v2.0.2-22-g60e30e4
v2.0.2-48-gaebb06e

View File

@ -1,56 +0,0 @@
5 header
seeds_fromRandom v2.0.1-1138-gfcac08c -N 50 -g 128 128 128
grid a 128 b 128 c 128
microstructures 50
randomSeed 3336946323
1_pos 2_pos 3_pos 1_euler 2_euler 3_euler microstructure
0.54457843603947365 0.84911587396210719 0.34846714169395199 146.18027121829002 137.38970467457548 64.889274068548971 1.0
0.30082506347847232 0.98313838966599176 0.44557226838658942 277.4997516434205 39.360506400353323 71.246613676352894 2.0
0.40772634005027159 0.9616152434202665 0.058204060548736787 357.09763745092783 25.490253793203657 268.023521027068 3.0
0.58904198203278091 0.72270060278093695 0.31942765324679046 350.68488850223423 130.4171465853421 250.42731366202318 4.0
0.51285660590703486 0.96889097226822973 0.65275467737350745 23.745542919457275 118.98401463018114 322.60963659419878 5.0
0.78608003485028433 0.83273743685098622 0.46591785719509976 124.52498788960992 100.66865249263579 43.350904777210218 6.0
0.65676045955005913 0.90612854270261067 0.46812684725311626 206.73481508655914 108.36640892186001 80.109515277983789 7.0
0.41091744799856139 0.019203430085754657 0.87577849258950335 294.38492822136715 146.40525644850072 307.47368257125362 8.0
0.2895339668620191 0.44890615451191845 0.98331278676555256 155.95129760119522 47.149690499466338 129.03566717283138 9.0
0.19961281156351873 0.52634383062850942 0.65188451822931848 147.12314868626314 111.70076966247582 118.18572187802707 10.0
0.86414247862963223 0.1358065510164656 0.66025345324864337 164.3847245485006 106.948282223783 169.81246394416348 11.0
0.22971651291623074 0.092972318577821886 0.29406405983067813 152.69170803150587 154.25570085621541 12.482717398044327 12.0
0.26338815658881415 0.34338560362947429 0.55845211616339796 34.576603888911734 112.1396081205236 231.97898012368159 13.0
0.75109304237913643 0.32426372309630619 0.24464858180476037 287.27773986438422 132.7748719439447 29.566044111233396 14.0
0.011464166371603362 0.038504815611266896 0.31848008962612995 3.6027692030412783 128.19004192002171 318.21386202740894 15.0
0.40531294455896061 0.89392258706810201 0.47360685251709117 224.94453046189483 91.073774858498993 174.6238603309032 16.0
0.53642882463725594 0.12961813440684475 0.33670742966203715 275.10050328051165 143.71902154901966 46.372591362351443 17.0
0.025264257063423813 0.86284946730733791 0.67853751997904233 286.09297442950589 84.366012495567063 168.12310601585438 18.0
0.46082042086486502 0.79920741984567956 0.84550103531963372 338.58981410067844 115.61172937509538 33.588172611417498 19.0
0.22570807057805362 0.074166418124772107 0.35703686595525042 123.22376691705952 84.092264279947017 358.5702863996658 20.0
0.05386086781200651 0.33174190751238741 0.22207351758975458 347.73707141532731 68.522081814108546 343.42676588519805 21.0
0.843158604433492 0.92955496315098074 0.64647123931005734 11.343815482295781 80.300931773797004 9.6393328996438079 22.0
0.38975306778625629 0.24157610260940071 0.71161594028191588 321.39703457206355 30.680985581522023 310.97284763119887 23.0
0.29080297238998321 0.7438587097696947 0.27827316089105131 318.66484094014749 129.93793511237541 136.82657482859585 24.0
0.39382389364070247 0.28978401907200979 0.25701142568390795 322.47065731551987 13.846167927307052 301.54027053054892 25.0
0.61050322346481545 0.13737535992809438 0.36661645869662263 352.54143971537871 57.8511858353625 133.84653788992898 26.0
0.79736663927764695 0.20513299822009629 0.79699332479250651 290.58637400802854 44.449209602954802 275.77563923277597 27.0
0.75235587126626513 0.11041486201059918 0.8131872750127791 70.389885527768058 106.61781772242031 249.0896396040977 28.0
0.47139010668774128 0.12192484253468709 0.21955576044612418 82.523861430871293 130.07642048077489 161.94830004765717 29.0
0.58577411200822327 0.55808726366080907 0.68861538513192688 4.5456602316904782 68.430488072013802 279.06105056042912 30.0
0.078221348390348527 0.38485150106633381 0.70002412594863284 44.840105036355524 52.915732353957182 321.10892793267385 31.0
0.67648574989589816 0.36189363050547918 0.1744438641736718 56.290857666353922 79.852422734452261 218.87802771695559 32.0
0.66993786328789628 0.24839196429109262 0.22913111586511459 90.545592617209479 111.73679898243722 50.777738624812869 33.0
0.97253038612350284 0.5008359837170796 0.22908814679929382 258.2784447839781 81.324197699117292 308.75839223966972 34.0
0.57267221923324418 0.57812183688041852 0.27747089968489891 44.241276881211661 104.39672542923724 263.41942696808212 35.0
0.20684173793886379 0.43993013267805814 0.65735383309297513 343.60408990114365 51.644327943351122 302.98734797140071 36.0
0.74510273339709676 0.73117975286639059 0.88155543772031653 318.38483613589898 93.903589849536274 302.06468871599935 37.0
0.96140945332061889 0.16540946028864878 0.40824265860818898 97.086714635901274 130.50888029759304 221.78895191070089 38.0
0.76663076605317781 0.85911002545479809 0.11281299879667539 163.06393615448818 43.363447677950042 338.05013375241901 39.0
0.41268673658765898 0.24787882796675886 0.57686480644197569 200.12920794363012 45.222523931505947 280.23271113977307 40.0
0.77256877568016891 0.88174830744168597 0.85149237688892054 116.81358850313981 71.413890894473454 115.54962789790765 41.0
0.26725724981852333 0.2962688497890511 0.89524301333622525 254.14781916777747 83.176346219908254 33.979304092964192 42.0
0.58047025880020098 0.57494408407976194 0.61595960318628096 334.70268656247265 42.480438737564974 177.92796756121371 43.0
0.52102440567302477 0.7145666401672387 0.21858506378351775 178.43052543384653 153.21174542887405 324.42119289220273 44.0
0.77321583279723483 0.96647383074249249 0.5062943967878929 230.42797261926012 99.507340620849902 169.75007570059978 45.0
0.3364367026326 0.45790436703027437 0.27197669375839439 218.70321774431869 60.819721511735267 217.80859716828817 46.0
0.41823530342173082 0.077759964416919514 0.66113722050248613 189.26108507623661 50.425749120256064 78.019878648192815 47.0
0.8754300454839713 0.094969845269609401 0.42632522145904467 250.899467172654 33.14582034295529 150.05888748377424 48.0
0.1950290416819265 0.59474264558516909 0.93298429220138601 232.236367110732 47.258083025548189 34.83912199551915 49.0
0.91993054481220637 0.48586729788450678 0.10933899155043697 246.05124283375034 131.539860458254 249.58739755697601 50.0

View File

@ -74,7 +74,7 @@ for name in filenames:
# ------------------------------------------ process data ------------------------------------------
theta=-0.75*np.pi
RotMat2TSL=np.array([[1., 0., 0.],
RotMat2TSL=np.array([[1., 0., 0.],
[0., np.cos(theta), np.sin(theta)], # Orientation to account for -135 deg
[0., -np.sin(theta), np.cos(theta)]]) # rotation for TSL convention
vec = np.zeros(4)

View File

@ -1,5 +1,5 @@
# special flags for some files
if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU")
if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
SET_SOURCE_FILES_PROPERTIES( "lattice.f90" PROPERTIES
COMPILE_FLAGS "-ffree-line-length-240")
# long lines for interaction matrix
@ -15,25 +15,22 @@ add_dependencies(SYSTEM_ROUTINES C_ROUTINES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:SYSTEM_ROUTINES>)
add_library(PREC OBJECT "prec.f90")
add_dependencies(PREC SYSTEM_ROUTINES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:PREC>)
if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
if (PROJECT_NAME STREQUAL "DAMASK_spectral")
add_library(DAMASK_INTERFACE OBJECT "spectral_interface.f90")
elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
add_library(DAMASK_INTERFACE OBJECT "FEM_interface.f90")
else ()
message (FATAL_ERROR "Build target (PROJECT_NAME) is not defined")
endif()
add_dependencies(DAMASK_INTERFACE PREC)
add_dependencies(DAMASK_INTERFACE PREC SYSTEM_ROUTINES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_INTERFACE>)
add_library(IO OBJECT "IO.f90")
add_dependencies(IO DAMASK_INTERFACE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:IO>)
add_library(CHAINED_LIST OBJECT "list.f90")
add_dependencies(CHAINED_LIST IO)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:CHAINED_LIST>)
add_library(NUMERICS OBJECT "numerics.f90")
add_dependencies(NUMERICS IO)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:NUMERICS>)
@ -42,6 +39,14 @@ add_library(DEBUG OBJECT "debug.f90")
add_dependencies(DEBUG NUMERICS)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DEBUG>)
add_library(CHAINED_LIST OBJECT "linked_list.f90")
add_dependencies(CHAINED_LIST DEBUG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:CHAINED_LIST>)
add_library(CONFIG_MATERIAL OBJECT "config.f90")
add_dependencies(CONFIG_MATERIAL CHAINED_LIST)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:CONFIG_MATERIAL>)
add_library(FEsolving OBJECT "FEsolving.f90")
add_dependencies(FEsolving DEBUG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEsolving>)
@ -51,11 +56,11 @@ add_dependencies(DAMASK_MATH FEsolving)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_MATH>)
# SPECTRAL solver and FEM solver use different mesh files
if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
if (PROJECT_NAME STREQUAL "DAMASK_spectral")
add_library(MESH OBJECT "mesh.f90")
add_dependencies(MESH DAMASK_MATH)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:MESH>)
elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
add_library(FEZoo OBJECT "FEZoo.f90")
add_dependencies(FEZoo DAMASK_MATH)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEZoo>)
@ -65,7 +70,7 @@ elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
endif()
add_library(MATERIAL OBJECT "material.f90")
add_dependencies(MATERIAL MESH CHAINED_LIST)
add_dependencies(MATERIAL MESH CONFIG_MATERIAL)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:MATERIAL>)
add_library(DAMASK_HELPERS OBJECT "lattice.f90")
@ -162,7 +167,7 @@ add_library(DAMASK_CPFE OBJECT "CPFEM2.f90")
add_dependencies(DAMASK_CPFE DAMASK_ENGINE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_CPFE>)
if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
if (PROJECT_NAME STREQUAL "DAMASK_spectral")
add_library(SPECTRAL_UTILITIES OBJECT "spectral_utilities.f90")
add_dependencies(SPECTRAL_UTILITIES DAMASK_CPFE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:SPECTRAL_UTILITIES>)
@ -174,13 +179,13 @@ if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
"spectral_mech_Basic.f90")
add_dependencies(SPECTRAL_SOLVER SPECTRAL_UTILITIES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:SPECTRAL_SOLVER>)
if(NOT "${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY")
if(NOT CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
add_executable(DAMASK_spectral "DAMASK_spectral.f90" ${OBJECTFILES})
else()
add_library(DAMASK_spectral OBJECT "DAMASK_spectral.f90")
endif()
add_dependencies(DAMASK_spectral SPECTRAL_SOLVER)
elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
add_library(FEM_UTILITIES OBJECT "FEM_utilities.f90")
add_dependencies(FEM_UTILITIES DAMASK_CPFE)

View File

@ -62,6 +62,8 @@ subroutine CPFEM_initAll(el,ip)
numerics_init
use debug, only: &
debug_init
use config, only: &
config_init
use FEsolving, only: &
FE_init
use math, only: &
@ -93,6 +95,7 @@ subroutine CPFEM_initAll(el,ip)
call IO_init
call numerics_init
call debug_init
call config_init
call math_init
call FE_init
call mesh_init(ip, el) ! pass on coordinates to alter calcMode of first ip
@ -143,7 +146,8 @@ subroutine CPFEM_init
material_phase, &
homogState, &
phase_plasticity, &
plasticState, &
plasticState
use config, only: &
material_Nhomogenization
use crystallite, only: &
crystallite_F0, &
@ -310,7 +314,8 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
thermal_type, &
THERMAL_conduction_ID, &
phase_Nsources, &
material_homog, &
material_homog
use config, only: &
material_Nhomogenization
use crystallite, only: &
crystallite_partionedF,&

View File

@ -27,6 +27,8 @@ subroutine CPFEM_initAll(el,ip)
numerics_init
use debug, only: &
debug_init
use config, only: &
config_init
use FEsolving, only: &
FE_init
use math, only: &
@ -64,6 +66,7 @@ subroutine CPFEM_initAll(el,ip)
#endif
call numerics_init
call debug_init
call config_init
call math_init
call FE_init
call mesh_init(ip, el) ! pass on coordinates to alter calcMode of first ip
@ -108,7 +111,8 @@ subroutine CPFEM_init
material_phase, &
homogState, &
phase_plasticity, &
plasticState, &
plasticState
use config, only: &
material_Nhomogenization
use crystallite, only: &
crystallite_F0, &
@ -228,7 +232,8 @@ subroutine CPFEM_age()
hydrogenfluxState, &
material_phase, &
phase_plasticity, &
phase_Nsources, &
phase_Nsources
use config, only: &
material_Nhomogenization
use crystallite, only: &
crystallite_partionedF,&

View File

@ -355,8 +355,8 @@ program DAMASK_spectral
select case (loadCases(1)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasicPETSc_label)
call basicPETSc_init
case (DAMASK_spectral_SolverBasic_label)
call basic_init
case (DAMASK_spectral_SolverPolarisation_label)
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) &
@ -513,8 +513,8 @@ program DAMASK_spectral
select case(loadCases(currentLoadCase)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasicPETSc_label)
call BasicPETSc_forward (&
case (DAMASK_spectral_SolverBasic_label)
call Basic_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime, &
deformation_BC = loadCases(currentLoadCase)%deformation, &
stress_BC = loadCases(currentLoadCase)%stress, &
@ -542,8 +542,8 @@ program DAMASK_spectral
select case(loadCases(currentLoadCase)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasicPETSc_label)
solres(field) = BasicPETSC_solution (&
case (DAMASK_spectral_SolverBasic_label)
solres(field) = Basic_solution (&
incInfo,timeinc,timeIncOld, &
stress_BC = loadCases(currentLoadCase)%stress, &
rotation_BC = loadCases(currentLoadCase)%rotation)

View File

@ -982,6 +982,10 @@ pure function IO_stringPos(string)
if ( string(left:left) == '#' ) exit
IO_stringPos = [IO_stringPos,int(left, pInt), int(right, pInt)]
IO_stringPos(1) = IO_stringPos(1)+1_pInt
endOfString: if (right < left) then
IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string)
exit
endif endOfString
enddo
end function IO_stringPos
@ -1546,6 +1550,17 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
case (136_pInt)
msg = 'zero entry on stiffness diagonal for transformed phase'
!--------------------------------------------------------------------------------------------------
! errors related to the parsing of material.config
case (140_pInt)
msg = 'key not found'
case (141_pInt)
msg = 'number of chunks in string differs'
case (142_pInt)
msg = 'empty list'
case (143_pInt)
msg = 'no value found for key'
!--------------------------------------------------------------------------------------------------
! material error messages and related messages in mesh
case (150_pInt)

View File

@ -4,9 +4,10 @@
!> @details List of files needed by MSC.Marc, Abaqus/Explicit, and Abaqus/Standard
!--------------------------------------------------------------------------------------------------
#include "IO.f90"
#include "list.f90"
#include "numerics.f90"
#include "debug.f90"
#include "linked_list.f90"
#include "config.f90"
#include "math.f90"
#include "FEsolving.f90"
#include "mesh.f90"

205
src/config.f90 Normal file
View File

@ -0,0 +1,205 @@
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Reads in the material configuration from file
!> @details Reads the material configuration file, where solverJobName.materialConfig takes
!! precedence over material.config. Stores the raw strings and the positions of delimiters for the
!! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture'
!--------------------------------------------------------------------------------------------------
module config
use linked_list
use prec, only: &
pReal, &
pInt
implicit none
private
type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: &
phaseConfig, &
microstructureConfig, &
homogenizationConfig, &
textureConfig, &
crystalliteConfig
character(len=64), dimension(:), allocatable, public, protected :: &
phase_name, & !< name of each phase
homogenization_name, & !< name of each homogenization
crystallite_name, & !< name of each crystallite setting
microstructure_name, & !< name of each microstructure
texture_name !< name of each texture
! ToDo: make private, no one needs to know that
character(len=*), parameter, public :: &
MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part
MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part
MATERIAL_partPhase = 'phase', & !< keyword for phase part
MATERIAL_partMicrostructure = 'microstructure', & !< keyword for microstructure part
MATERIAL_partTexture = 'texture' !< keyword for texture part
! ToDo: Remove, use size(phaseConfig) etc
integer(pInt), public, protected :: &
material_Ntexture, & !< number of textures
material_Nphase, & !< number of phases
material_Nhomogenization, & !< number of homogenizations
material_Nmicrostructure, & !< number of microstructures
material_Ncrystallite !< number of crystallite settings
! ToDo: make private, no one needs to know that
character(len=*), parameter, public :: &
MATERIAL_configFile = 'material.config', & !< generic name for material configuration file
MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file
public :: config_init
contains
subroutine config_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_error, &
IO_open_file, &
IO_read, &
IO_lc, &
IO_open_jobFile_stat, &
IO_getTag, &
IO_timeStamp, &
IO_EOF
use debug, only: &
debug_level, &
debug_material, &
debug_levelBasic
implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt
integer(pInt) :: myDebug
character(len=65536) :: &
line, &
part
myDebug = debug_level(debug_material)
write(6,'(/,a)') ' <<<+- material init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present...
call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file
rewind(fileUnit)
line = '' ! to have it initialized
do while (trim(line) /= IO_EOF)
part = IO_lc(IO_getTag(line,'<','>'))
select case (trim(part))
case (trim(material_partPhase))
call parseFile(line,phase_name,phaseConfig,FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
case (trim(material_partMicrostructure))
call parseFile(line,microstructure_name,microstructureConfig,FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
case (trim(material_partCrystallite))
call parseFile(line,crystallite_name,crystalliteConfig,FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
case (trim(material_partHomogenization))
call parseFile(line,homogenization_name,homogenizationConfig,FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
case (trim(material_partTexture))
call parseFile(line,texture_name,textureConfig,FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
case default
line = IO_read(fileUnit)
end select
enddo
material_Nhomogenization = size(homogenizationConfig)
if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization)
material_Nmicrostructure = size(microstructureConfig)
if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure)
material_Ncrystallite = size(crystalliteConfig)
if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite)
material_Nphase = size(phaseConfig)
if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase)
material_Ntexture = size(textureConfig)
if (material_Ntexture < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture)
end subroutine config_init
!--------------------------------------------------------------------------------------------------
!> @brief parses the homogenization part in the material configuration file
!--------------------------------------------------------------------------------------------------
subroutine parseFile(line,&
sectionNames,part,fileUnit)
use IO, only: &
IO_read, &
IO_error, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringValue, &
IO_stringPos, &
IO_EOF
implicit none
integer(pInt), intent(in) :: fileUnit
character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames
type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part
character(len=65536),intent(out) :: line
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: s
character(len=65536) :: devNull
character(len=64) :: tag
logical :: echo
echo = .false.
allocate(part(0))
s = 0_pInt
do while (trim(line) /= IO_EOF) ! read through sections of material part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
devNull = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundNextPart
nextSection: if (IO_getTag(line,'[',']') /= '') then
s = s + 1_pInt
part = [part, emptyList]
tag = IO_getTag(line,'[',']')
GfortranBug86033: if (.not. allocated(sectionNames)) then
allocate(sectionNames(1),source=tag)
else GfortranBug86033
sectionNames = [sectionNames,tag]
endif GfortranBug86033
endif nextSection
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
inSection: if (s > 0_pInt) then
call part(s)%add(IO_lc(trim(line)))
else inSection
echo = (trim(tag) == '/echo/')
endif inSection
enddo
if (echo) then
do s = 1, size(sectionNames)
call part(s)%show()
end do
end if
end subroutine parseFile
end module config

View File

@ -59,12 +59,13 @@ subroutine constitutive_init()
IO_timeStamp
use mesh, only: &
FE_geomtype
use material, only: &
material_phase, &
use config, only: &
material_Nphase, &
material_localFileExt, &
material_configFile, &
phase_name, &
material_configFile
use material, only: &
material_phase, &
phase_plasticity, &
phase_plasticityInstance, &
phase_Nsources, &

View File

@ -171,6 +171,7 @@ subroutine crystallite_init
IO_write_jobFile, &
IO_error
use material
use config
use constitutive, only: &
constitutive_initialFi, &
constitutive_microstructure ! derived (shortcut) quantities of given state
@ -1236,8 +1237,9 @@ subroutine crystallite_integrateStateRK4()
plasticState, &
sourceState, &
phase_Nsources, &
material_Nphase, &
phaseAt, phasememberAt
use config, only: &
material_Nphase
use constitutive, only: &
constitutive_collectDotState, &
constitutive_microstructure

View File

@ -70,7 +70,8 @@ subroutine damage_local_init(fileUnit)
damageState, &
damageMapping, &
damage, &
damage_initialPhi, &
damage_initialPhi
use config, only: &
material_partHomogenization
implicit none

View File

@ -26,6 +26,7 @@ subroutine damage_none_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &

View File

@ -75,7 +75,8 @@ subroutine damage_nonlocal_init(fileUnit)
damageState, &
damageMapping, &
damage, &
damage_initialPhi, &
damage_initialPhi
use config, only: &
material_partHomogenization
implicit none

View File

@ -101,6 +101,7 @@ subroutine homogenization_init
crystallite_maxSizePostResults
#endif
use material
use config
use homogenization_none
use homogenization_isostrain
use homogenization_RGC

View File

@ -100,6 +100,7 @@ subroutine homogenization_RGC_init(fileUnit)
FE_geomtype
use IO
use material
use config
implicit none
integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration

View File

@ -62,6 +62,7 @@ subroutine homogenization_isostrain_init(fileUnit)
debug_levelBasic
use IO
use material
use config
implicit none
integer(pInt), intent(in) :: fileUnit

View File

@ -29,6 +29,7 @@ subroutine homogenization_none_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &

View File

@ -81,7 +81,8 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit)
hydrogenfluxMapping, &
hydrogenConc, &
hydrogenConcRate, &
hydrogenflux_initialCh, &
hydrogenflux_initialCh
use config, only: &
material_partHomogenization, &
material_partPhase

View File

@ -27,6 +27,7 @@ subroutine hydrogenflux_isoconc_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &

View File

@ -78,7 +78,8 @@ subroutine kinematics_cleavage_opening_init(fileUnit)
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_cleavage_opening_label, &
KINEMATICS_cleavage_opening_ID, &
KINEMATICS_cleavage_opening_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use lattice, only: &

View File

@ -68,7 +68,8 @@ subroutine kinematics_hydrogen_strain_init(fileUnit)
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_hydrogen_strain_label, &
KINEMATICS_hydrogen_strain_ID, &
KINEMATICS_hydrogen_strain_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase

View File

@ -78,7 +78,8 @@ subroutine kinematics_slipplane_opening_init(fileUnit)
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_slipplane_opening_label, &
KINEMATICS_slipplane_opening_ID, &
KINEMATICS_slipplane_opening_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use lattice, only: &

View File

@ -68,7 +68,8 @@ subroutine kinematics_thermal_expansion_init(fileUnit)
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_thermal_expansion_label, &
KINEMATICS_thermal_expansion_ID, &
KINEMATICS_thermal_expansion_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase

View File

@ -68,7 +68,8 @@ subroutine kinematics_vacancy_strain_init(fileUnit)
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_vacancy_strain_label, &
KINEMATICS_vacancy_strain_ID, &
KINEMATICS_vacancy_strain_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase

View File

@ -1263,7 +1263,7 @@ subroutine lattice_init
IO_stringPos, &
IO_stringValue, &
IO_floatValue
use material, only: &
use config, only: &
material_configfile, &
material_localFileExt, &
material_partPhase

470
src/linked_list.f90 Normal file
View File

@ -0,0 +1,470 @@
!--------------------------------------------------------------------------------------------------
!> @author Martin Dieh, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Chained list to store string together with position of delimiters
!--------------------------------------------------------------------------------------------------
module linked_list
use prec, only: &
pReal, &
pInt
implicit none
private
type, private :: tPartitionedString
character(len=:), allocatable :: val
integer(pInt), dimension(:), allocatable :: pos
end type tPartitionedString
type, public :: tPartitionedStringList
type(tPartitionedString) :: string
type(tPartitionedStringList), pointer :: next => null()
contains
procedure :: add => add
procedure :: show => show
procedure :: keyExists => exist
procedure :: countKeys => count
procedure :: getFloat => getFloat
procedure :: getFloats => getFloats
procedure :: getInt => getInt
procedure :: getInts => getInts
procedure :: getStringsRaw => strings
procedure :: getString => getString
procedure :: getStrings => getStrings
end type tPartitionedStringList
type(tPartitionedStringList), public :: emptyList
contains
!--------------------------------------------------------------------------------------------------
!> @brief add element
!> @details Adds a string together with the start/end position of chunks in this string. The new
!! element is added at the end of the list. Empty strings are not added. All strings are converted
!! to lower case
!--------------------------------------------------------------------------------------------------
subroutine add(this,string)
use IO, only: &
IO_isBlank, &
IO_lc, &
IO_stringPos
implicit none
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: string
type(tPartitionedStringList), pointer :: new, item
if (IO_isBlank(string)) return
allocate(new)
new%string%val = IO_lc (trim(string))
new%string%pos = IO_stringPos(trim(string))
item => this
do while (associated(item%next))
item => item%next
enddo
item%next => new
end subroutine add
!--------------------------------------------------------------------------------------------------
!> @brief prints all elements
!> @details Strings are printed in order of insertion (FIFO)
!--------------------------------------------------------------------------------------------------
subroutine show(this)
implicit none
class(tPartitionedStringList) :: this
type(tPartitionedStringList), pointer :: item
item => this%next
do while (associated(item))
write(6,'(a)') trim(item%string%val)
item => item%next
end do
end subroutine show
!--------------------------------------------------------------------------------------------------
!> @brief deallocates all elements of a given list
!> @details Strings are printed in order of insertion (FIFO)
!--------------------------------------------------------------------------------------------------
! subroutine free_all()
! implicit none
!
! type(node), pointer :: item
!
! do
! item => first
!
! if (associated(item) .eqv. .FALSE.) exit
!
! first => first%next
! deallocate(item)
! end do
! end subroutine free_all
!--------------------------------------------------------------------------------------------------
!> @brief reports wether a given key (string value at first position) exists in the list
!--------------------------------------------------------------------------------------------------
logical function exist(this,key)
use IO, only: &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: item
exist = .false.
item => this%next
do while (associated(item) .and. .not. exist)
exist = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
item => item%next
end do
end function exist
!--------------------------------------------------------------------------------------------------
!> @brief count number of key appearances
!> @details traverses list and counts each occurrence of specified key
!--------------------------------------------------------------------------------------------------
integer(pInt) function count(this,key)
use IO, only: &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: item
integer(pInt) :: i
count = 0_pInt
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) &
count = count + 1_pInt
item => item%next
end do
end function count
!--------------------------------------------------------------------------------------------------
!> @brief returns all strings in the list
!> @details returns raw string without start/end position of chunks
!--------------------------------------------------------------------------------------------------
function strings(this)
use IO, only: &
IO_error, &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=65536), dimension(:), allocatable :: strings
character(len=65536) :: string
type(tPartitionedStringList), pointer :: item
item => this%next
do while (associated(item))
string = item%string%val
GfortranBug86033: if (.not. allocated(strings)) then
allocate(strings(1),source=string)
else GfortranBug86033
strings = [strings,string]
endif GfortranBug86033
item => item%next
end do
if (size(strings) < 0_pInt) call IO_error(142_pInt) ! better to check for "allocated"?
end function strings
!--------------------------------------------------------------------------------------------------
!> @brief gets float value of first string that matches given key (i.e. first chunk)
!> @details gets one float value. If key is not found exits with error unless default is given
!--------------------------------------------------------------------------------------------------
real(pReal) function getFloat(this,key,defaultVal)
use IO, only : &
IO_error, &
IO_stringValue, &
IO_FloatValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
real(pReal), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item
logical :: found
if (present(defaultVal)) getFloat = defaultVal
found = present(defaultVal)
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
getFloat = IO_FloatValue(item%string%val,item%string%pos,2)
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getFloat
!--------------------------------------------------------------------------------------------------
!> @brief gets integer value for given key
!> @details gets one integer value. If key is not found exits with error unless default is given
!--------------------------------------------------------------------------------------------------
integer(pInt) function getInt(this,key,defaultVal)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_IntValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item
logical :: found
if (present(defaultVal)) getInt = defaultVal
found = present(defaultVal)
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
getInt = IO_IntValue(item%string%val,item%string%pos,2)
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getInt
!--------------------------------------------------------------------------------------------------
!> @brief gets string value for given key
!> @details if key is not found exits with error unless default is given
!--------------------------------------------------------------------------------------------------
character(len=65536) function getString(this,key,defaultVal,raw)
use IO, only: &
IO_error, &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
character(len=65536), intent(in), optional :: defaultVal
logical, intent(in), optional :: raw
type(tPartitionedStringList), pointer :: item
logical :: found, &
split
if (present(defaultVal)) getString = defaultVal
split = merge(.not. raw,.true.,present(raw))
found = present(defaultVal)
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
if (split) then
getString = IO_StringValue(item%string%val,item%string%pos,2)
else
getString = trim(item%string%val(item%string%pos(4):)) ! raw string starting a second chunk
endif
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getString
!--------------------------------------------------------------------------------------------------
!> @brief ...
!> @details ...
!--------------------------------------------------------------------------------------------------
function getStrings(this,key,defaultVal,raw)
use IO
implicit none
character(len=65536),dimension(:), allocatable :: getStrings
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
character(len=65536),dimension(:), intent(in), optional :: defaultVal
logical, intent(in), optional :: raw
type(tPartitionedStringList), pointer :: item
character(len=65536) :: str
integer(pInt) :: i
logical :: found, &
split, &
cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
split = merge(.not. raw,.true.,present(raw))
found = present(defaultVal)
if (present(defaultVal)) getStrings = defaultVal
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings)
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
arrayAllocated: if (.not. allocated(getStrings)) then
if (split) then
str = IO_StringValue(item%string%val,item%string%pos,2_pInt)
allocate(getStrings(1),source=str)
do i=3_pInt,item%string%pos(1)
str = IO_StringValue(item%string%val,item%string%pos,i)
getStrings = [getStrings,str]
enddo
else
str = item%string%val(item%string%pos(4):)
getStrings = [str]
endif
else arrayAllocated
if (split) then
do i=2_pInt,item%string%pos(1)
str = IO_StringValue(item%string%val,item%string%pos,i)
getStrings = [getStrings,str]
enddo
else
getStrings = [getStrings,str]
endif
endif arrayAllocated
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function
!--------------------------------------------------------------------------------------------------
!> @brief gets array of int values for given key
!> @details if key is not found exits with error unless default is given
!--------------------------------------------------------------------------------------------------
function getInts(this,key,defaultVal)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_IntValue
implicit none
integer(pInt), dimension(:), allocatable :: getInts
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), dimension(:), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item
integer(pInt) :: i
logical :: found, &
cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
found = present(defaultVal)
if (present(defaultVal)) then
getInts = defaultVal
else
allocate(getInts(0))
endif
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (.not. cumulative) then
deallocate(getInts) ! use here rhs allocation with empty list
allocate(getInts(0))
endif
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
do i = 2_pInt, item%string%pos(1)
getInts = [getInts,IO_IntValue(item%string%val,item%string%pos,i)]
enddo
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getInts
!--------------------------------------------------------------------------------------------------
!> @brief gets array of float values for given key
!> @details if key is not found exits with error unless default is given
!--------------------------------------------------------------------------------------------------
function getFloats(this,key,defaultVal)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_FloatValue
implicit none
real(pReal), dimension(:), allocatable :: getFloats
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), dimension(:), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item
integer(pInt) :: i
logical :: found, &
cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
found = present(defaultVal)
if (present(defaultVal)) then
getFloats = defaultVal
else
allocate(getFloats(0))
endif
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (.not. cumulative) then
deallocate(getFloats) ! use here rhs allocation with empty list
allocate(getFloats(0))
endif
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
do i = 2_pInt, item%string%pos(1)
getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)]
enddo
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getFloats
end module linked_list

View File

@ -1,476 +0,0 @@
module chained_list
use prec, only: &
pReal, &
pInt
implicit none
private
type, private :: tPartitionedString
character(len=:), allocatable :: val
integer(pInt), dimension(:), allocatable :: pos
end type tPartitionedString
type, public :: tPartitionedStringList
type(tPartitionedString) :: string
type(tPartitionedStringList), pointer :: next => null()
type(tPartitionedStringList), pointer :: prev => null()
contains
procedure :: add => add
procedure :: show => show
procedure :: getRaw => getRaw
procedure :: getRaws => getRaws
procedure :: getStringsRaw => getStringsRaw
procedure :: getFloat => getFloat
procedure :: getFloatArray => getFloatArray
procedure :: getInt => getInt
procedure :: getIntArray => getIntArray
procedure :: getString => getString
procedure :: getStrings => getStrings
procedure :: keyExists => keyExists
procedure :: countKeys => countKeys
end type tPartitionedStringList
type(tPartitionedStringList), public :: emptyList
contains
!--------------------------------------------------------------------------------------------------
!> @brief add element
!> @details adds raw string and start/end position of chunks in this string
!--------------------------------------------------------------------------------------------------
subroutine add(this,string,stringPos)
implicit none
class(tPartitionedStringList) :: this
type(tPartitionedStringList), pointer :: &
new, &
tmp
character(len=*), intent(in) :: string
integer(pInt), dimension(:), intent(in) :: stringPos
allocate(new)
new%string%val=string
new%string%pos=stringPos
if (.not. associated(this%next)) then
this%next => new
else
tmp => this%next
this%next => new
this%next%next => tmp
end if
end subroutine add
!--------------------------------------------------------------------------------------------------
!> @brief add element
!> @details adds raw string and start/end position of chunks in this string
!--------------------------------------------------------------------------------------------------
subroutine show(this)
implicit none
class(tPartitionedStringList) :: this
type(tPartitionedStringList), pointer :: tmp
tmp => this%next
do
if (.not. associated(tmp)) exit
write(6,*) trim(tmp%string%val)
tmp => tmp%next
end do
end subroutine show
!--------------------------------------------------------------------------------------------------
!> @brief gets raw data
!> @details returns raw string and start/end position of chunks in this string
!--------------------------------------------------------------------------------------------------
subroutine getRaw(this,key,string,stringPos)
use IO, only : &
IO_error, &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), dimension(:),allocatable, intent(out) :: stringPos
character(len=*), intent(out) :: string
type(tPartitionedStringList), pointer :: tmp
tmp => this%next
do
if (.not. associated(tmp)) call IO_error(1_pInt,ext_msg=key)
foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
stringPos = tmp%string%pos
string = tmp%string%val
exit
endif foundKey
tmp => tmp%next
end do
end subroutine getRaw
!--------------------------------------------------------------------------------------------------
!> @brief gets raw data
!> @details returns raw string and start/end position of chunks in this string
!--------------------------------------------------------------------------------------------------
subroutine getRaws(this,key,string,stringPos)
use IO, only: &
IO_error, &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), dimension(:,:),allocatable, intent(out) :: stringPos
character(len=256), dimension(:),allocatable, intent(out) :: string
character(len=256) :: stringTmp
integer(pInt) :: posSize
integer(pInt), dimension(:),allocatable :: stringPosFlat
type(tPartitionedStringList), pointer :: tmp
posSize = -1_pInt
tmp => this%next
do
if (.not. associated(tmp)) then
if(posSize < 0_pInt) call IO_error(1_pInt,ext_msg=key)
stringPos = reshape(stringPosFlat,[posSize,size(string)])
exit
endif
foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
if (posSize < 0_pInt) then
posSize = size(tmp%string%pos)
stringPosFlat = tmp%string%pos
allocate(string(1))
string(1) = tmp%string%val
else
if (size(tmp%string%pos) /= posSize) call IO_error(1_pInt,ext_msg=key)
stringPosFlat = [stringPosFlat,tmp%string%pos]
stringTmp = tmp%string%val
string = [string,stringTmp]
endif
endif foundKey
tmp => tmp%next
end do
end subroutine getRaws
!--------------------------------------------------------------------------------------------------
!> @brief gets raw data
!> @details returns raw string and start/end position of chunks in this string
!--------------------------------------------------------------------------------------------------
function getStringsRaw(this)
use IO, only: &
IO_error, &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=256), dimension(:),allocatable :: getStringsRaw
character(len=256) :: stringTmp
type(tPartitionedStringList), pointer :: tmp
tmp => this%next
do
if (.not. associated(tmp)) then
if(size(getStringsRaw) < 0_pInt) call IO_error(1_pInt,ext_msg='getallraw empty list')
exit
endif
stringTmp = tmp%string%val
if (.not. allocated(getStringsRaw)) then
allocate(getStringsRaw(1),source=stringTmp)
else
getStringsRaw = [getStringsRaw,stringTmp]
endif
tmp => tmp%next
end do
end function getStringsRaw
!--------------------------------------------------------------------------------------------------
!> @brief gets float value for given key
!> @details if key is not found exits with error unless default is given
!--------------------------------------------------------------------------------------------------
real(pReal) function getFloat(this,key,defaultVal)
use IO, only : &
IO_error, &
IO_stringValue, &
IO_FloatValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
real(pReal), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: tmp
tmp => this%next
do
endOfList: if (.not. associated(tmp)) then
if(present(defaultVal)) then
getFloat = defaultVal
exit
else
call IO_error(1_pInt,ext_msg=key)
endif
endif endOfList
foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key)
getFloat = IO_FloatValue(tmp%string%val,tmp%string%pos,2)
exit
endif foundKey
tmp => tmp%next
end do
end function getFloat
!--------------------------------------------------------------------------------------------------
!> @brief gets float value for given key
!> @details if key is not found exits with error unless default is given
!--------------------------------------------------------------------------------------------------
integer(pInt) function getInt(this,key,defaultVal)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_IntValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: tmp
tmp => this%next
do
endOfList: if (.not. associated(tmp)) then
if(present(defaultVal)) then
getInt = defaultVal
exit
else
call IO_error(1_pInt,ext_msg=key)
endif
endif endOfList
foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key)
getInt = IO_IntValue(tmp%string%val,tmp%string%pos,2)
exit
endif foundKey
tmp => tmp%next
end do
end function getInt
!--------------------------------------------------------------------------------------------------
!> @brief gets string value for given key
!> @details if key is not found exits with error unless default is given
!--------------------------------------------------------------------------------------------------
character(len=64) function getString(this,key,defaultVal)
use IO, only: &
IO_error, &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
character(len=64), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: tmp
tmp => this%next
do
endOfList: if (.not. associated(tmp)) then
if(present(defaultVal)) then
getString = defaultVal
exit
else
call IO_error(1_pInt,ext_msg=key)
endif
endif endOfList
foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key)
getString = IO_StringValue(tmp%string%val,tmp%string%pos,2)
exit
endif foundKey
tmp => tmp%next
end do
end function getString
!--------------------------------------------------------------------------------------------------
!> @brief gets array of int values for given key
!> @details if key is not found exits with error unless default is given
!--------------------------------------------------------------------------------------------------
function getIntArray(this,key,defaultVal)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_IntValue
implicit none
integer(pInt), dimension(:), allocatable :: getIntArray
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt),dimension(:), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: tmp
integer(pInt) :: i
allocate(getIntArray(0))
tmp => this%next
do
endOfList: if (.not. associated(tmp)) then
if(present(defaultVal)) then
getIntArray = defaultVal
exit
else
call IO_error(1_pInt,ext_msg=key)
endif
endif endOfList
foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key)
do i = 2_pInt, tmp%string%pos(1)
getIntArray = [getIntArray,IO_IntValue(tmp%string%val,tmp%string%pos,i)]
enddo
exit
endif foundKey
tmp => tmp%next
end do
end function getIntArray
!--------------------------------------------------------------------------------------------------
!> @brief gets array of float values for given key
!> @details if key is not found exits with error unless default is given
!--------------------------------------------------------------------------------------------------
function getFloatArray(this,key,defaultVal)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_FloatValue
implicit none
real(pReal), dimension(:), allocatable :: getFloatArray
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
real(pReal),dimension(:), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: tmp
integer(pInt) :: i
allocate(getFloatArray(0))
tmp => this%next
do
endOfList: if (.not. associated(tmp)) then
if(present(defaultVal)) then
getFloatArray = defaultVal
exit
else
call IO_error(1_pInt,ext_msg=key)
endif
endif endOfList
foundKey: if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
if (tmp%string%pos(1) < 2_pInt) call IO_error(1_pInt,ext_msg=key)
do i = 2_pInt, tmp%string%pos(1)
getFloatArray = [getFloatArray,IO_FloatValue(tmp%string%val,tmp%string%pos,i)]
enddo
exit
endif foundKey
tmp => tmp%next
end do
end function getFloatArray
! reports wether a key exists at least once
function keyExists(this,key)
use IO
implicit none
logical :: keyExists
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: tmp
keyExists = .false.
tmp => this%next
do
if (.not. associated(tmp)) exit
if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
keyExists = .true.
exit
endif
tmp => tmp%next
end do
end function
integer(pInt) function countKeys(this,key)
use IO
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: tmp
integer(pInt) :: i
countKeys = 0_pInt
tmp => this%next
do
if (.not. associated(tmp)) exit
if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
countKeys = countKeys + 1_pInt
endif
tmp => tmp%next
end do
end function
function getStrings(this,key)
use IO
implicit none
character(len=64),dimension(:),allocatable :: getStrings
character(len=64) :: str
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: tmp
integer(pInt) :: i
tmp => this%next
do
if (.not. associated(tmp)) then
if (.not. allocated(getStrings)) allocate(getStrings(0),source=str)
exit
endif
if (trim(IO_stringValue(tmp%string%val,tmp%string%pos,1))==trim(key)) then
if (tmp%string%pos(1) < 2) print*, "NOT WORKKING"
str = IO_StringValue(tmp%string%val,tmp%string%pos,2)
GfortranBug86033: if (.not. allocated(getStrings)) then
allocate(getStrings(1),source=str)
else GfortranBug86033
getStrings = [getStrings,str]
endif GfortranBug86033
endif
tmp => tmp%next
end do
end function
! subroutine free_all()
! implicit none
!
! type(node), pointer :: tmp
!
! do
! tmp => first
!
! if (associated(tmp) .eqv. .FALSE.) exit
!
! first => first%next
! deallocate(tmp)
! end do
! end subroutine free_all
end module chained_list

View File

@ -7,7 +7,8 @@
!! 'phase', 'texture', and 'microstucture'
!--------------------------------------------------------------------------------------------------
module material
use chained_list
use config
use linked_list
use prec, only: &
pReal, &
pInt, &
@ -142,15 +143,6 @@ module material
HOMOGENIZATION_rgc_ID
end enum
character(len=*), parameter, public :: &
MATERIAL_configFile = 'material.config', & !< generic name for material configuration file
MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file
character(len=*), parameter, public :: &
MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part
MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part
MATERIAL_partPhase = 'phase' !< keyword for phase part
integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: &
phase_elasticity !< elasticity of each phase
integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: &
@ -174,17 +166,8 @@ module material
integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: &
homogenization_type !< type of each homogenization
character(len=64), dimension(:), allocatable, public, protected :: &
phase_name, & !< name of each phase
homogenization_name, & !< name of each homogenization
crystallite_name !< name of each crystallite setting
integer(pInt), public, protected :: &
homogenization_maxNgrains, & !< max number of grains in any USED homogenization
material_Nphase, & !< number of phases
material_Nhomogenization, & !< number of homogenizations
material_Nmicrostructure, & !< number of microstructures
material_Ncrystallite !< number of crystallite settings
homogenization_maxNgrains !< max number of grains in any USED homogenization
integer(pInt), dimension(:), allocatable, public, protected :: &
phase_Nsources, & !< number of source mechanisms active in each phase
@ -243,19 +226,10 @@ module material
phase_localPlasticity !< flags phases with local constitutive law
character(len=*), parameter, private :: &
MATERIAL_partMicrostructure = 'microstructure', & !< keyword for microstructure part
MATERIAL_partTexture = 'texture' !< keyword for texture part
character(len=64), dimension(:), allocatable, private :: &
microstructure_name, & !< name of each microstructure
texture_name !< name of each texture
character(len=256), dimension(:), allocatable, private :: &
texture_ODFfile !< name of each ODF file
integer(pInt), private :: &
material_Ntexture, & !< number of textures
microstructure_maxNconstituents, & !< max number of constituents in any phase
texture_maxNgauss, & !< max number of Gauss components in any texture
texture_maxNfiber !< max number of Fiber components in any texture
@ -305,13 +279,6 @@ module material
vacancyConcRate, & !< vacancy conc change field
hydrogenConcRate !< hydrogen conc change field
type(tPartitionedStringList), public,protected, allocatable, dimension(:) :: &
phaseConfig, &
microstructureConfig, &
homogenizationConfig, &
textureConfig, &
crystalliteConfig
public :: &
material_init, &
ELASTICITY_hooke_ID ,&
@ -379,13 +346,7 @@ subroutine material_init()
#endif
use IO, only: &
IO_error, &
IO_open_file, &
IO_read, &
IO_lc, &
IO_open_jobFile_stat, &
IO_getTag, &
IO_timeStamp, &
IO_EOF
IO_timeStamp
use debug, only: &
debug_level, &
debug_material, &
@ -410,51 +371,26 @@ subroutine material_init()
integer(pInt), dimension(:), allocatable :: CrystallitePosition
integer(pInt), dimension(:), allocatable :: HomogenizationPosition
character(len=65536) :: &
line,part
myDebug = debug_level(debug_material)
write(6,'(/,a)') ' <<<+- material init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present...
call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file
rewind(fileUnit)
line = '' ! to have it initialized
do while (trim(line) /= IO_EOF)
part = IO_lc(IO_getTag(line,'<','>'))
select case (trim(part))
case (trim(material_partPhase))
line = material_parsePhase(FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
case (trim(material_partMicrostructure))
line = material_parseMicrostructure(FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
case (trim(material_partCrystallite))
line = material_parseCrystallite(FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
case (trim(material_partHomogenization))
line = material_parseHomogenization(FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
case (trim(material_partTexture))
line = material_parseTexture(FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
case default
line = IO_read(fileUnit)
end select
enddo
call material_parsePhase()
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
call material_parseMicrostructure()
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
call material_parseCrystallite()
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
call material_parseHomogenization()
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
call material_parseTexture()
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
allocate(plasticState (material_Nphase))
allocate(sourceState (material_Nphase))
@ -569,68 +505,19 @@ end subroutine material_init
!--------------------------------------------------------------------------------------------------
!> @brief parses the homogenization part in the material configuration file
!> @brief parses the homogenization part from the material configuration
!--------------------------------------------------------------------------------------------------
character(len=65536) function material_parseHomogenization(fileUnit)
subroutine material_parseHomogenization
use config, only : &
homogenizationConfig
use IO, only: &
IO_read, &
IO_globalTagInPart, &
IO_countSections, &
IO_error, &
IO_countTagInPart, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringValue, &
IO_intValue, &
IO_floatValue, &
IO_stringPos, &
IO_EOF
IO_error
use mesh, only: &
mesh_element
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: Nsections, h
character(len=65536) :: line, tag,devNull
character(len=64) :: tag2
logical :: echo
allocate(homogenizationConfig(0))
h = 0_pInt
do while (trim(line) /= IO_EOF) ! read through sections of material part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
devNull = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundNextPart
nextSection: if (IO_getTag(line,'[',']') /= '') then
h = h + 1_pInt
homogenizationConfig = [homogenizationConfig, emptyList]
tag2 = IO_getTag(line,'[',']')
GfortranBug86033: if (.not. allocated(homogenization_name)) then
allocate(homogenization_name(1),source=tag2)
else GfortranBug86033
homogenization_name = [homogenization_name,tag2]
endif GfortranBug86033
endif nextSection
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
inSection: if (h > 0_pInt) then
chunkPos = IO_stringPos(line)
call homogenizationConfig(h)%add(IO_lc(trim(line)),chunkPos)
else inSection
echo = (trim(tag) == '/echo/')
endif inSection
enddo
material_Nhomogenization = size(homogenizationConfig)
if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization)
integer(pInt) :: h
character(len=65536) :: tag
allocate(homogenization_type(material_Nhomogenization), source=HOMOGENIZATION_undefined_ID)
allocate(thermal_type(material_Nhomogenization), source=THERMAL_isothermal_ID)
@ -656,97 +543,107 @@ character(len=65536) function material_parseHomogenization(fileUnit)
forall (h = 1_pInt:material_Nhomogenization) homogenization_active(h) = any(mesh_element(3,:) == h)
do h=1_pInt, material_Nhomogenization
homogenization_Noutput(h) = homogenizationConfig(h)%countKeys('(output)')
tag = homogenizationConfig(h)%getString('mech')
select case (trim(tag))
case(HOMOGENIZATION_NONE_label)
homogenization_type(h) = HOMOGENIZATION_NONE_ID
homogenization_Ngrains(h) = 1_pInt
case(HOMOGENIZATION_ISOSTRAIN_label)
homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID
homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents')
case(HOMOGENIZATION_RGC_label)
homogenization_type(h) = HOMOGENIZATION_RGC_ID
homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents')
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h))
select case (trim(tag))
case(HOMOGENIZATION_NONE_label)
homogenization_type(h) = HOMOGENIZATION_NONE_ID
homogenization_Ngrains(h) = 1_pInt
case(HOMOGENIZATION_ISOSTRAIN_label)
homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID
homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents')
case(HOMOGENIZATION_RGC_label)
homogenization_type(h) = HOMOGENIZATION_RGC_ID
homogenization_Ngrains(h) = homogenizationConfig(h)%getInt('nconstituents')
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
homogenization_typeInstance(h) = &
count(homogenization_type==homogenization_type(h)) ! count instances
if (homogenizationConfig(h)%keyExists('thermal')) then
tag = homogenizationConfig(h)%getString('thermal')
thermal_initialT(h) = homogenizationConfig(h)%getFloat('t0',defaultVal=300.0_pReal)
! case ('t0')
! thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt)
select case (trim(tag))
case(THERMAL_isothermal_label)
thermal_type(h) = THERMAL_isothermal_ID
case(THERMAL_adiabatic_label)
thermal_type(h) = THERMAL_adiabatic_ID
case(THERMAL_conduction_label)
thermal_type(h) = THERMAL_conduction_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
tag = homogenizationConfig(h)%getString('thermal')
select case (trim(tag))
case(THERMAL_isothermal_label)
thermal_type(h) = THERMAL_isothermal_ID
case(THERMAL_adiabatic_label)
thermal_type(h) = THERMAL_adiabatic_ID
case(THERMAL_conduction_label)
thermal_type(h) = THERMAL_conduction_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
if (homogenizationConfig(h)%keyExists('damage')) then
tag = homogenizationConfig(h)%getString('damage')
! case ('initialdamage')
! damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt)
select case (trim(tag))
case(DAMAGE_NONE_label)
damage_type(h) = DAMAGE_none_ID
case(DAMAGE_LOCAL_label)
damage_type(h) = DAMAGE_local_ID
case(DAMAGE_NONLOCAL_label)
damage_type(h) = DAMAGE_nonlocal_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
if (homogenizationConfig(h)%keyExists('vacancyflux')) then
tag = homogenizationConfig(h)%getString('vacancyflux')
! case ('cv0')
! vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt)
select case (trim(tag))
case(VACANCYFLUX_isoconc_label)
vacancyflux_type(h) = VACANCYFLUX_isoconc_ID
case(VACANCYFLUX_isochempot_label)
vacancyflux_type(h) = VACANCYFLUX_isochempot_ID
case(VACANCYFLUX_cahnhilliard_label)
vacancyflux_type(h) = VACANCYFLUX_cahnhilliard_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
if (homogenizationConfig(h)%keyExists('porosity')) then
tag = homogenizationConfig(h)%getString('porosity')
select case (trim(tag))
case(POROSITY_NONE_label)
porosity_type(h) = POROSITY_none_ID
case(POROSITY_phasefield_label)
porosity_type(h) = POROSITY_phasefield_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
if (homogenizationConfig(h)%keyExists('hydrogenflux')) then
tag = homogenizationConfig(h)%getString('hydrogenflux')
! case ('ch0')
! hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt)
select case (trim(tag))
case(HYDROGENFLUX_isoconc_label)
hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID
case(HYDROGENFLUX_cahnhilliard_label)
hydrogenflux_type(h) = HYDROGENFLUX_cahnhilliard_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
damage_initialPhi(h) = homogenizationConfig(h)%getFloat('initialdamage',defaultVal=1.0_pReal)
tag = homogenizationConfig(h)%getString('damage')
select case (trim(tag))
case(DAMAGE_NONE_label)
damage_type(h) = DAMAGE_none_ID
case(DAMAGE_LOCAL_label)
damage_type(h) = DAMAGE_local_ID
case(DAMAGE_NONLOCAL_label)
damage_type(h) = DAMAGE_nonlocal_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
if (homogenizationConfig(h)%keyExists('vacancyflux')) then
vacancyflux_initialCv(h) = homogenizationConfig(h)%getFloat('cv0',defaultVal=0.0_pReal)
tag = homogenizationConfig(h)%getString('vacancyflux')
select case (trim(tag))
case(VACANCYFLUX_isoconc_label)
vacancyflux_type(h) = VACANCYFLUX_isoconc_ID
case(VACANCYFLUX_isochempot_label)
vacancyflux_type(h) = VACANCYFLUX_isochempot_ID
case(VACANCYFLUX_cahnhilliard_label)
vacancyflux_type(h) = VACANCYFLUX_cahnhilliard_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
if (homogenizationConfig(h)%keyExists('porosity')) then
!ToDo?
tag = homogenizationConfig(h)%getString('porosity')
select case (trim(tag))
case(POROSITY_NONE_label)
porosity_type(h) = POROSITY_none_ID
case(POROSITY_phasefield_label)
porosity_type(h) = POROSITY_phasefield_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
if (homogenizationConfig(h)%keyExists('hydrogenflux')) then
hydrogenflux_initialCh(h) = homogenizationConfig(h)%getFloat('ch0',defaultVal=0.0_pReal)
tag = homogenizationConfig(h)%getString('hydrogenflux')
select case (trim(tag))
case(HYDROGENFLUX_isoconc_label)
hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID
case(HYDROGENFLUX_cahnhilliard_label)
hydrogenflux_type(h) = HYDROGENFLUX_cahnhilliard_ID
case default
call IO_error(500_pInt,ext_msg=trim(tag))
end select
endif
enddo
do h=1_pInt, material_Nhomogenization
@ -759,69 +656,33 @@ endif
enddo
homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active)
material_parseHomogenization=line
end function material_parseHomogenization
end subroutine material_parseHomogenization
!--------------------------------------------------------------------------------------------------
!> @brief parses the microstructure part in the material configuration file
!--------------------------------------------------------------------------------------------------
character(len=65536) function material_parseMicrostructure(fileUnit)
subroutine material_parseMicrostructure
use prec, only: &
dNeq
use IO
use IO, only: &
IO_floatValue, &
IO_intValue, &
IO_stringValue, &
IO_stringPos, &
IO_error
use mesh, only: &
mesh_element, &
mesh_NcpElems
implicit none
integer(pInt), intent(in) :: fileUnit
character(len=256), dimension(:), allocatable :: &
character(len=65536), dimension(:), allocatable :: &
str
character(len=64) :: tag2
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt), allocatable, dimension(:,:) :: chunkPoss
integer(pInt) :: e, m, constituent, i
integer(pInt) :: e, m, c, i
character(len=65536) :: &
tag,line,devNull
logical :: echo
allocate(MicrostructureConfig(0))
line = '' ! to have it initialized
m = 0_pInt
echo =.false.
do while (trim(line) /= IO_EOF) ! read through sections of material part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
devNull = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundNextPart
nextSection: if (IO_getTag(line,'[',']') /= '') then
m = m + 1_pInt
microstructureConfig = [microstructureConfig, emptyList]
tag2 = IO_getTag(line,'[',']')
GfortranBug86033: if (.not. allocated(microstructure_name)) then
allocate(microstructure_name(1),source=tag2)
else GfortranBug86033
microstructure_name = [microstructure_name,tag2]
endif GfortranBug86033
endif nextSection
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
inSection: if (m > 0_pInt) then
chunkPos = IO_stringPos(line)
call microstructureConfig(m)%add(IO_lc(trim(line)),chunkPos)
else inSection
echo = (trim(tag) == '/echo/')
endif inSection
enddo
material_Nmicrostructure = size(microstructureConfig)
if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure)
tag
allocate(microstructure_crystallite(material_Nmicrostructure), source=0_pInt)
allocate(microstructure_Nconstituents(material_Nmicrostructure), source=0_pInt)
@ -845,166 +706,63 @@ character(len=65536) function material_parseMicrostructure(fileUnit)
allocate(microstructure_fraction(microstructure_maxNconstituents,material_Nmicrostructure),source=0.0_pReal)
do m=1_pInt, material_Nmicrostructure
call microstructureConfig(m)%getRaws('(constituent)',str,chunkPoss)
do constituent = 1_pInt, size(str)
do i = 2_pInt,6_pInt,2_pInt
tag = IO_lc(IO_stringValue(str(constituent),chunkPoss(:,constituent),i))
str = microstructureConfig(m)%getStrings('(constituent)',raw=.true.)
do c = 1_pInt, size(str)
chunkPos = IO_stringPos(str(c))
select case (tag)
case('phase')
microstructure_phase(constituent,m) = IO_intValue(str(constituent),chunkPoss(:,constituent),i+1_pInt)
case('texture')
microstructure_texture(constituent,m) = IO_intValue(str(constituent),chunkPoss(:,constituent),i+1_pInt)
do i = 1_pInt,5_pInt,2_pInt
tag = IO_stringValue(str(c),chunkPos,i)
case('fraction')
microstructure_fraction(constituent,m) = IO_floatValue(str(constituent),chunkPoss(:,constituent),i+1_pInt)
select case (tag)
case('phase')
microstructure_phase(c,m) = IO_intValue(str(c),chunkPos,i+1_pInt)
case('texture')
microstructure_texture(c,m) = IO_intValue(str(c),chunkPos,i+1_pInt)
case('fraction')
microstructure_fraction(c,m) = IO_floatValue(str(c),chunkPos,i+1_pInt)
end select
enddo
enddo
enddo
end select
enddo
enddo
enddo
!sanity check
do m = 1_pInt, material_Nmicrostructure
if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) &
call IO_error(153_pInt,ext_msg=microstructure_name(m))
enddo
material_parseMicrostructure = line
end function material_parseMicrostructure
end subroutine material_parseMicrostructure
!--------------------------------------------------------------------------------------------------
!> @brief parses the crystallite part in the material configuration file
!--------------------------------------------------------------------------------------------------
character(len=65536) function material_parseCrystallite(fileUnit)
use IO, only: &
IO_read, &
IO_error, &
IO_getTag, &
IO_lc, &
IO_stringPos, &
IO_stringValue, &
IO_isBlank, &
IO_EOF
subroutine material_parseCrystallite
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=64) :: tag2
integer(pInt) :: c
character(len=65536) :: line, tag,devNull
logical :: echo
allocate(crystalliteConfig(0))
c = 0_pInt
do while (trim(line) /= IO_EOF) ! read through sections of material part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
devNull = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundNextPart
nextSection: if (IO_getTag(line,'[',']') /= '') then
c = c + 1_pInt
crystalliteConfig = [crystalliteConfig, emptyList]
tag2 = IO_getTag(line,'[',']')
GfortranBug86033: if (.not. allocated(crystallite_name)) then
allocate(crystallite_name(1),source=tag2)
else GfortranBug86033
crystallite_name = [crystallite_name,tag2]
endif GfortranBug86033
endif nextSection
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
inSection: if (c > 0_pInt) then
chunkPos = IO_stringPos(line)
call crystalliteConfig(c)%add(IO_lc(trim(line)),chunkPos)
else inSection
echo = (trim(tag) == '/echo/')
endif inSection
enddo
material_Ncrystallite = size(crystalliteConfig)
if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite)
allocate(crystallite_Noutput(material_Ncrystallite), source=0_pInt)
allocate(crystallite_Noutput(material_Ncrystallite),source=0_pInt)
do c=1_pInt, material_Ncrystallite
crystallite_Noutput(c) = crystalliteConfig(c)%countKeys('(output)')
enddo
material_parseCrystallite = line
end function material_parseCrystallite
end subroutine material_parseCrystallite
!--------------------------------------------------------------------------------------------------
!> @brief parses the phase part in the material configuration file
!--------------------------------------------------------------------------------------------------
character(len=65536) function material_parsePhase(fileUnit)
use chained_list, only: &
emptyList
subroutine material_parsePhase
use IO, only: &
IO_read, &
IO_globalTagInPart, &
IO_countSections, &
IO_error, &
IO_countTagInPart, &
IO_getTag, &
IO_spotTagInPart, &
IO_lc, &
IO_isBlank, &
IO_stringValue, &
IO_stringPos, &
IO_EOF
IO_stringValue
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p
character(len=65536) :: &
tag,line,devNull
character(len=64) :: tag2
character(len=64), dimension(:), allocatable :: &
str
logical :: echo
character(len=256), dimension(:), allocatable :: str
allocate(phaseConfig(0))
line = '' ! to have it initialized
p = 0_pInt ! - " -
echo =.false.
do while (trim(line) /= IO_EOF) ! read through sections of material part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
devNull = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundNextPart
nextSection: if (IO_getTag(line,'[',']') /= '') then
p = p + 1_pInt
phaseConfig = [phaseConfig, emptyList]
tag2 = IO_getTag(line,'[',']')
GfortranBug86033: if (.not. allocated(phase_name)) then
allocate(phase_name(1),source=tag2)
else GfortranBug86033
phase_name = [phase_name,tag2]
endif GfortranBug86033
endif nextSection
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
inSection: if (p > 0_pInt) then
chunkPos = IO_stringPos(line)
call phaseConfig(p)%add(IO_lc(trim(line)),chunkPos)
else inSection
echo = (trim(tag) == '/echo/')
endif inSection
enddo
material_Nphase = size(phaseConfig)
if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase)
allocate(phase_elasticity(material_Nphase),source=ELASTICITY_undefined_ID)
allocate(phase_plasticity(material_Nphase),source=PLASTICITY_undefined_ID)
@ -1117,85 +875,35 @@ character(len=65536) function material_parsePhase(fileUnit)
phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p))
enddo
material_parsePhase = line
end function material_parsePhase
end subroutine material_parsePhase
!--------------------------------------------------------------------------------------------------
!> @brief parses the texture part in the material configuration file
!--------------------------------------------------------------------------------------------------
character(len=65536) function material_parseTexture(fileUnit)
subroutine material_parseTexture
use prec, only: &
dNeq
use IO, only: &
IO_read, &
IO_globalTagInPart, &
IO_countSections, &
IO_error, &
IO_countTagInPart, &
IO_getTag, &
IO_spotTagInPart, &
IO_lc, &
IO_isBlank, &
IO_floatValue, &
IO_stringValue, &
IO_stringPos, &
IO_EOF
IO_floatValue, &
IO_stringValue
use math, only: &
inRad, &
math_sampleRandomOri, &
math_I3, &
math_det33, &
math_inv33
math_det33
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt) :: section, gauss, fiber, j, t, i
character(len=65536), dimension(:), allocatable :: lines
integer(pInt), dimension(:), allocatable :: chunkPos
character(len=65536) :: tag
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: Nsections, section, gauss, fiber, j, t, i
character(len=64) :: tag2
character(len=256), dimension(:), allocatable :: bla
logical :: echo
character(len=65536) :: line, tag,devNull
allocate(textureConfig(0))
t = 0_pInt
do while (trim(line) /= IO_EOF) ! read through sections of material part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
devNull = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundNextPart
nextSection: if (IO_getTag(line,'[',']') /= '') then
t = t + 1_pInt
textureConfig = [textureConfig, emptyList]
tag2 = IO_getTag(line,'[',']')
GfortranBug86033: if (.not. allocated(texture_name)) then
allocate(texture_name(1),source=tag2)
else GfortranBug86033
texture_name = [texture_name,tag2]
endif GfortranBug86033
endif nextSection
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
inSection: if (t > 0_pInt) then
chunkPos = IO_stringPos(line)
call textureConfig(t)%add(IO_lc(trim(line)),chunkPos)
else inSection
echo = (trim(tag) == '/echo/')
endif inSection
enddo
material_Ntexture = size(textureConfig)
if (material_Ntexture < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture)
allocate(texture_ODFfile(material_Ntexture)); texture_ODFfile=''
allocate(texture_symmetry(material_Ntexture), source=1_pInt)
allocate(texture_Ngauss(material_Ntexture), source=0_pInt)
allocate(texture_Nfiber(material_Ntexture), source=0_pInt)
allocate(texture_ODFfile(material_Ntexture)); texture_ODFfile=''
allocate(texture_symmetry(material_Ntexture), source=1_pInt)
allocate(texture_Ngauss(material_Ntexture), source=0_pInt)
allocate(texture_Nfiber(material_Ntexture), source=0_pInt)
do t=1_pInt, material_Ntexture
texture_Ngauss(t) = textureConfig(t)%countKeys('(gauss)') &
@ -1214,109 +922,111 @@ character(len=65536) function material_parseTexture(fileUnit)
section = t
gauss = 0_pInt
fiber = 0_pInt
bla = textureConfig(t)%getStringsRaw()
if (textureConfig(t)%keyExists('axes')) then
lines = textureConfig(t)%getStrings('axes')
do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries
select case (lines(j))
case('x', '+x')
texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis
case('-x')
texture_transformation(j,1:3,t) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis
case('y', '+y')
texture_transformation(j,1:3,t) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis
case('-y')
texture_transformation(j,1:3,t) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis
case('z', '+z')
texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis
case('-z')
texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis
case default
call IO_error(157_pInt,t)
end select
enddo
if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157_pInt,t)
endif
lines: do i=1_pInt, size(bla)
line = bla(i)
tag=''
texture_ODFfile(t) = textureConfig(t)%getString('hybridia',defaultVal=tag)
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
textureType: select case(tag)
if (textureConfig(t)%keyExists('symmetry')) then
select case (textureConfig(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
case ('axes', 'rotation') textureType
do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries
tag = IO_lc(IO_stringValue(line,chunkPos,j+1_pInt))
select case (tag)
case('x', '+x')
texture_transformation(j,1:3,section) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis
case('-x')
texture_transformation(j,1:3,section) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis
case('y', '+y')
texture_transformation(j,1:3,section) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis
case('-y')
texture_transformation(j,1:3,section) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis
case('z', '+z')
texture_transformation(j,1:3,section) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis
case('-z')
texture_transformation(j,1:3,section) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis
case default
call IO_error(157_pInt,section)
end select
enddo
if(dNeq(math_det33(texture_transformation(1:3,1:3,section)),1.0_pReal)) &
call IO_error(157_pInt,section)
case ('hybridia') textureType
texture_ODFfile(section) = IO_stringValue(line,chunkPos,2_pInt)
case ('symmetry') textureType
tag = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
select case (tag)
case('orthotropic')
texture_symmetry(section) = 4_pInt
case('monoclinic')
texture_symmetry(section) = 2_pInt
case default
texture_symmetry(section) = 1_pInt
if (textureConfig(t)%keyExists('(random)')) then
lines = textureConfig(t)%getStrings('(random)',raw=.true.)
do i = 1_pInt, size(lines)
gauss = gauss + 1_pInt
texture_Gauss(1:3,gauss,t) = math_sampleRandomOri()
chunkPos = IO_stringPos(lines(i))
do j = 1_pInt,3_pInt,2_pInt
select case (IO_stringValue(lines(i),chunkPos,j))
case('scatter')
texture_Gauss(4,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('fraction')
texture_Gauss(5,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)
end select
enddo
enddo
endif
case ('(random)') textureType
gauss = gauss + 1_pInt
texture_Gauss(1:3,gauss,section) = math_sampleRandomOri()
do j = 2_pInt,4_pInt,2_pInt
tag = IO_lc(IO_stringValue(line,chunkPos,j))
select case (tag)
case('scatter')
texture_Gauss(4,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad
case('fraction')
texture_Gauss(5,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)
end select
enddo
lines = textureConfig(t)%getStringsRaw()
do i=1_pInt, size(lines)
chunkPos = IO_stringPos(lines(i))
tag = IO_stringValue(lines(i),chunkPos,1_pInt) ! extract key
textureType: select case(tag)
case ('(gauss)') textureType
gauss = gauss + 1_pInt
do j = 2_pInt,10_pInt,2_pInt
tag = IO_lc(IO_stringValue(line,chunkPos,j))
tag = IO_stringValue(lines(i),chunkPos,j)
select case (tag)
case('phi1')
texture_Gauss(1,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad
texture_Gauss(1,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('phi')
texture_Gauss(2,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad
texture_Gauss(2,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('phi2')
texture_Gauss(3,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad
texture_Gauss(3,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('scatter')
texture_Gauss(4,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad
texture_Gauss(4,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('fraction')
texture_Gauss(5,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)
texture_Gauss(5,gauss,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)
end select
enddo
case ('(fiber)') textureType
fiber = fiber + 1_pInt
do j = 2_pInt,12_pInt,2_pInt
tag = IO_lc(IO_stringValue(line,chunkPos,j))
tag = IO_stringValue(lines(i),chunkPos,j)
select case (tag)
case('alpha1')
texture_Fiber(1,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad
texture_Fiber(1,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('alpha2')
texture_Fiber(2,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad
texture_Fiber(2,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('beta1')
texture_Fiber(3,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad
texture_Fiber(3,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('beta2')
texture_Fiber(4,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad
texture_Fiber(4,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('scatter')
texture_Fiber(5,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad
texture_Fiber(5,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)*inRad
case('fraction')
texture_Fiber(6,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)
texture_Fiber(6,fiber,t) = IO_floatValue(lines(i),chunkPos,j+1_pInt)
end select
enddo
end select textureType
enddo lines
enddo
enddo
material_parseTexture = line
end function material_parseTexture
end subroutine material_parseTexture
!--------------------------------------------------------------------------------------------------
@ -1432,10 +1142,8 @@ subroutine material_populateGrains
allocate(orientationOfGrain(3,maxval(Ngrains)),source=0.0_pReal) ! reserve memory for maximum case
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out)
write(6,'(/,a/)') ' MATERIAL grain population'
write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#'
!$OMP END CRITICAL (write2out)
endif
homogenizationLoop: do homog = 1_pInt,material_Nhomogenization
dGrains = homogenization_Ngrains(homog) ! grain number per material point
@ -1443,11 +1151,8 @@ subroutine material_populateGrains
activePair: if (Ngrains(homog,micro) > 0_pInt) then
myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate
myNconstituents = microstructure_Nconstituents(micro) ! assign short name for number of constituents
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out)
write(6,'(/,a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains
!$OMP END CRITICAL (write2out)
endif
if (iand(myDebug,debug_levelBasic) /= 0_pInt) &
write(6,'(/,a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains
!--------------------------------------------------------------------------------------------------

View File

@ -223,7 +223,6 @@ end subroutine math_init
!> @brief check correctness of (some) math functions
!--------------------------------------------------------------------------------------------------
subroutine math_check
use prec, only: tol_math_check
use IO, only: IO_error
@ -1823,6 +1822,8 @@ function math_sampleFiberOri(alpha,beta,FWHM)
integer(pInt):: j,& !< index of smallest component
i
allocate(a(0))
allocate(idx(0))
fInC = [sin(alpha(1))*cos(alpha(2)), sin(alpha(1))*sin(alpha(2)), cos(alpha(1))]
fInS = [sin(beta(1))*cos(beta(2)), sin(beta(1))*sin(beta(2)), cos(beta(1))]
@ -2635,135 +2636,4 @@ real(pReal) pure function math_limit(a, left, right)
end function math_limit
!--------------------------------------------------------------------------------------------------
!> @brief Modified Bessel I function of order 0
!> @author John Burkardt
!> @details original version available on https://people.sc.fsu.edu/~jburkardt/f_src/toms715/toms715.html
!--------------------------------------------------------------------------------------------------
real(pReal) function bessel_i0 (x)
use, intrinsic :: IEEE_ARITHMETIC
implicit none
real(pReal), intent(in) :: x
integer(pInt) :: i
real(pReal) :: sump_p, sump_q, xAbs, xx
real(pReal), parameter, dimension(15) :: p_small = real( &
[-5.2487866627945699800e-18, -1.5982226675653184646e-14, -2.6843448573468483278e-11, &
-3.0517226450451067446e-08, -2.5172644670688975051e-05, -1.5453977791786851041e-02, &
-7.0935347449210549190e+00, -2.4125195876041896775e+03, -5.9545626019847898221e+05, &
-1.0313066708737980747e+08, -1.1912746104985237192e+10, -8.4925101247114157499e+11, &
-3.2940087627407749166e+13, -5.5050369673018427753e+14, -2.2335582639474375249e+15], pReal)
real(pReal), parameter, dimension(5) :: q_small = real( &
[-3.7277560179962773046e+03, 6.5158506418655165707e+06, -6.5626560740833869295e+09, &
3.7604188704092954661e+12, -9.7087946179594019126e+14], pReal)
real(pReal), parameter, dimension(8) :: p_large = real( &
[-3.9843750000000000000e-01, 2.9205384596336793945e+00, -2.4708469169133954315e+00, &
4.7914889422856814203e-01, -3.7384991926068969150e-03, -2.6801520353328635310e-03, &
9.9168777670983678974e-05, -2.1877128189032726730e-06], pReal)
real(pReal), parameter, dimension(7) :: q_large = real( &
[-3.1446690275135491500e+01, 8.5539563258012929600e+01, -6.0228002066743340583e+01, &
1.3982595353892851542e+01, -1.1151759188741312645e+00, 3.2547697594819615062e-02, &
-5.5194330231005480228e-04], pReal)
xAbs = abs(x)
argRange: if (xAbs < 5.55e-17_pReal) then
bessel_i0 = 1.0_pReal
else if (xAbs < 15.0_pReal) then argRange
xx = xAbs**2.0_pReal
sump_p = p_small(1)
do i = 2, 15
sump_p = sump_p * xx + p_small(i)
end do
xx = xx - 225.0_pReal
sump_q = ((((xx+q_small(1))*xx+q_small(2))*xx+q_small(3))*xx+q_small(4))*xx+q_small(5)
bessel_i0 = sump_p / sump_q
else if (xAbs <= 713.986_pReal) then argRange
xx = 1.0_pReal / xAbs - 2.0_pReal/30.0_pReal
sump_p = ((((((p_large(1)*xx+p_large(2))*xx+p_large(3))*xx+p_large(4))*xx+ &
p_large(5))*xx+p_large(6))*xx+p_large(7))*xx+p_large(8)
sump_q = ((((((xx+q_large(1))*xx+q_large(2))*xx+q_large(3))*xx+ &
q_large(4))*xx+q_large(5))*xx+q_large(6))*xx+q_large(7)
bessel_i0 = sump_p / sump_q
avoidOverflow: if (xAbs > 698.986_pReal) then
bessel_i0 = ((bessel_i0*exp(xAbs-40.0_pReal)-p_large(1)*exp(xAbs-40.0_pReal))/sqrt(xAbs))*exp(40.0)
else avoidOverflow
bessel_i0 = ((bessel_i0*exp(xAbs)-p_large(1)*exp(xAbs))/sqrt(xAbs))
endif avoidOverflow
else argRange
bessel_i0 = IEEE_value(bessel_i0,IEEE_positive_inf)
end if argRange
end function bessel_i0
!--------------------------------------------------------------------------------------------------
!> @brief Modified Bessel I function of order 1
!> @author John Burkardt
!> @details original version available on https://people.sc.fsu.edu/~jburkardt/f_src/toms715/toms715.html
!--------------------------------------------------------------------------------------------------
real(pReal) function bessel_i1 (x)
use, intrinsic :: IEEE_ARITHMETIC
implicit none
real(pReal), intent(in) :: x
integer(pInt) :: i
real(pReal) :: sump_p, sump_q, xAbs, xx
real(pReal), dimension(15), parameter :: p_small = real( &
[-1.9705291802535139930e-19, -6.5245515583151902910e-16, -1.1928788903603238754e-12, &
-1.4831904935994647675e-09, -1.3466829827635152875e-06, -9.1746443287817501309e-04, &
-4.7207090827310162436e-01, -1.8225946631657315931e+02, -5.1894091982308017540e+04, &
-1.0588550724769347106e+07, -1.4828267606612366099e+09, -1.3357437682275493024e+11, &
-6.9876779648010090070e+12, -1.7732037840791591320e+14, -1.4577180278143463643e+15], pReal)
real(pReal), dimension(5), parameter :: q_small = real( &
[-4.0076864679904189921e+03, 7.4810580356655069138e+06, -8.0059518998619764991e+09, &
4.8544714258273622913e+12, -1.3218168307321442305e+15], pReal)
real(pReal), dimension(8), parameter :: p_large = real( &
[-6.0437159056137600000e-02, 4.5748122901933459000e-01, -4.2843766903304806403e-01, &
9.7356000150886612134e-02, -3.2457723974465568321e-03, -3.6395264712121795296e-04, &
1.6258661867440836395e-05, -3.6347578404608223492e-07], pReal)
real(pReal), dimension(6), parameter :: q_large = real( &
[-3.8806586721556593450e+00, 3.2593714889036996297e+00, -8.5017476463217924408e-01, &
7.4212010813186530069e-02, -2.2835624489492512649e-03, 3.7510433111922824643e-05], pReal)
real(pReal), parameter :: pbar = 3.98437500e-01
xAbs = abs(x)
argRange: if (xAbs < 5.55e-17_pReal) then
bessel_i1 = 0.5_pReal * xAbs
else if (xAbs < 15.0_pReal) then argRange
xx = xAbs**2.0_pReal
sump_p = p_small(1)
do i = 2, 15
sump_p = sump_p * xx + p_small(i)
end do
xx = xx - 225.0_pReal
sump_q = ((((xx+q_small(1))*xx+q_small(2))*xx+q_small(3))*xx+q_small(4)) * xx + q_small(5)
bessel_i1 = (sump_p / sump_q) * xAbs
else if (xAbs <= 713.986_pReal) then argRange
xx = 1.0_pReal / xAbs - 2.0_pReal/30.0_pReal
sump_p = ((((((p_large(1)*xx+p_large(2))*xx+p_large(3))*xx+p_large(4))*xx+&
p_large(5))*xx+p_large(6))*xx+p_large(7))*xx+p_large(8)
sump_q = (((((xx+q_large(1))*xx+q_large(2))*xx+q_large(3))*xx+ q_large(4))*xx+q_large(5))*xx+q_large(6)
bessel_i1 = sump_p / sump_q
avoidOverflow: if (xAbs > 698.986_pReal) then
bessel_i1 = ((bessel_i1 * exp(xAbs-40.0_pReal) + pbar * exp(xAbs-40.0_pReal)) / sqrt(xAbs)) * exp(40.0_pReal)
else avoidOverflow
bessel_i1 = ((bessel_i1 * exp(xAbs) + pbar * exp(xAbs)) / sqrt(xAbs))
endif avoidOverflow
else argRange
bessel_i1 = IEEE_value(bessel_i1,IEEE_positive_inf)
end if argRange
if (x < 0.0_pReal) bessel_i1 = -bessel_i1
end function bessel_i1
end module math

View File

@ -151,8 +151,9 @@ subroutine plastic_disloUCLA_init(fileUnit)
phase_Noutput, &
PLASTICITY_DISLOUCLA_label, &
PLASTICITY_DISLOUCLA_ID, &
material_phase, &
plasticState, &
material_phase, &
plasticState
use config, only: &
MATERIAL_partPhase
use lattice
use numerics,only: &

View File

@ -239,7 +239,8 @@ subroutine plastic_dislotwin_init(fileUnit)
PLASTICITY_DISLOTWIN_label, &
PLASTICITY_DISLOTWIN_ID, &
material_phase, &
plasticState, &
plasticState
use config, only: &
MATERIAL_partPhase
use lattice
use numerics,only: &

View File

@ -97,7 +97,8 @@ use IO
PLASTICITY_ISOTROPIC_label, &
PLASTICITY_ISOTROPIC_ID, &
material_phase, &
plasticState, &
plasticState
use config, only: &
MATERIAL_partPhase, &
phaseConfig

View File

@ -12,32 +12,32 @@ module plastic_kinehardening
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
plastic_kinehardening_sizePostResults !< cumulative size of post results
plastic_kinehardening_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
plastic_kinehardening_sizePostResult !< size of each post result output
plastic_kinehardening_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
plastic_kinehardening_output !< name of each post result output
plastic_kinehardening_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
plastic_kinehardening_Noutput !< number of outputs per instance
plastic_kinehardening_Noutput !< number of outputs per instance
integer(pInt), dimension(:), allocatable, public, protected :: &
plastic_kinehardening_totalNslip !< no. of slip system used in simulation
plastic_kinehardening_totalNslip !< no. of slip system used in simulation
integer(pInt), dimension(:,:), allocatable, private :: &
plastic_kinehardening_Nslip !< active number of slip systems per family (input parameter, per family)
plastic_kinehardening_Nslip !< active number of slip systems per family (input parameter, per family)
enum, bind(c)
enumerator :: undefined_ID, &
crss_ID, & !< critical resolved stress
crss_back_ID, & !< critical resolved back stress
sense_ID, & !< sense of acting shear stress (-1 or +1)
chi0_ID, & !< backstress at last switch of stress sense (positive?)
gamma0_ID, & !< accumulated shear at last switch of stress sense (at current switch?)
crss_ID, & !< critical resolved stress
crss_back_ID, & !< critical resolved back stress
sense_ID, & !< sense of acting shear stress (-1 or +1)
chi0_ID, & !< backstress at last switch of stress sense (positive?)
gamma0_ID, & !< accumulated shear at last switch of stress sense (at current switch?)
accshear_ID, &
sumGamma_ID, &
shearrate_ID, &
@ -46,26 +46,26 @@ module plastic_kinehardening
end enum
type, private :: tParameters !< container type for internal constitutive parameters
type, private :: tParameters !< container type for internal constitutive parameters
integer(kind(undefined_ID)), dimension(:), allocatable, private :: &
outputID !< ID of each post result output
outputID !< ID of each post result output
real(pReal) :: &
gdot0, & !< reference shear strain rate for slip (input parameter)
n_slip, & !< stress exponent for slip (input parameter)
gdot0, & !< reference shear strain rate for slip (input parameter)
n_slip, & !< stress exponent for slip (input parameter)
aTolResistance, &
aTolShear
real(pReal), dimension(:), allocatable, private :: &
crss0, & !< initial critical shear stress for slip (input parameter, per family)
theta0, & !< initial hardening rate of forward stress for each slip
theta1, & !< asymptotic hardening rate of forward stress for each slip >
theta0_b, & !< initial hardening rate of back stress for each slip >
theta1_b, & !< asymptotic hardening rate of back stress for each slip >
crss0, & !< initial critical shear stress for slip (input parameter, per family)
theta0, & !< initial hardening rate of forward stress for each slip
theta1, & !< asymptotic hardening rate of forward stress for each slip >
theta0_b, & !< initial hardening rate of back stress for each slip >
theta1_b, & !< asymptotic hardening rate of back stress for each slip >
tau1, &
tau1_b, &
interaction_slipslip, & !< latent hardening matrix
interaction_slipslip, & !< latent hardening matrix
nonSchmidCoeff
real(pReal), dimension(:,:), allocatable, private :: &
@ -73,20 +73,20 @@ module plastic_kinehardening
end type
type, private :: tKinehardeningState
real(pReal), pointer, dimension(:,:) :: & !< vectors along NipcMyInstance
crss, & !< critical resolved stress
crss_back, & !< critical resolved back stress
sense, & !< sense of acting shear stress (-1 or +1)
chi0, & !< backstress at last switch of stress sense
gamma0, & !< accumulated shear at last switch of stress sense
accshear !< accumulated (absolute) shear
real(pReal), pointer, dimension(:,:) :: & !< vectors along NipcMyInstance
crss, & !< critical resolved stress
crss_back, & !< critical resolved back stress
sense, & !< sense of acting shear stress (-1 or +1)
chi0, & !< backstress at last switch of stress sense
gamma0, & !< accumulated shear at last switch of stress sense
accshear !< accumulated (absolute) shear
real(pReal), pointer, dimension(:) :: & !< scalars along NipcMyInstance
sumGamma !< accumulated shear across all systems
real(pReal), pointer, dimension(:) :: & !< scalars along NipcMyInstance
sumGamma !< accumulated shear across all systems
end type
type(tParameters), dimension(:), allocatable, private :: &
param !< containers of constitutive parameters (len Ninstance)
param !< containers of constitutive parameters (len Ninstance)
type(tKinehardeningState), allocatable, dimension(:), private :: &
dotState, &
@ -145,7 +145,8 @@ subroutine plastic_kinehardening_init(fileUnit)
phase_plasticityInstance, &
phase_Noutput, &
material_phase, &
plasticState, &
plasticState
use config, only: &
MATERIAL_partPhase
use lattice
use numerics,only: &
@ -155,9 +156,10 @@ subroutine plastic_kinehardening_init(fileUnit)
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(kind(undefined_ID)) :: &
output_ID
integer(pInt) :: &
o, j, k, f, &
output_ID, &
phase, &
instance, &
maxNinstance, &
@ -177,8 +179,6 @@ subroutine plastic_kinehardening_init(fileUnit)
tag = '', &
line = '', &
extmsg = ''
character(len=64) :: &
outputtag = ''
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_KINEHARDENING_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -220,7 +220,6 @@ subroutine plastic_kinehardening_init(fileUnit)
Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase
Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase))
Nchunks_nonSchmid = lattice_NnonSchmid(phase)
allocate(param(instance)%outputID(phase_Noutput(phase)), source=undefined_ID) ! allocate space for IDs of every requested output
allocate(param(instance)%crss0 (Nchunks_SlipFamilies), source=0.0_pReal)
allocate(param(instance)%tau1 (Nchunks_SlipFamilies), source=0.0_pReal)
allocate(param(instance)%tau1_b (Nchunks_SlipFamilies), source=0.0_pReal)
@ -236,39 +235,48 @@ subroutine plastic_kinehardening_init(fileUnit)
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_KINEHARDENING_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran
instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
output_ID = undefined_ID
select case(outputtag)
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('resistance')
output_ID = crss_ID
case ('backstress')
output_ID = crss_back_ID
case ('sense')
output_ID = sense_ID
case ('chi0')
output_ID = chi0_ID
case ('gamma0')
output_ID = gamma0_ID
case ('accumulatedshear')
output_ID = accshear_ID
case ('totalshear')
output_ID = sumGamma_ID
case ('shearrate')
output_ID = shearrate_ID
case ('resolvedstress')
output_ID = resolvedstress_ID
end select
if (output_ID /= undefined_ID) then
plastic_kinehardening_Noutput(instance) = plastic_kinehardening_Noutput(instance) + 1_pInt
plastic_kinehardening_output(plastic_kinehardening_Noutput(instance),instance) = outputtag
param(instance)%outputID (plastic_kinehardening_Noutput(instance)) = output_ID
plastic_kinehardening_output(plastic_kinehardening_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
param(instance)%outputID = [param(instance)%outputID, output_ID]
endif
!--------------------------------------------------------------------------------------------------
! parameters depending on number of slip families
case ('nslip')
@ -619,7 +627,6 @@ subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dTstar99, &
math_transpose33
use lattice, only: &
lattice_Sslip, & !< schmid matrix
lattice_Sslip_v, &
lattice_maxNslipFamily, &
lattice_NslipSystem, &
lattice_NnonSchmid
@ -739,8 +746,6 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el)
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), dimension(6) :: &
Tstar_dev_v !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation
real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(phaseAt(ipc,ip,el)))) :: &
gdot_pos,gdot_neg, &
tau_pos,tau_neg, &
@ -799,14 +804,10 @@ end subroutine plastic_kinehardening_deltaState
!--------------------------------------------------------------------------------------------------
subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el)
use lattice, only: &
lattice_Sslip_v, &
lattice_maxNslipFamily, &
lattice_NslipSystem, &
lattice_NnonSchmid
lattice_maxNslipFamily
use material, only: &
material_phase, &
phaseAt, phasememberAt, &
plasticState, &
phase_plasticityInstance
implicit none
@ -819,10 +820,8 @@ subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el)
integer(pInt) :: &
instance,ph, &
f,i,j,k, &
index_myFamily,index_otherFamily, &
f,i,j, &
nSlip, &
offset_accshear, &
of
real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
@ -873,14 +872,12 @@ end subroutine plastic_kinehardening_dotState
function plastic_kinehardening_postResults(Tstar_v,ipc,ip,el)
use material, only: &
material_phase, &
plasticState, &
phaseAt, phasememberAt, &
phase_plasticityInstance
use lattice, only: &
lattice_Sslip_v, &
lattice_maxNslipFamily, &
lattice_NslipSystem, &
lattice_NnonSchmid
lattice_NslipSystem
implicit none
real(pReal), dimension(6), intent(in) :: &
@ -896,7 +893,7 @@ function plastic_kinehardening_postResults(Tstar_v,ipc,ip,el)
integer(pInt) :: &
instance,ph, of, &
nSlip,&
o,f,i,c,j,k, &
o,f,i,c,j,&
index_myFamily
real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &

View File

@ -291,8 +291,8 @@ use material, only: phase_plasticity, &
PLASTICITY_NONLOCAL_label, &
PLASTICITY_NONLOCAL_ID, &
plasticState, &
MATERIAL_partPhase ,&
material_phase
use config, only: MATERIAL_partPhase
use lattice
use numerics,only: &
numerics_integrator

View File

@ -128,10 +128,9 @@ subroutine plastic_phenopowerlaw_init
PLASTICITY_PHENOPOWERLAW_label, &
PLASTICITY_PHENOPOWERLAW_ID, &
material_phase, &
plasticState, &
MATERIAL_partPhase, &
phaseConfig
plasticState
use config, only: &
MATERIAL_partPhase
use lattice
use numerics,only: &
numerics_integrator

View File

@ -27,6 +27,7 @@ subroutine porosity_none_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &

View File

@ -77,11 +77,10 @@ subroutine porosity_phasefield_init(fileUnit)
porosityState, &
porosityMapping, &
porosity, &
porosity_initialPhi, &
porosity_initialPhi
use config, only: &
material_partHomogenization, &
material_partPhase
use numerics,only: &
worldrank
implicit none
integer(pInt), intent(in) :: fileUnit
@ -94,11 +93,9 @@ subroutine porosity_phasefield_init(fileUnit)
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_phasefield_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_phasefield_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(porosity_type == POROSITY_phasefield_ID),pInt)
if (maxNinstance == 0_pInt) return

View File

@ -91,9 +91,10 @@ subroutine source_damage_anisoBrittle_init(fileUnit)
phase_Noutput, &
SOURCE_damage_anisoBrittle_label, &
SOURCE_damage_anisoBrittle_ID, &
material_phase, &
sourceState
use config, only: &
material_Nphase, &
material_phase, &
sourceState, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

View File

@ -95,9 +95,10 @@ subroutine source_damage_anisoDuctile_init(fileUnit)
phase_Noutput, &
SOURCE_damage_anisoDuctile_label, &
SOURCE_damage_anisoDuctile_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

View File

@ -81,9 +81,10 @@ subroutine source_damage_isoBrittle_init(fileUnit)
phase_Noutput, &
SOURCE_damage_isoBrittle_label, &
SOURCE_damage_isoBrittle_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

View File

@ -81,10 +81,12 @@ subroutine source_damage_isoDuctile_init(fileUnit)
phase_Noutput, &
SOURCE_damage_isoDuctile_label, &
SOURCE_damage_isoDuctile_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

View File

@ -67,9 +67,10 @@ subroutine source_thermal_dissipation_init(fileUnit)
phase_Noutput, &
SOURCE_thermal_dissipation_label, &
SOURCE_thermal_dissipation_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

View File

@ -73,9 +73,10 @@ subroutine source_thermal_externalheat_init(fileUnit)
phase_Noutput, &
SOURCE_thermal_externalheat_label, &
SOURCE_thermal_externalheat_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

View File

@ -69,9 +69,10 @@ subroutine source_vacancy_irradiation_init(fileUnit)
phase_Noutput, &
SOURCE_vacancy_irradiation_label, &
SOURCE_vacancy_irradiation_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

View File

@ -67,9 +67,10 @@ subroutine source_vacancy_phenoplasticity_init(fileUnit)
phase_Noutput, &
SOURCE_vacancy_phenoplasticity_label, &
SOURCE_vacancy_phenoplasticity_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

View File

@ -71,9 +71,10 @@ subroutine source_vacancy_thermalfluc_init(fileUnit)
phase_Noutput, &
SOURCE_vacancy_thermalfluc_label, &
SOURCE_vacancy_thermalfluc_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

View File

@ -2,7 +2,7 @@
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Basic scheme PETSc solver
!> @brief Basic scheme solver
!--------------------------------------------------------------------------------------------------
module spectral_mech_basic
#include <petsc/finclude/petscsnes.h>
@ -22,7 +22,7 @@ module spectral_mech_basic
private
character (len=*), parameter, public :: &
DAMASK_spectral_SolverBasicPETSC_label = 'basic'
DAMASK_spectral_SolverBasic_label = 'basic'
!--------------------------------------------------------------------------------------------------
! derived types
@ -65,9 +65,9 @@ module spectral_mech_basic
real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal
public :: &
basicPETSc_init, &
basicPETSc_solution, &
BasicPETSc_forward
basic_init, &
basic_solution, &
basic_forward
external :: &
PETScErrorF ! is called in the CHKERRQ macro
@ -76,7 +76,7 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine basicPETSc_init
subroutine basic_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
@ -124,9 +124,9 @@ subroutine basicPETSc_init
external :: &
SNESSetOptionsPrefix, &
SNESSetConvergenceTest, &
DMDASNESsetFunctionLocal
DMDASNESSetFunctionLocal
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>'
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasic init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:3145, 2015'
write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -158,9 +158,9 @@ subroutine basicPETSc_init
call DMsetFromOptions(da,ierr); CHKERRQ(ierr)
call DMsetUp(da,ierr); CHKERRQ(ierr)
call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor)
call DMDASNESsetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector
call DMDASNESsetFunctionLocal(da,INSERT_VALUES,Basic_formResidual,PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector
CHKERRQ(ierr)
call SNESsetConvergenceTest(snes,BasicPETSC_converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged"
call SNESsetConvergenceTest(snes,Basic_converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged"
CHKERRQ(ierr)
call SNESsetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional CLI arguments
@ -212,12 +212,12 @@ subroutine basicPETSc_init
call Utilities_updateGamma(C_minMaxAvg,.true.)
end subroutine basicPETSc_init
end subroutine basic_init
!--------------------------------------------------------------------------------------------------
!> @brief solution for the Basic PETSC scheme with internal iterations
!> @brief solution for the Basic scheme with internal iterations
!--------------------------------------------------------------------------------------------------
type(tSolutionState) function basicPETSc_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC)
type(tSolutionState) function basic_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC)
use IO, only: &
IO_error
use numerics, only: &
@ -275,19 +275,19 @@ type(tSolutionState) function basicPETSc_solution(incInfoIn,timeinc,timeinc_old,
! check convergence
call SNESGetConvergedReason(snes,reason,ierr); CHKERRQ(ierr)
BasicPETSc_solution%converged = reason > 0
basicPETSC_solution%iterationsNeeded = totalIter
basicPETSc_solution%termIll = terminallyIll
basic_solution%converged = reason > 0
basic_solution%iterationsNeeded = totalIter
basic_solution%termIll = terminallyIll
terminallyIll = .false.
if (reason == -4) call IO_error(893_pInt) ! MPI error
end function BasicPETSc_solution
end function basic_solution
!--------------------------------------------------------------------------------------------------
!> @brief forms the basic residual vector
!--------------------------------------------------------------------------------------------------
subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
subroutine Basic_formResidual(in,x_scal,f_scal,dummy,ierr)
use numerics, only: &
itmax, &
itmin
@ -370,13 +370,13 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
! constructing residual
f_scal = tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) ! Gamma*P gives correction towards div(P) = 0, so needs to be zero, too
end subroutine BasicPETSc_formResidual
end subroutine Basic_formResidual
!--------------------------------------------------------------------------------------------------
!> @brief convergence check
!--------------------------------------------------------------------------------------------------
subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr)
subroutine Basic_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr)
use numerics, only: &
itmax, &
itmin, &
@ -425,14 +425,14 @@ subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,du
write(6,'(/,a)') ' ==========================================================================='
flush(6)
end subroutine BasicPETSc_converged
end subroutine Basic_converged
!--------------------------------------------------------------------------------------------------
!> @brief forwarding routine
!> @details find new boundary conditions and best F estimate for end of current timestep
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
!--------------------------------------------------------------------------------------------------
subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
subroutine Basic_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
use math, only: &
math_mul33x33 ,&
math_rotate_backward33
@ -538,6 +538,6 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation
math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3])
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
end subroutine BasicPETSc_forward
end subroutine Basic_forward
end module spectral_mech_basic

View File

@ -64,6 +64,8 @@ subroutine thermal_adiabatic_init(fileUnit)
IO_error, &
IO_timeStamp, &
IO_EOF
use config, only: &
material_partHomogenization
use material, only: &
thermal_type, &
thermal_typeInstance, &
@ -76,8 +78,7 @@ subroutine thermal_adiabatic_init(fileUnit)
thermalMapping, &
thermal_initialT, &
temperature, &
temperatureRate, &
material_partHomogenization
temperatureRate
implicit none
integer(pInt), intent(in) :: fileUnit

View File

@ -77,7 +77,8 @@ subroutine thermal_conduction_init(fileUnit)
thermalMapping, &
thermal_initialT, &
temperature, &
temperatureRate, &
temperatureRate
use config, only: &
material_partHomogenization
implicit none

View File

@ -27,6 +27,7 @@ subroutine thermal_isothermal_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &

View File

@ -91,9 +91,10 @@ subroutine vacancyflux_cahnhilliard_init(fileUnit)
vacancyfluxMapping, &
vacancyConc, &
vacancyConcRate, &
vacancyflux_initialCv, &
material_partHomogenization, &
material_partPhase
vacancyflux_initialCv
use config, only: &
material_partPhase, &
material_partHomogenization
implicit none
integer(pInt), intent(in) :: fileUnit

View File

@ -74,7 +74,8 @@ subroutine vacancyflux_isochempot_init(fileUnit)
vacancyfluxMapping, &
vacancyConc, &
vacancyConcRate, &
vacancyflux_initialCv, &
vacancyflux_initialCv
use config, only: &
material_partHomogenization
implicit none

View File

@ -27,6 +27,7 @@ subroutine vacancyflux_isoconc_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &