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" IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016"
IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017" IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017"
IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018" IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018"
GNUCompiler5_3: "Compiler/GNU/5.3" GNUCompiler7_3: "Compiler/GNU/7.3"
# ------------ Defaults ---------------------------------------------- # ------------ Defaults ----------------------------------------------
IntelCompiler: "$IntelCompiler18_1" IntelCompiler: "$IntelCompiler18_1"
GNUCompiler: "$GNUCompiler5_3" GNUCompiler: "$GNUCompiler7_3"
# ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++ # ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++
MPICH3_2Intel17_0: "MPI/Intel/17.0/MPICH/3.2" MPICH3_2Intel17_0: "MPI/Intel/17.0/MPICH/3.2"
MPICH3_2Intel18_1: "MPI/Intel/18.1/MPICH/3.2.1" 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 ---------------------------------------------- # ------------ Defaults ----------------------------------------------
MPICH_GNU: "$MPICH3_2GNU5_3" MPICH_GNU: "$MPICH3_2GNU7_3"
MPICH_Intel: "$MPICH3_2Intel18_1" MPICH_Intel: "$MPICH3_2Intel18_1"
# ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++ # ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++
PETSc3_9_1MPICH3_2Intel18_1: "Libraries/PETSc/3.9.1/Intel-18.1-MPICH-3.2.1" 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 ---------------------------------------------- # ------------ Defaults ----------------------------------------------
PETSc_MPICH_Intel: "$PETSc3_9_1MPICH3_2Intel18_1" 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 +++++++++++++++++++++++++++++++++++++++++++++++++++ # ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++
Abaqus2016: "FEM/Abaqus/2016" Abaqus2016: "FEM/Abaqus/2016"
Abaqus2017: "FEM/Abaqus/2017" Abaqus2017: "FEM/Abaqus/2017"

View File

@ -5,8 +5,8 @@ cmake_minimum_required (VERSION 2.8.8 FATAL_ERROR)
#--------------------------------------------------------------------------------------- #---------------------------------------------------------------------------------------
# Find PETSc from system environment # Find PETSc from system environment
set(PETSC_DIR $ENV{PETSC_DIR}) set(PETSC_DIR $ENV{PETSC_DIR})
if ("${PETSC_DIR}" STREQUAL "") if (PETSC_DIR STREQUAL "")
message (FATAL_ERROR "PETSC_DIR is not defined") message (FATAL_ERROR "PETSc location (PETSC_DIR) is not defined")
endif () endif ()
set (petsc_conf_variables "${PETSC_DIR}/lib/petsc/conf/variables") 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 # Now start to care about DAMASK
# DAMASK solver defines project to build # DAMASK solver defines project to build
if ("${DAMASK_SOLVER}" STREQUAL "SPECTRAL") if (DAMASK_SOLVER STREQUAL "SPECTRAL")
project (DAMASK_spectral Fortran C) project (DAMASK_spectral Fortran C)
add_definitions (-DSpectral) add_definitions (-DSpectral)
message ("Building Spectral Solver\n") message ("Building Spectral Solver\n")
elseif ("${DAMASK_SOLVER}" STREQUAL "FEM") elseif (DAMASK_SOLVER STREQUAL "FEM")
project (DAMASK_FEM Fortran C) project (DAMASK_FEM Fortran C)
add_definitions (-DFEM) add_definitions (-DFEM)
message ("Building FEM Solver\n") message ("Building FEM Solver\n")
else ()
message (FATAL_ERROR "Build target (DAMASK_SOLVER) is not defined")
endif () endif ()
# set linker commands (needs to be done after defining the project) # set linker commands (needs to be done after defining the project)
set (CMAKE_LINKER "${PETSC_LINKER}") set (CMAKE_LINKER "${PETSC_LINKER}")
if ("${CMAKE_BUILD_TYPE}" STREQUAL "") if (CMAKE_BUILD_TYPE STREQUAL "")
set (CMAKE_BUILD_TYPE "RELEASE") set (CMAKE_BUILD_TYPE "RELEASE")
endif () endif ()
# Predefined sets for OPTIMIZATION/OPENMP based on BUILD_TYPE # 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 (DEBUG_FLAGS "${DEBUG_FLAGS} -DDEBUG")
set (PARALLEL "OFF") set (PARALLEL "OFF")
set (OPTI "OFF") set (OPTI "OFF")
elseif ("${CMAKE_BUILD_TYPE}" STREQUAL "RELEASE") elseif (CMAKE_BUILD_TYPE STREQUAL "RELEASE")
set (PARALLEL "ON") set (PARALLEL "ON")
set (OPTI "DEFENSIVE") set (OPTI "DEFENSIVE")
elseif ("${CMAKE_BUILD_TYPE}" STREQUAL "PERFORMANCE") elseif (CMAKE_BUILD_TYPE STREQUAL "PERFORMANCE")
set (PARALLEL "ON") set (PARALLEL "ON")
set (OPTI "AGGRESSIVE") set (OPTI "AGGRESSIVE")
endif () endif ()
# $OPTIMIZATION takes precedence over $BUILD_TYPE defaults # $OPTIMIZATION takes precedence over $BUILD_TYPE defaults
if ("${OPTIMIZATION}" STREQUAL "") if (OPTIMIZATION STREQUAL "")
set (OPTIMIZATION "${OPTI}") set (OPTIMIZATION "${OPTI}")
else () else ()
set (OPTIMIZATION "${OPTIMIZATION}") set (OPTIMIZATION "${OPTIMIZATION}")
endif () endif ()
# $OPENMP takes precedence over $BUILD_TYPE defaults # $OPENMP takes precedence over $BUILD_TYPE defaults
if ("${OPENMP}" STREQUAL "") if (OPENMP STREQUAL "")
set (OPENMP "${PARALLEL}") set (OPENMP "${PARALLEL}")
else () else ()
set(OPENMP "${OPENMP}") set(OPENMP "${OPENMP}")
endif () endif ()
# syntax check only (mainly for pre-receive hook, works only with gfortran) # 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") set (BUILDCMD_POST "${BUILDCMD_POST} -fsyntax-only")
endif () endif ()
@ -188,17 +190,17 @@ set (DAMASK_INCLUDE_FLAGS "${DAMASK_INCLUDE_FLAGS} ${PETSC_INCLUDES}")
################################################################################################### ###################################################################################################
# Intel Compiler # Intel Compiler
################################################################################################### ###################################################################################################
if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel")
if (OPENMP) if (OPENMP)
set (OPENMP_FLAGS "-qopenmp -parallel") set (OPENMP_FLAGS "-qopenmp -parallel")
endif () endif ()
if ("${OPTIMIZATION}" STREQUAL "OFF") if (OPTIMIZATION STREQUAL "OFF")
set (OPTIMIZATION_FLAGS "-O0 -no-ip") set (OPTIMIZATION_FLAGS "-O0 -no-ip")
elseif ("${OPTIMIZATION}" STREQUAL "DEFENSIVE") elseif (OPTIMIZATION STREQUAL "DEFENSIVE")
set (OPTIMIZATION_FLAGS "-O2") set (OPTIMIZATION_FLAGS "-O2")
elseif ("${OPTIMIZATION}" STREQUAL "AGGRESSIVE") elseif (OPTIMIZATION STREQUAL "AGGRESSIVE")
set (OPTIMIZATION_FLAGS "-ipo -O3 -no-prec-div -fp-model fast=2 -xHost") 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" # -fast = -ipo, -O3, -no-prec-div, -static, -fp-model fast=2, and -xHost"
endif () endif ()
@ -308,17 +310,17 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel")
################################################################################################### ###################################################################################################
# GNU Compiler # GNU Compiler
################################################################################################### ###################################################################################################
elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
if (OPENMP) if (OPENMP)
set (OPENMP_FLAGS "-fopenmp") set (OPENMP_FLAGS "-fopenmp")
endif () endif ()
if ("${OPTIMIZATION}" STREQUAL "OFF") if (OPTIMIZATION STREQUAL "OFF")
set (OPTIMIZATION_FLAGS "-O0" ) set (OPTIMIZATION_FLAGS "-O0" )
elseif ("${OPTIMIZATION}" STREQUAL "DEFENSIVE") elseif (OPTIMIZATION STREQUAL "DEFENSIVE")
set (OPTIMIZATION_FLAGS "-O2") set (OPTIMIZATION_FLAGS "-O2")
elseif ("${OPTIMIZATION}" STREQUAL "AGGRESSIVE") elseif (OPTIMIZATION STREQUAL "AGGRESSIVE")
set (OPTIMIZATION_FLAGS "-O3 -ffast-math -funroll-loops -ftree-vectorize") set (OPTIMIZATION_FLAGS "-O3 -ffast-math -funroll-loops -ftree-vectorize")
endif () endif ()
@ -443,12 +445,15 @@ elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU")
# Additional options # 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) # -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 () endif ()
set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${BUILDCMD_PRE} ${OPENMP_FLAGS} ${STANDARD_CHECK} ${OPTIMIZATION_FLAGS} ${COMPILE_FLAGS} ${PRECISION_FLAGS}") 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}") 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_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${DEBUG_FLAGS}")
set (CMAKE_Fortran_LINK_EXECUTABLE "${CMAKE_Fortran_LINK_EXECUTABLE} ${DEBUG_FLAGS}") set (CMAKE_Fortran_LINK_EXECUTABLE "${CMAKE_Fortran_LINK_EXECUTABLE} ${DEBUG_FLAGS}")
endif () endif ()
@ -464,15 +469,15 @@ message ("Fortran Linker Command:\n${CMAKE_Fortran_LINK_EXECUTABLE}\n")
add_subdirectory (src) add_subdirectory (src)
# INSTALL BUILT BINARIES # INSTALL BUILT BINARIES
if ("${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY") if (CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
exec_program (mktemp ARGS -d OUTPUT_VARIABLE BLACK_HOLE) exec_program (mktemp ARGS -d OUTPUT_VARIABLE BLACK_HOLE)
install (PROGRAMS ${PROJECT_BINARY_DIR}/src/prec.mod install (PROGRAMS ${PROJECT_BINARY_DIR}/src/prec.mod
DESTINATION ${BLACK_HOLE}) DESTINATION ${BLACK_HOLE})
else () else ()
if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral") if (PROJECT_NAME STREQUAL "DAMASK_spectral")
install (PROGRAMS ${PROJECT_BINARY_DIR}/src/DAMASK_spectral install (PROGRAMS ${PROJECT_BINARY_DIR}/src/DAMASK_spectral
DESTINATION ${CMAKE_INSTALL_PREFIX}) DESTINATION ${CMAKE_INSTALL_PREFIX})
elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM") elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
install (PROGRAMS ${PROJECT_BINARY_DIR}/src/DAMASK_FEM install (PROGRAMS ${PROJECT_BINARY_DIR}/src/DAMASK_FEM
DESTINATION ${CMAKE_INSTALL_PREFIX}) DESTINATION ${CMAKE_INSTALL_PREFIX})
endif () endif ()

View File

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

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

View File

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

View File

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

View File

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

View File

@ -982,6 +982,10 @@ pure function IO_stringPos(string)
if ( string(left:left) == '#' ) exit if ( string(left:left) == '#' ) exit
IO_stringPos = [IO_stringPos,int(left, pInt), int(right, pInt)] IO_stringPos = [IO_stringPos,int(left, pInt), int(right, pInt)]
IO_stringPos(1) = IO_stringPos(1)+1_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 enddo
end function IO_stringPos end function IO_stringPos
@ -1546,6 +1550,17 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
case (136_pInt) case (136_pInt)
msg = 'zero entry on stiffness diagonal for transformed phase' 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 ! material error messages and related messages in mesh
case (150_pInt) case (150_pInt)

View File

@ -4,9 +4,10 @@
!> @details List of files needed by MSC.Marc, Abaqus/Explicit, and Abaqus/Standard !> @details List of files needed by MSC.Marc, Abaqus/Explicit, and Abaqus/Standard
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
#include "IO.f90" #include "IO.f90"
#include "list.f90"
#include "numerics.f90" #include "numerics.f90"
#include "debug.f90" #include "debug.f90"
#include "linked_list.f90"
#include "config.f90"
#include "math.f90" #include "math.f90"
#include "FEsolving.f90" #include "FEsolving.f90"
#include "mesh.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 IO_timeStamp
use mesh, only: & use mesh, only: &
FE_geomtype FE_geomtype
use material, only: & use config, only: &
material_phase, &
material_Nphase, & material_Nphase, &
material_localFileExt, & material_localFileExt, &
material_configFile, &
phase_name, & phase_name, &
material_configFile
use material, only: &
material_phase, &
phase_plasticity, & phase_plasticity, &
phase_plasticityInstance, & phase_plasticityInstance, &
phase_Nsources, & phase_Nsources, &

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1263,7 +1263,7 @@ subroutine lattice_init
IO_stringPos, & IO_stringPos, &
IO_stringValue, & IO_stringValue, &
IO_floatValue IO_floatValue
use material, only: & use config, only: &
material_configfile, & material_configfile, &
material_localFileExt, & material_localFileExt, &
material_partPhase 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' !! 'phase', 'texture', and 'microstucture'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module material module material
use chained_list use config
use linked_list
use prec, only: & use prec, only: &
pReal, & pReal, &
pInt, & pInt, &
@ -142,15 +143,6 @@ module material
HOMOGENIZATION_rgc_ID HOMOGENIZATION_rgc_ID
end enum 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 :: & integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: &
phase_elasticity !< elasticity of each phase phase_elasticity !< elasticity of each phase
integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: & integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: &
@ -174,17 +166,8 @@ module material
integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: & integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: &
homogenization_type !< type of each homogenization 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 :: & integer(pInt), public, protected :: &
homogenization_maxNgrains, & !< max number of grains in any USED homogenization 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
integer(pInt), dimension(:), allocatable, public, protected :: & integer(pInt), dimension(:), allocatable, public, protected :: &
phase_Nsources, & !< number of source mechanisms active in each phase phase_Nsources, & !< number of source mechanisms active in each phase
@ -243,19 +226,10 @@ module material
phase_localPlasticity !< flags phases with local constitutive law 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 :: & character(len=256), dimension(:), allocatable, private :: &
texture_ODFfile !< name of each ODF file texture_ODFfile !< name of each ODF file
integer(pInt), private :: & integer(pInt), private :: &
material_Ntexture, & !< number of textures
microstructure_maxNconstituents, & !< max number of constituents in any phase microstructure_maxNconstituents, & !< max number of constituents in any phase
texture_maxNgauss, & !< max number of Gauss components in any texture texture_maxNgauss, & !< max number of Gauss components in any texture
texture_maxNfiber !< max number of Fiber 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 vacancyConcRate, & !< vacancy conc change field
hydrogenConcRate !< hydrogen conc change field hydrogenConcRate !< hydrogen conc change field
type(tPartitionedStringList), public,protected, allocatable, dimension(:) :: &
phaseConfig, &
microstructureConfig, &
homogenizationConfig, &
textureConfig, &
crystalliteConfig
public :: & public :: &
material_init, & material_init, &
ELASTICITY_hooke_ID ,& ELASTICITY_hooke_ID ,&
@ -379,13 +346,7 @@ subroutine material_init()
#endif #endif
use IO, only: & use IO, only: &
IO_error, & IO_error, &
IO_open_file, & IO_timeStamp
IO_read, &
IO_lc, &
IO_open_jobFile_stat, &
IO_getTag, &
IO_timeStamp, &
IO_EOF
use debug, only: & use debug, only: &
debug_level, & debug_level, &
debug_material, & debug_material, &
@ -410,52 +371,27 @@ subroutine material_init()
integer(pInt), dimension(:), allocatable :: CrystallitePosition integer(pInt), dimension(:), allocatable :: CrystallitePosition
integer(pInt), dimension(:), allocatable :: HomogenizationPosition integer(pInt), dimension(:), allocatable :: HomogenizationPosition
character(len=65536) :: &
line,part
myDebug = debug_level(debug_material) myDebug = debug_level(debug_material)
write(6,'(/,a)') ' <<<+- material init -+>>>' write(6,'(/,a)') ' <<<+- material init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... call material_parsePhase()
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) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
case (trim(material_partMicrostructure)) call material_parseMicrostructure()
line = material_parseMicrostructure(FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
case (trim(material_partCrystallite)) call material_parseCrystallite()
line = material_parseCrystallite(FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
case (trim(material_partHomogenization)) call material_parseHomogenization()
line = material_parseHomogenization(FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
case (trim(material_partTexture)) call material_parseTexture()
line = material_parseTexture(FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
case default
line = IO_read(fileUnit)
end select
enddo
allocate(plasticState (material_Nphase)) allocate(plasticState (material_Nphase))
allocate(sourceState (material_Nphase)) allocate(sourceState (material_Nphase))
do myPhase = 1,material_Nphase do myPhase = 1,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: & use IO, only: &
IO_read, & IO_error
IO_globalTagInPart, &
IO_countSections, &
IO_error, &
IO_countTagInPart, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringValue, &
IO_intValue, &
IO_floatValue, &
IO_stringPos, &
IO_EOF
use mesh, only: & use mesh, only: &
mesh_element mesh_element
implicit none implicit none
integer(pInt), intent(in) :: fileUnit integer(pInt) :: h
character(len=65536) :: tag
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)
allocate(homogenization_type(material_Nhomogenization), source=HOMOGENIZATION_undefined_ID) allocate(homogenization_type(material_Nhomogenization), source=HOMOGENIZATION_undefined_ID)
allocate(thermal_type(material_Nhomogenization), source=THERMAL_isothermal_ID) allocate(thermal_type(material_Nhomogenization), source=THERMAL_isothermal_ID)
@ -656,11 +543,10 @@ character(len=65536) function material_parseHomogenization(fileUnit)
forall (h = 1_pInt:material_Nhomogenization) homogenization_active(h) = any(mesh_element(3,:) == h) forall (h = 1_pInt:material_Nhomogenization) homogenization_active(h) = any(mesh_element(3,:) == h)
do h=1_pInt, material_Nhomogenization do h=1_pInt, material_Nhomogenization
homogenization_Noutput(h) = homogenizationConfig(h)%countKeys('(output)') homogenization_Noutput(h) = homogenizationConfig(h)%countKeys('(output)')
tag = homogenizationConfig(h)%getString('mech')
tag = homogenizationConfig(h)%getString('mech')
select case (trim(tag)) select case (trim(tag))
case(HOMOGENIZATION_NONE_label) case(HOMOGENIZATION_NONE_label)
homogenization_type(h) = HOMOGENIZATION_NONE_ID homogenization_type(h) = HOMOGENIZATION_NONE_ID
@ -674,13 +560,13 @@ character(len=65536) function material_parseHomogenization(fileUnit)
case default case default
call IO_error(500_pInt,ext_msg=trim(tag)) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
homogenization_typeInstance(h) = &
count(homogenization_type==homogenization_type(h)) ! count instances
if (homogenizationConfig(h)%keyExists('thermal')) then
tag = homogenizationConfig(h)%getString('thermal')
! case ('t0') homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h))
! thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt)
if (homogenizationConfig(h)%keyExists('thermal')) then
thermal_initialT(h) = homogenizationConfig(h)%getFloat('t0',defaultVal=300.0_pReal)
tag = homogenizationConfig(h)%getString('thermal')
select case (trim(tag)) select case (trim(tag))
case(THERMAL_isothermal_label) case(THERMAL_isothermal_label)
thermal_type(h) = THERMAL_isothermal_ID thermal_type(h) = THERMAL_isothermal_ID
@ -691,12 +577,13 @@ character(len=65536) function material_parseHomogenization(fileUnit)
case default case default
call IO_error(500_pInt,ext_msg=trim(tag)) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
endif endif
if (homogenizationConfig(h)%keyExists('damage')) then if (homogenizationConfig(h)%keyExists('damage')) then
damage_initialPhi(h) = homogenizationConfig(h)%getFloat('initialdamage',defaultVal=1.0_pReal)
tag = homogenizationConfig(h)%getString('damage') tag = homogenizationConfig(h)%getString('damage')
! case ('initialdamage')
! damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt)
select case (trim(tag)) select case (trim(tag))
case(DAMAGE_NONE_label) case(DAMAGE_NONE_label)
damage_type(h) = DAMAGE_none_ID damage_type(h) = DAMAGE_none_ID
@ -707,11 +594,13 @@ endif
case default case default
call IO_error(500_pInt,ext_msg=trim(tag)) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
endif endif
if (homogenizationConfig(h)%keyExists('vacancyflux')) then if (homogenizationConfig(h)%keyExists('vacancyflux')) then
vacancyflux_initialCv(h) = homogenizationConfig(h)%getFloat('cv0',defaultVal=0.0_pReal)
tag = homogenizationConfig(h)%getString('vacancyflux') tag = homogenizationConfig(h)%getString('vacancyflux')
! case ('cv0')
! vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt)
select case (trim(tag)) select case (trim(tag))
case(VACANCYFLUX_isoconc_label) case(VACANCYFLUX_isoconc_label)
vacancyflux_type(h) = VACANCYFLUX_isoconc_ID vacancyflux_type(h) = VACANCYFLUX_isoconc_ID
@ -722,8 +611,12 @@ endif
case default case default
call IO_error(500_pInt,ext_msg=trim(tag)) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
endif endif
if (homogenizationConfig(h)%keyExists('porosity')) then if (homogenizationConfig(h)%keyExists('porosity')) then
!ToDo?
tag = homogenizationConfig(h)%getString('porosity') tag = homogenizationConfig(h)%getString('porosity')
select case (trim(tag)) select case (trim(tag))
case(POROSITY_NONE_label) case(POROSITY_NONE_label)
@ -733,11 +626,13 @@ endif
case default case default
call IO_error(500_pInt,ext_msg=trim(tag)) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
endif endif
if (homogenizationConfig(h)%keyExists('hydrogenflux')) then if (homogenizationConfig(h)%keyExists('hydrogenflux')) then
hydrogenflux_initialCh(h) = homogenizationConfig(h)%getFloat('ch0',defaultVal=0.0_pReal)
tag = homogenizationConfig(h)%getString('hydrogenflux') tag = homogenizationConfig(h)%getString('hydrogenflux')
! case ('ch0')
! hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt)
select case (trim(tag)) select case (trim(tag))
case(HYDROGENFLUX_isoconc_label) case(HYDROGENFLUX_isoconc_label)
hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID
@ -746,7 +641,9 @@ endif
case default case default
call IO_error(500_pInt,ext_msg=trim(tag)) call IO_error(500_pInt,ext_msg=trim(tag))
end select end select
endif endif
enddo enddo
do h=1_pInt, material_Nhomogenization do h=1_pInt, material_Nhomogenization
@ -759,69 +656,33 @@ endif
enddo enddo
homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active) 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 !> @brief parses the microstructure part in the material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
character(len=65536) function material_parseMicrostructure(fileUnit) subroutine material_parseMicrostructure
use prec, only: & use prec, only: &
dNeq dNeq
use IO use IO, only: &
IO_floatValue, &
IO_intValue, &
IO_stringValue, &
IO_stringPos, &
IO_error
use mesh, only: & use mesh, only: &
mesh_element, & mesh_element, &
mesh_NcpElems mesh_NcpElems
implicit none implicit none
integer(pInt), intent(in) :: fileUnit character(len=65536), dimension(:), allocatable :: &
character(len=256), dimension(:), allocatable :: &
str str
character(len=64) :: tag2
integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt), allocatable, dimension(:,:) :: chunkPoss integer(pInt) :: e, m, c, i
integer(pInt) :: e, m, constituent, i
character(len=65536) :: & character(len=65536) :: &
tag,line,devNull tag
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)
allocate(microstructure_crystallite(material_Nmicrostructure), source=0_pInt) allocate(microstructure_crystallite(material_Nmicrostructure), source=0_pInt)
allocate(microstructure_Nconstituents(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) allocate(microstructure_fraction(microstructure_maxNconstituents,material_Nmicrostructure),source=0.0_pReal)
do m=1_pInt, material_Nmicrostructure do m=1_pInt, material_Nmicrostructure
call microstructureConfig(m)%getRaws('(constituent)',str,chunkPoss) str = microstructureConfig(m)%getStrings('(constituent)',raw=.true.)
do constituent = 1_pInt, size(str) do c = 1_pInt, size(str)
do i = 2_pInt,6_pInt,2_pInt chunkPos = IO_stringPos(str(c))
tag = IO_lc(IO_stringValue(str(constituent),chunkPoss(:,constituent),i))
do i = 1_pInt,5_pInt,2_pInt
tag = IO_stringValue(str(c),chunkPos,i)
select case (tag) select case (tag)
case('phase') case('phase')
microstructure_phase(constituent,m) = IO_intValue(str(constituent),chunkPoss(:,constituent),i+1_pInt) microstructure_phase(c,m) = IO_intValue(str(c),chunkPos,i+1_pInt)
case('texture') case('texture')
microstructure_texture(constituent,m) = IO_intValue(str(constituent),chunkPoss(:,constituent),i+1_pInt) microstructure_texture(c,m) = IO_intValue(str(c),chunkPos,i+1_pInt)
case('fraction') case('fraction')
microstructure_fraction(constituent,m) = IO_floatValue(str(constituent),chunkPoss(:,constituent),i+1_pInt) microstructure_fraction(c,m) = IO_floatValue(str(c),chunkPos,i+1_pInt)
end select end select
enddo enddo
enddo enddo
enddo enddo
!sanity check
do m = 1_pInt, material_Nmicrostructure do m = 1_pInt, material_Nmicrostructure
if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) & if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) &
call IO_error(153_pInt,ext_msg=microstructure_name(m)) call IO_error(153_pInt,ext_msg=microstructure_name(m))
enddo enddo
material_parseMicrostructure = line end subroutine material_parseMicrostructure
end function material_parseMicrostructure
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief parses the crystallite part in the material configuration file !> @brief parses the crystallite part in the material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
character(len=65536) function material_parseCrystallite(fileUnit) subroutine material_parseCrystallite
use IO, only: &
IO_read, &
IO_error, &
IO_getTag, &
IO_lc, &
IO_stringPos, &
IO_stringValue, &
IO_isBlank, &
IO_EOF
implicit none implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=64) :: tag2
integer(pInt) :: c 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 do c=1_pInt, material_Ncrystallite
crystallite_Noutput(c) = crystalliteConfig(c)%countKeys('(output)') crystallite_Noutput(c) = crystalliteConfig(c)%countKeys('(output)')
enddo enddo
material_parseCrystallite = line end subroutine material_parseCrystallite
end function material_parseCrystallite
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief parses the phase part in the material configuration file !> @brief parses the phase part in the material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
character(len=65536) function material_parsePhase(fileUnit) subroutine material_parsePhase
use chained_list, only: &
emptyList
use IO, only: & use IO, only: &
IO_read, &
IO_globalTagInPart, &
IO_countSections, &
IO_error, & IO_error, &
IO_countTagInPart, &
IO_getTag, & IO_getTag, &
IO_spotTagInPart, & IO_stringValue
IO_lc, &
IO_isBlank, &
IO_stringValue, &
IO_stringPos, &
IO_EOF
implicit none implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p
character(len=65536) :: & character(len=256), dimension(:), allocatable :: str
tag,line,devNull
character(len=64) :: tag2
character(len=64), dimension(:), allocatable :: &
str
logical :: echo
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_elasticity(material_Nphase),source=ELASTICITY_undefined_ID)
allocate(phase_plasticity(material_Nphase),source=PLASTICITY_undefined_ID) allocate(phase_plasticity(material_Nphase),source=PLASTICITY_undefined_ID)
@ -1117,80 +875,30 @@ character(len=65536) function material_parsePhase(fileUnit)
phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p))
enddo enddo
material_parsePhase = line end subroutine material_parsePhase
end function material_parsePhase
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief parses the texture part in the material configuration file !> @brief parses the texture part in the material configuration file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
character(len=65536) function material_parseTexture(fileUnit) subroutine material_parseTexture
use prec, only: & use prec, only: &
dNeq dNeq
use IO, only: & use IO, only: &
IO_read, &
IO_globalTagInPart, &
IO_countSections, &
IO_error, & IO_error, &
IO_countTagInPart, &
IO_getTag, &
IO_spotTagInPart, &
IO_lc, &
IO_isBlank, &
IO_floatValue, &
IO_stringValue, &
IO_stringPos, & IO_stringPos, &
IO_EOF IO_floatValue, &
IO_stringValue
use math, only: & use math, only: &
inRad, & inRad, &
math_sampleRandomOri, & math_sampleRandomOri, &
math_I3, & math_I3, &
math_det33, & math_det33
math_inv33
implicit none 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
integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: tag
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_ODFfile(material_Ntexture)); texture_ODFfile=''
allocate(texture_symmetry(material_Ntexture), source=1_pInt) allocate(texture_symmetry(material_Ntexture), source=1_pInt)
@ -1214,109 +922,111 @@ character(len=65536) function material_parseTexture(fileUnit)
section = t section = t
gauss = 0_pInt gauss = 0_pInt
fiber = 0_pInt fiber = 0_pInt
bla = textureConfig(t)%getStringsRaw()
lines: do i=1_pInt, size(bla) if (textureConfig(t)%keyExists('axes')) then
line = bla(i) lines = textureConfig(t)%getStrings('axes')
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
textureType: select case(tag)
case ('axes', 'rotation') textureType
do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries 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 (lines(j))
select case (tag)
case('x', '+x') case('x', '+x')
texture_transformation(j,1:3,section) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis
case('-x') case('-x')
texture_transformation(j,1:3,section) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis texture_transformation(j,1:3,t) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis
case('y', '+y') case('y', '+y')
texture_transformation(j,1:3,section) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis texture_transformation(j,1:3,t) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis
case('-y') case('-y')
texture_transformation(j,1:3,section) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis texture_transformation(j,1:3,t) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis
case('z', '+z') case('z', '+z')
texture_transformation(j,1:3,section) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis
case('-z') case('-z')
texture_transformation(j,1:3,section) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis
case default case default
call IO_error(157_pInt,section) call IO_error(157_pInt,t)
end select end select
enddo enddo
if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157_pInt,t)
endif
if(dNeq(math_det33(texture_transformation(1:3,1:3,section)),1.0_pReal)) & tag=''
call IO_error(157_pInt,section) texture_ODFfile(t) = textureConfig(t)%getString('hybridia',defaultVal=tag)
case ('hybridia') textureType if (textureConfig(t)%keyExists('symmetry')) then
texture_ODFfile(section) = IO_stringValue(line,chunkPos,2_pInt) select case (textureConfig(t)%getString('symmetry'))
case ('symmetry') textureType
tag = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
select case (tag)
case('orthotropic') case('orthotropic')
texture_symmetry(section) = 4_pInt texture_symmetry(t) = 4_pInt
case('monoclinic') case('monoclinic')
texture_symmetry(section) = 2_pInt texture_symmetry(t) = 2_pInt
case default case default
texture_symmetry(section) = 1_pInt texture_symmetry(t) = 1_pInt
end select end select
endif
case ('(random)') textureType if (textureConfig(t)%keyExists('(random)')) then
lines = textureConfig(t)%getStrings('(random)',raw=.true.)
do i = 1_pInt, size(lines)
gauss = gauss + 1_pInt gauss = gauss + 1_pInt
texture_Gauss(1:3,gauss,section) = math_sampleRandomOri() texture_Gauss(1:3,gauss,t) = math_sampleRandomOri()
do j = 2_pInt,4_pInt,2_pInt chunkPos = IO_stringPos(lines(i))
tag = IO_lc(IO_stringValue(line,chunkPos,j)) do j = 1_pInt,3_pInt,2_pInt
select case (tag) select case (IO_stringValue(lines(i),chunkPos,j))
case('scatter') 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') 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 end select
enddo enddo
enddo
endif
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 case ('(gauss)') textureType
gauss = gauss + 1_pInt gauss = gauss + 1_pInt
do j = 2_pInt,10_pInt,2_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) select case (tag)
case('phi1') 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') 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') 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') 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') 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 end select
enddo enddo
case ('(fiber)') textureType case ('(fiber)') textureType
fiber = fiber + 1_pInt fiber = fiber + 1_pInt
do j = 2_pInt,12_pInt,2_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) select case (tag)
case('alpha1') 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') 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') 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') 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') 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') 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 end select
enddo enddo
end select textureType end select textureType
enddo lines enddo
enddo enddo
material_parseTexture = line end subroutine material_parseTexture
end function material_parseTexture
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1432,10 +1142,8 @@ subroutine material_populateGrains
allocate(orientationOfGrain(3,maxval(Ngrains)),source=0.0_pReal) ! reserve memory for maximum case allocate(orientationOfGrain(3,maxval(Ngrains)),source=0.0_pReal) ! reserve memory for maximum case
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out)
write(6,'(/,a/)') ' MATERIAL grain population' write(6,'(/,a/)') ' MATERIAL grain population'
write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#' write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#'
!$OMP END CRITICAL (write2out)
endif endif
homogenizationLoop: do homog = 1_pInt,material_Nhomogenization homogenizationLoop: do homog = 1_pInt,material_Nhomogenization
dGrains = homogenization_Ngrains(homog) ! grain number per material point dGrains = homogenization_Ngrains(homog) ! grain number per material point
@ -1443,11 +1151,8 @@ subroutine material_populateGrains
activePair: if (Ngrains(homog,micro) > 0_pInt) then activePair: if (Ngrains(homog,micro) > 0_pInt) then
myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate 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 myNconstituents = microstructure_Nconstituents(micro) ! assign short name for number of constituents
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) &
!$OMP CRITICAL (write2out)
write(6,'(/,a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains write(6,'(/,a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains
!$OMP END CRITICAL (write2out)
endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

View File

@ -223,7 +223,6 @@ end subroutine math_init
!> @brief check correctness of (some) math functions !> @brief check correctness of (some) math functions
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine math_check subroutine math_check
use prec, only: tol_math_check use prec, only: tol_math_check
use IO, only: IO_error use IO, only: IO_error
@ -1823,6 +1822,8 @@ function math_sampleFiberOri(alpha,beta,FWHM)
integer(pInt):: j,& !< index of smallest component integer(pInt):: j,& !< index of smallest component
i i
allocate(a(0))
allocate(idx(0))
fInC = [sin(alpha(1))*cos(alpha(2)), sin(alpha(1))*sin(alpha(2)), cos(alpha(1))] 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))] 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 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 end module math

View File

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

View File

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

View File

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

View File

@ -145,7 +145,8 @@ subroutine plastic_kinehardening_init(fileUnit)
phase_plasticityInstance, & phase_plasticityInstance, &
phase_Noutput, & phase_Noutput, &
material_phase, & material_phase, &
plasticState, & plasticState
use config, only: &
MATERIAL_partPhase MATERIAL_partPhase
use lattice use lattice
use numerics,only: & use numerics,only: &
@ -155,9 +156,10 @@ subroutine plastic_kinehardening_init(fileUnit)
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt), allocatable, dimension(:) :: chunkPos
integer(kind(undefined_ID)) :: &
output_ID
integer(pInt) :: & integer(pInt) :: &
o, j, k, f, & o, j, k, f, &
output_ID, &
phase, & phase, &
instance, & instance, &
maxNinstance, & maxNinstance, &
@ -177,8 +179,6 @@ subroutine plastic_kinehardening_init(fileUnit)
tag = '', & tag = '', &
line = '', & line = '', &
extmsg = '' extmsg = ''
character(len=64) :: &
outputtag = ''
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_KINEHARDENING_label//' init -+>>>' write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_KINEHARDENING_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() 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_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_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase))
Nchunks_nonSchmid = lattice_NnonSchmid(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)%crss0 (Nchunks_SlipFamilies), source=0.0_pReal)
allocate(param(instance)%tau1 (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) 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 cycle ! skip to next line
endif 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 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) chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag) select case(tag)
case ('(output)') case ('(output)')
outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
output_ID = undefined_ID output_ID = undefined_ID
select case(outputtag) select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('resistance') case ('resistance')
output_ID = crss_ID output_ID = crss_ID
case ('backstress') case ('backstress')
output_ID = crss_back_ID output_ID = crss_back_ID
case ('sense') case ('sense')
output_ID = sense_ID output_ID = sense_ID
case ('chi0') case ('chi0')
output_ID = chi0_ID output_ID = chi0_ID
case ('gamma0') case ('gamma0')
output_ID = gamma0_ID output_ID = gamma0_ID
case ('accumulatedshear') case ('accumulatedshear')
output_ID = accshear_ID output_ID = accshear_ID
case ('totalshear') case ('totalshear')
output_ID = sumGamma_ID output_ID = sumGamma_ID
case ('shearrate') case ('shearrate')
output_ID = shearrate_ID output_ID = shearrate_ID
case ('resolvedstress') case ('resolvedstress')
output_ID = resolvedstress_ID output_ID = resolvedstress_ID
end select end select
if (output_ID /= undefined_ID) then if (output_ID /= undefined_ID) then
plastic_kinehardening_Noutput(instance) = plastic_kinehardening_Noutput(instance) + 1_pInt plastic_kinehardening_Noutput(instance) = plastic_kinehardening_Noutput(instance) + 1_pInt
plastic_kinehardening_output(plastic_kinehardening_Noutput(instance),instance) = outputtag plastic_kinehardening_output(plastic_kinehardening_Noutput(instance),instance) = &
param(instance)%outputID (plastic_kinehardening_Noutput(instance)) = output_ID IO_lc(IO_stringValue(line,chunkPos,2_pInt))
param(instance)%outputID = [param(instance)%outputID, output_ID]
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! parameters depending on number of slip families ! parameters depending on number of slip families
case ('nslip') case ('nslip')
@ -619,7 +627,6 @@ subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dTstar99, &
math_transpose33 math_transpose33
use lattice, only: & use lattice, only: &
lattice_Sslip, & !< schmid matrix lattice_Sslip, & !< schmid matrix
lattice_Sslip_v, &
lattice_maxNslipFamily, & lattice_maxNslipFamily, &
lattice_NslipSystem, & lattice_NslipSystem, &
lattice_NnonSchmid lattice_NnonSchmid
@ -739,8 +746,6 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el)
ipc, & !< component-ID of integration point ipc, & !< component-ID of integration point
ip, & !< integration point ip, & !< integration point
el !< element 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)))) :: & real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(phaseAt(ipc,ip,el)))) :: &
gdot_pos,gdot_neg, & gdot_pos,gdot_neg, &
tau_pos,tau_neg, & tau_pos,tau_neg, &
@ -799,14 +804,10 @@ end subroutine plastic_kinehardening_deltaState
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el) subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el)
use lattice, only: & use lattice, only: &
lattice_Sslip_v, & lattice_maxNslipFamily
lattice_maxNslipFamily, &
lattice_NslipSystem, &
lattice_NnonSchmid
use material, only: & use material, only: &
material_phase, & material_phase, &
phaseAt, phasememberAt, & phaseAt, phasememberAt, &
plasticState, &
phase_plasticityInstance phase_plasticityInstance
implicit none implicit none
@ -819,10 +820,8 @@ subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el)
integer(pInt) :: & integer(pInt) :: &
instance,ph, & instance,ph, &
f,i,j,k, & f,i,j, &
index_myFamily,index_otherFamily, &
nSlip, & nSlip, &
offset_accshear, &
of of
real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & 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) function plastic_kinehardening_postResults(Tstar_v,ipc,ip,el)
use material, only: & use material, only: &
material_phase, & material_phase, &
plasticState, &
phaseAt, phasememberAt, & phaseAt, phasememberAt, &
phase_plasticityInstance phase_plasticityInstance
use lattice, only: & use lattice, only: &
lattice_Sslip_v, & lattice_Sslip_v, &
lattice_maxNslipFamily, & lattice_maxNslipFamily, &
lattice_NslipSystem, & lattice_NslipSystem
lattice_NnonSchmid
implicit none implicit none
real(pReal), dimension(6), intent(in) :: & real(pReal), dimension(6), intent(in) :: &
@ -896,7 +893,7 @@ function plastic_kinehardening_postResults(Tstar_v,ipc,ip,el)
integer(pInt) :: & integer(pInt) :: &
instance,ph, of, & instance,ph, of, &
nSlip,& nSlip,&
o,f,i,c,j,k, & o,f,i,c,j,&
index_myFamily index_myFamily
real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & 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_label, &
PLASTICITY_NONLOCAL_ID, & PLASTICITY_NONLOCAL_ID, &
plasticState, & plasticState, &
MATERIAL_partPhase ,&
material_phase material_phase
use config, only: MATERIAL_partPhase
use lattice use lattice
use numerics,only: & use numerics,only: &
numerics_integrator numerics_integrator

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -2,7 +2,7 @@
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH !> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, 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 module spectral_mech_basic
#include <petsc/finclude/petscsnes.h> #include <petsc/finclude/petscsnes.h>
@ -22,7 +22,7 @@ module spectral_mech_basic
private private
character (len=*), parameter, public :: & character (len=*), parameter, public :: &
DAMASK_spectral_SolverBasicPETSC_label = 'basic' DAMASK_spectral_SolverBasic_label = 'basic'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! derived types ! derived types
@ -65,9 +65,9 @@ module spectral_mech_basic
real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal
public :: & public :: &
basicPETSc_init, & basic_init, &
basicPETSc_solution, & basic_solution, &
BasicPETSc_forward basic_forward
external :: & external :: &
PETScErrorF ! is called in the CHKERRQ macro 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 !> @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 #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: & use, intrinsic :: iso_fortran_env, only: &
compiler_version, & compiler_version, &
@ -124,9 +124,9 @@ subroutine basicPETSc_init
external :: & external :: &
SNESSetOptionsPrefix, & SNESSetOptionsPrefix, &
SNESSetConvergenceTest, & 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)') ' 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,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -158,9 +158,9 @@ subroutine basicPETSc_init
call DMsetFromOptions(da,ierr); CHKERRQ(ierr) call DMsetFromOptions(da,ierr); CHKERRQ(ierr)
call DMsetUp(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 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) 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) CHKERRQ(ierr)
call SNESsetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional CLI arguments 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.) 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: & use IO, only: &
IO_error IO_error
use numerics, only: & use numerics, only: &
@ -275,19 +275,19 @@ type(tSolutionState) function basicPETSc_solution(incInfoIn,timeinc,timeinc_old,
! check convergence ! check convergence
call SNESGetConvergedReason(snes,reason,ierr); CHKERRQ(ierr) call SNESGetConvergedReason(snes,reason,ierr); CHKERRQ(ierr)
BasicPETSc_solution%converged = reason > 0 basic_solution%converged = reason > 0
basicPETSC_solution%iterationsNeeded = totalIter basic_solution%iterationsNeeded = totalIter
basicPETSc_solution%termIll = terminallyIll basic_solution%termIll = terminallyIll
terminallyIll = .false. terminallyIll = .false.
if (reason == -4) call IO_error(893_pInt) ! MPI error if (reason == -4) call IO_error(893_pInt) ! MPI error
end function BasicPETSc_solution end function basic_solution
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief forms the basic residual vector !> @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: & use numerics, only: &
itmax, & itmax, &
itmin itmin
@ -370,13 +370,13 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
! constructing residual ! 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 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 !> @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: & use numerics, only: &
itmax, & itmax, &
itmin, & itmin, &
@ -425,14 +425,14 @@ subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,du
write(6,'(/,a)') ' ===========================================================================' write(6,'(/,a)') ' ==========================================================================='
flush(6) flush(6)
end subroutine BasicPETSc_converged end subroutine Basic_converged
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief forwarding routine !> @brief forwarding routine
!> @details find new boundary conditions and best F estimate for end of current timestep !> @details find new boundary conditions and best F estimate for end of current timestep
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates !> 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: & use math, only: &
math_mul33x33 ,& math_mul33x33 ,&
math_rotate_backward33 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]) math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3])
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
end subroutine BasicPETSc_forward end subroutine Basic_forward
end module spectral_mech_basic end module spectral_mech_basic

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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