diff --git a/.gitignore b/.gitignore index 22c568409..2a118ef29 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,7 @@ *.pyc *.mod *.o +*.hdf5 *.exe *.bak *~ diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 99daef5e5..f1af6259f 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -158,12 +158,12 @@ Post_AverageDown: - master - release -#Post_General: -# stage: postprocessing -# script: PostProcessing/test.py -# except: -# - master -# - release +Post_General: + stage: postprocessing + script: PostProcessing/test.py + except: + - master + - release Post_GeometryReconstruction: stage: postprocessing @@ -343,6 +343,15 @@ Spectral_MPI: - master - release +SpectralAll_restartMPI: + stage: spectral + script: + - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel + - SpectralAll_restartMPI/test.py + except: + - master + - release + Plasticity_DetectChanges: stage: spectral script: Plasticity_DetectChanges/test.py @@ -364,12 +373,12 @@ Phenopowerlaw_singleSlip: - master - release -#TextureComponents: -# stage: spectral -# script: TextureComponents/test.py -# except: -# - master -# - release +TextureComponents: + stage: spectral + script: TextureComponents/test.py + except: + - master + - release ################################################################################################### @@ -468,27 +477,24 @@ AbaqusStd: script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT abaqus - except: - - master - - release + only: + - development Marc: stage: createDocumentation script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT marc - except: - - master - - release + only: + - development Spectral: stage: createDocumentation script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT spectral - except: - - master - - release + only: + - development ################################################################################################## backupData: diff --git a/LICENSE b/LICENSE index 630dc3a84..1ab20178c 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2011-18 Max-Planck-Institut für Eisenforschung GmbH +Copyright 2011-19 Max-Planck-Institut für Eisenforschung GmbH DAMASK is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/Makefile b/Makefile index a8a7a6e0f..cd2690cc7 100644 --- a/Makefile +++ b/Makefile @@ -7,11 +7,11 @@ all: spectral FEM processing .PHONY: spectral spectral: build/spectral - @(cd build/spectral;make --no-print-directory -ws all install;) + @(cd build/spectral;make -j4 --no-print-directory -ws all install;) .PHONY: FEM FEM: build/FEM - @(cd build/FEM; make --no-print-directory -ws all install;) + @(cd build/FEM; make -j4 --no-print-directory -ws all install;) .PHONY: build/spectral build/spectral: diff --git a/PRIVATE b/PRIVATE index b9a52a85c..5ed6a1f60 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit b9a52a85cd65cc27a8e863302bd984abdcad1455 +Subproject commit 5ed6a1f60b412eb46ff6820cf03b684095ff1f75 diff --git a/VERSION b/VERSION index 2ad825361..895c5d6b5 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1236-g1ef82e35 +v2.0.2-1395-g4848e600 diff --git a/env/DAMASK.csh b/env/DAMASK.csh index 6b6c58d9d..1819dd305 100644 --- a/env/DAMASK.csh +++ b/env/DAMASK.csh @@ -64,7 +64,7 @@ endif setenv DAMASK_NUM_THREADS $DAMASK_NUM_THREADS if ( ! $?PYTHONPATH ) then - setenv PYTHONPATH $DAMASK_ROOT/lib + setenv PYTHONPATH $DAMASK_ROOT/python else - setenv PYTHONPATH $DAMASK_ROOT/lib:$PYTHONPATH + setenv PYTHONPATH $DAMASK_ROOT/python:$PYTHONPATH endif diff --git a/env/DAMASK.sh b/env/DAMASK.sh index bd26a3ebb..fa2c8db25 100644 --- a/env/DAMASK.sh +++ b/env/DAMASK.sh @@ -95,7 +95,7 @@ if [ ! -z "$PS1" ]; then fi export DAMASK_NUM_THREADS -export PYTHONPATH=$DAMASK_ROOT/lib:$PYTHONPATH +export PYTHONPATH=$DAMASK_ROOT/python:$PYTHONPATH for var in BASE STAT SOLVER PROCESSING FREE DAMASK_BIN BRANCH; do unset "${var}" diff --git a/env/DAMASK.zsh b/env/DAMASK.zsh index 4d5a1e47d..61b9c89f9 100644 --- a/env/DAMASK.zsh +++ b/env/DAMASK.zsh @@ -88,7 +88,7 @@ if [ ! -z "$PS1" ]; then fi export DAMASK_NUM_THREADS -export PYTHONPATH=$DAMASK_ROOT/lib:$PYTHONPATH +export PYTHONPATH=$DAMASK_ROOT/python:$PYTHONPATH for var in BASE STAT SOLVER PROCESSING FREE DAMASK_BIN BRANCH; do unset "${var}" diff --git a/installation/mods_Abaqus/abaqus_v6.env b/installation/mods_Abaqus/abaqus_v6.env index d09257a9d..0b4a7fd43 100644 --- a/installation/mods_Abaqus/abaqus_v6.env +++ b/installation/mods_Abaqus/abaqus_v6.env @@ -12,9 +12,17 @@ # import os, re, glob, driverUtils from damask import version as DAMASKVERSION +from damask import Environment +myEnv = Environment() -# Use the version in $PATH -fortCmd = "ifort" +if myEnv.options['DAMASK_HDF5'] == 'ON': + # use hdf5 compiler wrapper in $PATH + fortCmd = os.popen('h5fc -shlib -show').read().replace('\n','') # complicated way needed to pass in DAMASKVERSION string + link_sl += fortCmd.split()[1:] + fortCmd +=" -DDAMASKHDF5" +else: + # Use the version in $PATH + fortCmd = "ifort" # -free to use free-format FORTRAN 90 syntax # -O <0-3> optimization level @@ -50,4 +58,6 @@ ask_delete=OFF # Remove the temporary names from the namespace del fortCmd +del Environment +del myEnv del DAMASKVERSION diff --git a/installation/mods_Abaqus/abaqus_v6_debug.env b/installation/mods_Abaqus/abaqus_v6_debug.env index de5189a52..c967c1e65 100644 --- a/installation/mods_Abaqus/abaqus_v6_debug.env +++ b/installation/mods_Abaqus/abaqus_v6_debug.env @@ -12,9 +12,17 @@ # import os, re, glob, driverUtils from damask import version as DAMASKVERSION +from damask import Environment +myEnv = Environment() -# Use the version in $PATH -fortCmd = "ifort" +if myEnv.options['DAMASK_HDF5'] == 'ON': + # use hdf5 compiler wrapper in $PATH + fortCmd = os.popen('h5fc -shlib -show').read().replace('\n','') # complicated way needed to pass in DAMASKVERSION string + link_sl += fortCmd.split()[1:] + fortCmd +=" -DDAMASKHDF5" +else: + # Use the version in $PATH + fortCmd = "ifort" # -free to use free-format FORTRAN 90 syntax # -O <0-3> optimization level @@ -55,4 +63,6 @@ ask_delete=OFF # Remove the temporary names from the namespace del fortCmd +del Environment +del myEnv del DAMASKVERSION diff --git a/installation/mods_MarcMentat/2018.1/Marc_tools/include_linux64 b/installation/mods_MarcMentat/2018.1/Marc_tools/include_linux64 index 22b306cb1..53eef9d83 100644 --- a/installation/mods_MarcMentat/2018.1/Marc_tools/include_linux64 +++ b/installation/mods_MarcMentat/2018.1/Marc_tools/include_linux64 @@ -63,7 +63,6 @@ else INTEGER_PATH=/$MARC_INTEGER_SIZE fi -FCOMP=ifort INTELPATH="/opt/intel/compilers_and_libraries_2017/linux" # find the root directory of the compiler installation: @@ -99,6 +98,16 @@ else FCOMPROOT= fi +# DAMASK uses the HDF5 compiler wrapper around the Intel compiler +if test "$DAMASK_HDF5" = "ON";then + H5FC="$(h5fc -shlib -show)" + HDF5_LIB=${H5FC//ifort/} + FCOMP="$H5FC -DDAMASKHDF5" + echo $FCOMP +else + FCOMP=ifort +fi + # AEM if test "$MARCDLLOUTDIR" = ""; then DLLOUTDIR="$MARC_LIB" @@ -535,23 +544,17 @@ else DAMASKVERSION="'N/A'" fi -if test "$DAMASK_HDF5" = "ON";then - DFCOMP="$(h5fc -show) -DDAMASKHDF5" -else - DFCOMP=$FCOMP -fi -# # DAMASK compiler calls: additional flags are in line 2 OpenMP flags in line 3 -DFORTLOWMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \ +DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \ -qopenmp -qopenmp-threadprivate=compat\ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD" -DFORTRANMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \ +DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \ -qopenmp -qopenmp-threadprivate=compat\ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD" -DFORTHIGHMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \ +DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \ -qopenmp -qopenmp-threadprivate=compat\ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD" @@ -570,15 +573,15 @@ then fi # DAMASK compiler calls: additional flags are in line 2 OpenMP flags in line 3 - DFORTLOWMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \ + DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \ -qopenmp -qopenmp-threadprivate=compat\ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD" - DFORTRANMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \ + DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \ -qopenmp -qopenmp-threadprivate=compat\ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD" - DFORTHIGHMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \ + DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2018.1 -DDAMASKVERSION=$DAMASKVERSION \ -qopenmp -qopenmp-threadprivate=compat\ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD" @@ -744,7 +747,7 @@ SECLIBS="-L$MARC_LIB -llapi" SOLVERLIBS="${BCSSOLVERLIBS} ${VKISOLVERLIBS} ${CASISOLVERLIBS} ${MF2SOLVERLIBS} \ $MKLLIB -L$MARC_MKL -liomp5 \ - $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/kdtree2.a " + $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/kdtree2.a $HDF5_LIB " SOLVERLIBS_DLL=${SOLVERLIBS} if test "$AEM_DLL" -eq 1 diff --git a/processing/post/addEuclideanDistance.py b/processing/post/addEuclideanDistance.py index 2e5794e1b..f759b7a8f 100755 --- a/processing/post/addEuclideanDistance.py +++ b/processing/post/addEuclideanDistance.py @@ -149,7 +149,6 @@ for name in filenames: errors = [] remarks = [] - column = {} if not 3 >= table.label_dimension(options.pos) >= 1: errors.append('coordinates "{}" need to have one, two, or three dimensions.'.format(options.pos)) diff --git a/processing/post/addMises.py b/processing/post/addMises.py index 55cf6552e..7e757ed9d 100755 --- a/processing/post/addMises.py +++ b/processing/post/addMises.py @@ -4,6 +4,7 @@ import os,sys,math import numpy as np from optparse import OptionParser +from collections import OrderedDict import damask scriptName = os.path.splitext(os.path.basename(__file__))[0] @@ -63,10 +64,10 @@ for name in filenames: # ------------------------------------------ sanity checks ---------------------------------------- - items = { - 'strain': {'dim': 9, 'shape': [3,3], 'labels':options.strain, 'active':[], 'column': []}, - 'stress': {'dim': 9, 'shape': [3,3], 'labels':options.stress, 'active':[], 'column': []}, - } + items = OrderedDict([ + ('strain', {'dim': 9, 'shape': [3,3], 'labels':options.strain, 'active':[], 'column': []}), + ('stress', {'dim': 9, 'shape': [3,3], 'labels':options.stress, 'active':[], 'column': []}) + ]) errors = [] remarks = [] diff --git a/processing/post/ascii2hdf5.py b/processing/post/ascii2hdf5.py deleted file mode 100755 index effac981b..000000000 --- a/processing/post/ascii2hdf5.py +++ /dev/null @@ -1,142 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -# ------------------------------------------------------------------- # -# NOTE: # -# 1. Not all output is defined in the DS_HDF5.xml, please add new # -# new one to the system wide definition file # -# /lib/damask/DS_HDF5.xml # -# or specify your own when initializing HDF5 class # -# 2. Somehow the point cloud structure cannot be properly handled # -# by Xdmf, which is a descriptive wrapper for visualizing HDF5 # -# using Paraview. The current solution is using cell structured # -# HDF5 so that Xdmf can describe the data shape as a rectangular # -# mesh rather than polyvertex. # -# TODO: # -# 1. remove the ._tmp file, basically need a way to # -# just load data from ASCII table. # -# 2. a progress monitor when transferring data from ASCII table # -# to HDF5. # -# 3. a more flexible way handle the data structure rather than a # -# xml file. # -# ------------------------------------------------------------------- # - -import os -import damask -import numpy as np -from optparse import OptionParser - - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -# ----- helper function ----- # -def get_rectMshVectors(xyz_array, posNum): - """Get Vx, Vy, Vz for rectLinear grid""" - # need some improvement, and only works for rectangular grid - v = sorted(list(set(xyz_array[:, posNum]))) - v_interval = (v[2]+v[1])/2.0 - (v[1]+v[0])/2.0 - v_start = (v[1]+v[0])/2.0 - v_interval - v_end = (v[-1]+v[-2])/2.0 + v_interval - V = np.linspace(v_start, v_end, len(v)+1) - return V - - -# ----- MAIN ---- # -desp_msg = "Convert DAMASK ascii table to HDF5 file" -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=desp_msg, - version=scriptID) -parser.add_option('-D', '--DefinitionFile', - dest='storage definition file', - type='string', - metavar='string', - help='definition file for H5 data storage') -parser.add_option('-p', '--pos', '--position', - dest='pos', - type='string', metavar='string', - help='label of coordinates [%default]') - -parser.set_defaults(DefinitionFile='default', - pos='pos') - -(options, filenames) = parser.parse_args() - -filename = filenames[0] - -if options.DefinitionFile == 'default': - defFile = None -else: - defFile = options.DefinitionFile - -# ----- read in data using DAMASK ASCII table class ----- # -asciiTable = damask.ASCIItable(name=filename, buffered=False) -asciiTable.head_read() -asciiTable.data_readArray() -incNum = int(asciiTable.data[asciiTable.label_index('inc'), 0]) -fullTable = np.copy(asciiTable.data) # deep copy all data, just to be safe -labels = asciiTable.labels() -labels_idx = [asciiTable.label_index(label) for label in labels] -featuresDim = [labels_idx[i+1] - labels_idx[i] for i in range(len(labels)-1)] -featuresDim.append(fullTable.shape[1] - labels_idx[-1]) - -# ----- figure out size and grid ----- # -pos_idx = asciiTable.label_index('pos') -xyz_array = asciiTable.data[:, pos_idx:pos_idx+3] -Vx = get_rectMshVectors(xyz_array, 0) -Vy = get_rectMshVectors(xyz_array, 1) -Vz = get_rectMshVectors(xyz_array, 2) -# use the dimension of the rectangular grid to reshape all other data -mshGridDim = [len(Vx)-1, len(Vy)-1, len(Vz)-1] - -# ----- compose cmd log ----- # -cmd_log = " ".join([scriptID, filename]) - -# ----- create a new HDF5 file and save the data -----# -# force remove existing HDF5 file -h5fName = filename.replace(".txt", ".h5") -try: - os.remove(h5fName) -except OSError: - pass -h5f = damask.H5Table(h5fName, - new_file=True, - dsXMLFile=defFile) -# adding increment number as root level attributes -h5f.add_attr('inc', incNum) -# add the mesh grid data now -h5f.add_data("Vx", Vx, cmd_log=cmd_log) -h5f.add_data("Vy", Vy, cmd_log=cmd_log) -h5f.add_data("Vz", Vz, cmd_log=cmd_log) - -# add the rest of data from table -labelsProcessed = ['inc'] -for fi in range(len(labels)): - featureName = labels[fi] - # remove trouble maker "("" and ")" from label/feature name - if "(" in featureName: - featureName = featureName.replace("(", "") - if ")" in featureName: - featureName = featureName.replace(")", "") - # skip increment and duplicated columns in the ASCII table - if featureName in labelsProcessed: - continue - - featureIdx = labels_idx[fi] - featureDim = featuresDim[fi] - # grab the data hook - dataset = fullTable[:, featureIdx:featureIdx+featureDim] - # mapping 2D data onto a 3D rectangular mesh to get 4D data - # WARNING: In paraview, the data for a recmesh is mapped as: - # --> len(z), len(y), len(x), size(data) - # dataset = dataset.reshape((mshGridDim[0], - # mshGridDim[1], - # mshGridDim[2], - # dataset.shape[1])) - # write out data - print("adding {}...".format(featureName)) - h5f.add_data(featureName, dataset, cmd_log=cmd_log) - # write down the processed label - labelsProcessed.append(featureName) diff --git a/processing/post/groupTable.py b/processing/post/groupTable.py index 67d07a7d1..f78566304 100755 --- a/processing/post/groupTable.py +++ b/processing/post/groupTable.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys @@ -21,18 +21,19 @@ scriptID = ' '.join([scriptName,damask.version]) # -------------------------------------------------------------------- parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ -Apply a user-specified function to condense all rows for which column 'label' has identical values into a single row. -Output table will contain as many rows as there are different (unique) values in the grouping column. +Apply a user-specified function to condense into a single row all those rows for which columns 'label' have identical values. +Output table will contain as many rows as there are different (unique) values in the grouping column(s). Periodic domain averaging of coordinate values is supported. Examples: For grain averaged values, replace all rows of particular 'texture' with a single row containing their average. -""", version = scriptID) +{name} --label texture --function np.average data.txt +""".format(name = scriptName), version = scriptID) parser.add_option('-l','--label', dest = 'label', - type = 'string', metavar = 'string', - help = 'column label for grouping rows') + action = 'extend', metavar = '', + help = 'column label(s) for grouping rows') parser.add_option('-f','--function', dest = 'function', type = 'string', metavar = 'string', @@ -40,7 +41,7 @@ parser.add_option('-f','--function', parser.add_option('-a','--all', dest = 'all', action = 'store_true', - help = 'apply mapping function also to grouping column') + help = 'apply mapping function also to grouping column(s)') group = OptionGroup(parser, "periodic averaging", "") @@ -57,6 +58,7 @@ parser.add_option_group(group) parser.set_defaults(function = 'np.average', all = False, + label = [], boundary = [0.0, 1.0]) (options,filenames) = parser.parse_args() @@ -71,7 +73,7 @@ try: except: mapFunction = None -if options.label is None: +if options.label is []: parser.error('no grouping column specified.') if not hasattr(mapFunction,'__call__'): parser.error('function "{}" is not callable.'.format(options.function)) @@ -89,13 +91,20 @@ for name in filenames: # ------------------------------------------ sanity checks --------------------------------------- + remarks = [] + errors = [] + table.head_read() - if table.label_dimension(options.label) != 1: - damask.util.croak('column {} is not of scalar dimension.'.format(options.label)) - table.close(dismiss = True) # close ASCIItable and remove empty file + grpColumns = table.label_index(options.label)[::-1] + grpColumns = grpColumns[np.where(grpColumns>=0)] + + if len(grpColumns) == 0: errors.append('no valid grouping column present.') + + if remarks != []: damask.util.croak(remarks) + if errors != []: + damask.util.croak(errors) + table.close(dismiss=True) continue - else: - grpColumn = table.label_index(options.label) # ------------------------------------------ assemble info --------------------------------------- @@ -108,10 +117,9 @@ for name in filenames: indexrange = table.label_indexrange(options.periodic) if options.periodic is not None else [] rows,cols = table.data.shape - table.data = table.data[np.lexsort([table.data[:,grpColumn]])] # sort data by grpColumn - - values,index = np.unique(table.data[:,grpColumn], return_index = True) # unique grpColumn values and their positions - index = np.append(index,rows) # add termination position + table.data = table.data[np.lexsort(table.data[:,grpColumns].T)] # sort data by grpColumn(s) + values,index = np.unique(table.data[:,grpColumns], axis=0, return_index=True) # unique grpColumn values and their positions + index = sorted(np.append(index,rows)) # add termination position grpTable = np.empty((len(values), cols)) # initialize output for i in range(len(values)): # iterate over groups (unique values in grpColumn) @@ -119,7 +127,7 @@ for name in filenames: grpTable[i,indexrange] = \ periodicAverage(table.data[index[i]:index[i+1],indexrange],options.boundary) # apply periodicAverage mapping function - if not options.all: grpTable[i,grpColumn] = table.data[index[i],grpColumn] # restore grouping column value + if not options.all: grpTable[i,grpColumns] = table.data[index[i],grpColumns] # restore grouping column value table.data = grpTable diff --git a/processing/post/postResults.py b/processing/post/postResults.py index a5a2669d7..c0885a967 100755 --- a/processing/post/postResults.py +++ b/processing/post/postResults.py @@ -831,7 +831,7 @@ if options.info: elementsOfNode = {} Nelems = stat['NumberOfElements'] for e in range(Nelems): - if options.verbose and Nelems > 100 and e%(Nelems//100) == 0: # report in 1% steps if possible and avoid modulo by zero + if options.verbose and Nelems >= 50 and e%(Nelems//50) == 0: # report in 2% steps if possible and avoid modulo by zero damask.util.progressBar(iteration=e,total=Nelems,prefix='1/3: connecting elements') for n in map(p.node_sequence,p.element(e).items): if n not in elementsOfNode: @@ -856,7 +856,7 @@ damask.util.progressBar(iteration=1,total=1,prefix='1/3: connecting elements') if options.nodalScalar: Npoints = stat['NumberOfNodes'] for n in range(Npoints): - if options.verbose and Npoints > 100 and e%(Npoints//100) == 0: # report in 1% steps if possible and avoid modulo by zero + if options.verbose and Npoints >= 50 and e%(Npoints//50) == 0: # report in 2% steps if possible and avoid modulo by zero damask.util.progressBar(iteration=n,total=Npoints,prefix='2/3: scanning nodes ') myNodeID = p.node_id(n) myNodeCoordinates = [p.node(n).x, p.node(n).y, p.node(n).z] @@ -893,7 +893,7 @@ if options.nodalScalar: else: Nelems = stat['NumberOfElements'] for e in range(Nelems): - if options.verbose and Nelems > 100 and e%(Nelems//100) == 0: # report in 1% steps if possible and avoid modulo by zero + if options.verbose and Nelems >= 50 and e%(Nelems//50) == 0: # report in 2% steps if possible and avoid modulo by zero damask.util.progressBar(iteration=e,total=Nelems,prefix='2/3: scanning elements ') myElemID = p.element_id(e) myIpCoordinates = ipCoords(p.element(e).type, list(map(lambda node: [node.x, node.y, node.z], @@ -1034,7 +1034,7 @@ for incCount,position in enumerate(locations): # walk through locations Ngroups = len(groups) for j,group in enumerate(groups): f = incCount*Ngroups + j - if options.verbose and (Ngroups*Nincs) > 100 and f%((Ngroups*Nincs)//100) == 0: # report in 1% steps if possible and avoid modulo by zero + if options.verbose and (Ngroups*Nincs) >= 50 and f%((Ngroups*Nincs)//50) == 0: # report in 2% steps if possible and avoid modulo by zero damask.util.progressBar(iteration=f,total=Ngroups*Nincs,prefix='3/3: processing points ') N = 0 # group member counter for (e,n,i,g,n_local) in group[1:]: # loop over group members @@ -1087,7 +1087,7 @@ for incCount,position in enumerate(locations): # walk through locations ['Crystallite']*len(options.crystalliteResult) + ['Constitutive']*len(options.constitutiveResult) ): - outputIndex = (list(zip(*outputFormat[resultType]['outputs']))[0]).index(label) # find the position of this output in the outputFormat + outputIndex = (list(zip(*outputFormat[resultType]['outputs']))[0]).index(label) # find the position of this output in the outputFormat length = int(outputFormat[resultType]['outputs'][outputIndex][1]) thisHead = heading('_',[[component,''.join( label.split() )] for component in range(int(length>1),length+int(length>1))]) if assembleHeader: header += thisHead diff --git a/processing/post/viewTable.py b/processing/post/viewTable.py index c01bdcddb..309f229e1 100755 --- a/processing/post/viewTable.py +++ b/processing/post/viewTable.py @@ -61,7 +61,14 @@ for name in filenames: table = damask.ASCIItable(name = name, buffered = False, labeled = options.labeled, readonly = True) except: continue - damask.util.report(scriptName,name) + details = ', '.join( + (['header'] if options.table else []) + + (['info'] if options.head or options.info else []) + + (['labels'] if options.head or options.labels else []) + + (['data'] if options.data else []) + + [] + ) + damask.util.report(scriptName,name + ('' if details == '' else ' -- '+details)) # ------------------------------------------ output head --------------------------------------- diff --git a/processing/pre/mentat_pbcOnBoxMesh.py b/processing/pre/mentat_pbcOnBoxMesh.py index afd8d95f0..c171c6ccd 100755 --- a/processing/pre/mentat_pbcOnBoxMesh.py +++ b/processing/pre/mentat_pbcOnBoxMesh.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import sys,os,re,time,tempfile @@ -93,7 +93,7 @@ def add_servoLinks(mfd_data,active=[True,True,True]): # directions on which to for i in range(len(mfd_data)): mfd_dict[mfd_data[i]['label']] = i - NodeCoords = np.array(mfd_data[mfd_dict['nodes']]['els'][0::4])[:,1:4] + NodeCoords = np.array(mfd_data[mfd_dict['nodes']]['els'][1::4])[:,1:4] Nnodes = NodeCoords.shape[0] box['min'] = NodeCoords.min(axis=0) # find the bounding box diff --git a/processing/pre/mentat_spectralBox.py b/processing/pre/mentat_spectralBox.py index aa7039e0d..89f4a7a43 100755 --- a/processing/pre/mentat_spectralBox.py +++ b/processing/pre/mentat_spectralBox.py @@ -49,7 +49,7 @@ def output(cmds,locals,dest): #------------------------------------------------------------------------------------------------- def init(): return [ - "#"+' '.join([scriptID] + sys.argv[1:]), + "|"+' '.join([scriptID] + sys.argv[1:]), "*draw_manual", # prevent redrawing in Mentat, should be much faster "*new_model yes", "*reset", diff --git a/lib/damask/.gitignore b/python/damask/.gitignore similarity index 100% rename from lib/damask/.gitignore rename to python/damask/.gitignore diff --git a/lib/damask/__init__.py b/python/damask/__init__.py similarity index 100% rename from lib/damask/__init__.py rename to python/damask/__init__.py diff --git a/lib/damask/asciitable.py b/python/damask/asciitable.py similarity index 100% rename from lib/damask/asciitable.py rename to python/damask/asciitable.py diff --git a/lib/damask/colormaps.py b/python/damask/colormaps.py similarity index 100% rename from lib/damask/colormaps.py rename to python/damask/colormaps.py diff --git a/lib/damask/config/__init__.py b/python/damask/config/__init__.py similarity index 100% rename from lib/damask/config/__init__.py rename to python/damask/config/__init__.py diff --git a/lib/damask/config/material.py b/python/damask/config/material.py similarity index 100% rename from lib/damask/config/material.py rename to python/damask/config/material.py diff --git a/lib/damask/environment.py b/python/damask/environment.py similarity index 100% rename from lib/damask/environment.py rename to python/damask/environment.py diff --git a/lib/damask/geometry/__init__.py b/python/damask/geometry/__init__.py similarity index 100% rename from lib/damask/geometry/__init__.py rename to python/damask/geometry/__init__.py diff --git a/lib/damask/geometry/geometry.py b/python/damask/geometry/geometry.py similarity index 100% rename from lib/damask/geometry/geometry.py rename to python/damask/geometry/geometry.py diff --git a/lib/damask/geometry/marc.py b/python/damask/geometry/marc.py similarity index 100% rename from lib/damask/geometry/marc.py rename to python/damask/geometry/marc.py diff --git a/lib/damask/geometry/spectral.py b/python/damask/geometry/spectral.py similarity index 100% rename from lib/damask/geometry/spectral.py rename to python/damask/geometry/spectral.py diff --git a/lib/damask/orientation.py b/python/damask/orientation.py similarity index 100% rename from lib/damask/orientation.py rename to python/damask/orientation.py diff --git a/lib/damask/result.py b/python/damask/result.py similarity index 100% rename from lib/damask/result.py rename to python/damask/result.py diff --git a/lib/damask/result/marc2vtk.py b/python/damask/result/marc2vtk.py similarity index 100% rename from lib/damask/result/marc2vtk.py rename to python/damask/result/marc2vtk.py diff --git a/lib/damask/solver/__init__.py b/python/damask/solver/__init__.py similarity index 100% rename from lib/damask/solver/__init__.py rename to python/damask/solver/__init__.py diff --git a/lib/damask/solver/abaqus.py b/python/damask/solver/abaqus.py similarity index 100% rename from lib/damask/solver/abaqus.py rename to python/damask/solver/abaqus.py diff --git a/lib/damask/solver/marc.py b/python/damask/solver/marc.py similarity index 100% rename from lib/damask/solver/marc.py rename to python/damask/solver/marc.py diff --git a/lib/damask/solver/solver.py b/python/damask/solver/solver.py similarity index 100% rename from lib/damask/solver/solver.py rename to python/damask/solver/solver.py diff --git a/lib/damask/solver/spectral.py b/python/damask/solver/spectral.py similarity index 100% rename from lib/damask/solver/spectral.py rename to python/damask/solver/spectral.py diff --git a/lib/damask/test/__init__.py b/python/damask/test/__init__.py similarity index 100% rename from lib/damask/test/__init__.py rename to python/damask/test/__init__.py diff --git a/lib/damask/test/test.py b/python/damask/test/test.py similarity index 100% rename from lib/damask/test/test.py rename to python/damask/test/test.py diff --git a/lib/damask/util.py b/python/damask/util.py similarity index 94% rename from lib/damask/util.py rename to python/damask/util.py index e7d4a16bc..a88080df5 100644 --- a/lib/damask/util.py +++ b/python/damask/util.py @@ -134,7 +134,7 @@ class extendableOption(Option): # Print iterations progress # from https://gist.github.com/aubricus/f91fb55dc6ba5557fbab06119420dd6a -def progressBar(iteration, total, prefix='', suffix='', decimals=1, bar_length=100): +def progressBar(iteration, total, prefix='', bar_length=50): """ Call in a loop to create terminal progress bar @@ -142,16 +142,29 @@ def progressBar(iteration, total, prefix='', suffix='', decimals=1, bar_length=1 iteration - Required : current iteration (Int) total - Required : total iterations (Int) prefix - Optional : prefix string (Str) - suffix - Optional : suffix string (Str) - decimals - Optional : positive number of decimals in percent complete (Int) bar_length - Optional : character length of bar (Int) """ - str_format = "{0:." + str(decimals) + "f}" - percents = str_format.format(100 * (iteration / float(total))) - filled_length = int(round(bar_length * iteration / float(total))) - bar = '█' * filled_length + '-' * (bar_length - filled_length) + fraction = iteration / float(total) + if not hasattr(progressBar, "last_fraction"): # first call to function + progressBar.start_time = time.time() + progressBar.last_fraction = -1.0 + remaining_time = ' n/a' + else: + if fraction <= progressBar.last_fraction or iteration == 0: # reset: called within a new loop + progressBar.start_time = time.time() + progressBar.last_fraction = -1.0 + remaining_time = ' n/a' + else: + progressBar.last_fraction = fraction + remainder = (total - iteration) * (time.time()-progressBar.start_time)/iteration + remaining_time = '{: 3d}:'.format(int( remainder//3600)) + \ + '{:02d}:'.format(int((remainder//60)%60)) + \ + '{:02d}' .format(int( remainder %60)) - sys.stderr.write('\r%s |%s| %s%s %s' % (prefix, bar, percents, '%', suffix)), + filled_length = int(round(bar_length * fraction)) + bar = '█' * filled_length + '░' * (bar_length - filled_length) + + sys.stderr.write('\r{} {} {}'.format(prefix, bar, remaining_time)), if iteration == total: sys.stderr.write('\n\n') sys.stderr.flush() diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 2e4462243..23c7a5643 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -29,24 +29,28 @@ add_library(IO OBJECT "IO.f90") add_dependencies(IO DAMASK_INTERFACE) list(APPEND OBJECTFILES $) -add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90") -add_dependencies(HDF5_UTILITIES IO) -list(APPEND OBJECTFILES $) - add_library(NUMERICS OBJECT "numerics.f90") -add_dependencies(NUMERICS HDF5_UTILITIES) +add_dependencies(NUMERICS IO) list(APPEND OBJECTFILES $) add_library(DEBUG OBJECT "debug.f90") add_dependencies(DEBUG NUMERICS) list(APPEND OBJECTFILES $) -add_library(CONFIG OBJECT "config.f90") -add_dependencies(CONFIG DEBUG) -list(APPEND OBJECTFILES $) +add_library(DAMASK_CONFIG OBJECT "config.f90") +add_dependencies(DAMASK_CONFIG DEBUG) +list(APPEND OBJECTFILES $) + +add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90") +add_dependencies(HDF5_UTILITIES DAMASK_CONFIG) +list(APPEND OBJECTFILES $) + +add_library(RESULTS OBJECT "results.f90") +add_dependencies(RESULTS HDF5_UTILITIES) +list(APPEND OBJECTFILES $) add_library(FEsolving OBJECT "FEsolving.f90") -add_dependencies(FEsolving DEBUG) +add_dependencies(FEsolving RESULTS) list(APPEND OBJECTFILES $) add_library(DAMASK_MATH OBJECT "math.f90") @@ -68,7 +72,7 @@ elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") endif() add_library(MATERIAL OBJECT "material.f90") -add_dependencies(MATERIAL MESH CONFIG) +add_dependencies(MATERIAL MESH DAMASK_CONFIG) list(APPEND OBJECTFILES $) add_library(DAMASK_HELPERS OBJECT "lattice.f90") @@ -90,9 +94,7 @@ list(APPEND OBJECTFILES $) add_library (KINEMATICS OBJECT "kinematics_cleavage_opening.f90" "kinematics_slipplane_opening.f90" - "kinematics_thermal_expansion.f90" - "kinematics_vacancy_strain.f90" - "kinematics_hydrogen_strain.f90") + "kinematics_thermal_expansion.f90") add_dependencies(KINEMATICS DAMASK_HELPERS) list(APPEND OBJECTFILES $) @@ -102,10 +104,7 @@ add_library (SOURCE OBJECT "source_damage_isoBrittle.f90" "source_damage_isoDuctile.f90" "source_damage_anisoBrittle.f90" - "source_damage_anisoDuctile.f90" - "source_vacancy_phenoplasticity.f90" - "source_vacancy_irradiation.f90" - "source_vacancy_thermalfluc.f90") + "source_damage_anisoDuctile.f90") add_dependencies(SOURCE DAMASK_HELPERS) list(APPEND OBJECTFILES $) @@ -124,25 +123,6 @@ add_library(HOMOGENIZATION OBJECT add_dependencies(HOMOGENIZATION CRYSTALLITE) list(APPEND OBJECTFILES $) -add_library(HYDROGENFLUX OBJECT - "hydrogenflux_isoconc.f90" - "hydrogenflux_cahnhilliard.f90") -add_dependencies(HYDROGENFLUX CRYSTALLITE) -list(APPEND OBJECTFILES $) - -add_library(POROSITY OBJECT - "porosity_none.f90" - "porosity_phasefield.f90") -add_dependencies(POROSITY CRYSTALLITE) -list(APPEND OBJECTFILES $) - -add_library(VACANCYFLUX OBJECT - "vacancyflux_isoconc.f90" - "vacancyflux_isochempot.f90" - "vacancyflux_cahnhilliard.f90") -add_dependencies(VACANCYFLUX CRYSTALLITE) -list(APPEND OBJECTFILES $) - add_library(DAMAGE OBJECT "damage_none.f90" "damage_local.f90" @@ -158,7 +138,7 @@ add_dependencies(THERMAL CRYSTALLITE) list(APPEND OBJECTFILES $) add_library(DAMASK_ENGINE OBJECT "homogenization.f90") -add_dependencies(DAMASK_ENGINE THERMAL DAMAGE VACANCYFLUX POROSITY HYDROGENFLUX HOMOGENIZATION) +add_dependencies(DAMASK_ENGINE THERMAL DAMAGE HOMOGENIZATION) list(APPEND OBJECTFILES $) add_library(DAMASK_CPFE OBJECT "CPFEM2.f90") diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index 674a557b5..847688d57 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -304,8 +304,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt homogState, & thermalState, & damageState, & - vacancyfluxState, & - hydrogenfluxState, & phaseAt, phasememberAt, & material_phase, & phase_plasticity, & @@ -421,8 +419,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt homogState (homog)%state0 = homogState (homog)%state thermalState (homog)%state0 = thermalState (homog)%state damageState (homog)%state0 = damageState (homog)%state - vacancyfluxState (homog)%state0 = vacancyfluxState (homog)%state - hydrogenfluxState(homog)%state0 = hydrogenfluxState(homog)%state enddo diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 2aed858a7..75f57f4c2 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -10,8 +10,8 @@ module CPFEM2 public :: & CPFEM_age, & - CPFEM_initAll - + CPFEM_initAll, & + CPFEM_results contains @@ -20,8 +20,7 @@ contains !-------------------------------------------------------------------------------------------------- subroutine CPFEM_initAll() use prec, only: & - pInt - use prec, only: & + pInt, & prec_init use numerics, only: & numerics_init @@ -39,6 +38,8 @@ subroutine CPFEM_initAll() material_init use HDF5_utilities, only: & HDF5_utilities_init + use results, only: & + results_init use lattice, only: & lattice_init use constitutive, only: & @@ -73,6 +74,7 @@ subroutine CPFEM_initAll() call lattice_init call material_init call HDF5_utilities_init + call results_init call constitutive_init call crystallite_init call homogenization_init @@ -105,8 +107,7 @@ subroutine CPFEM_init debug_levelBasic, & debug_levelExtensive use FEsolving, only: & - restartRead, & - modelName + restartRead use material, only: & material_phase, & homogState, & @@ -125,23 +126,22 @@ subroutine CPFEM_init use hdf5 use HDF5_utilities, only: & HDF5_openFile, & - HDF5_openGroup2, & + HDF5_closeFile, & + HDF5_openGroup, & + HDF5_closeGroup, & HDF5_read use DAMASK_interface, only: & getSolverJobName implicit none - integer(pInt) :: k,l,m,ph,homog + integer(pInt) :: ph,homog character(len=1024) :: rankStr, PlasticItem, HomogItem - integer(HID_T) :: fileReadID, groupPlasticID, groupHomogID - integer :: hdferr + integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - flush(6) - endif mainProcess + flush(6) ! *** restore the last converged values of each essential variable from the binary file if (restartRead) then @@ -152,34 +152,39 @@ subroutine CPFEM_init write(rankStr,'(a1,i0)')'_',worldrank - fileReadID = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5') + fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5') - call HDF5_read(material_phase, fileReadID,'recordedPhase') - call HDF5_read(crystallite_F0, fileReadID,'convergedF') - call HDF5_read(crystallite_Fp0, fileReadID,'convergedFp') - call HDF5_read(crystallite_Fi0, fileReadID,'convergedFi') - call HDF5_read(crystallite_Lp0, fileReadID,'convergedLp') - call HDF5_read(crystallite_Li0, fileReadID,'convergedLi') - call HDF5_read(crystallite_dPdF0, fileReadID,'convergeddPdF') - call HDF5_read(crystallite_Tstar0_v,fileReadID,'convergedTstar') + call HDF5_read(fileHandle,material_phase, 'recordedPhase') + call HDF5_read(fileHandle,crystallite_F0, 'convergedF') + call HDF5_read(fileHandle,crystallite_Fp0, 'convergedFp') + call HDF5_read(fileHandle,crystallite_Fi0, 'convergedFi') + call HDF5_read(fileHandle,crystallite_Lp0, 'convergedLp') + call HDF5_read(fileHandle,crystallite_Li0, 'convergedLi') + call HDF5_read(fileHandle,crystallite_dPdF0, 'convergeddPdF') + call HDF5_read(fileHandle,crystallite_Tstar0_v,'convergedTstar') - groupPlasticID = HDF5_openGroup2(fileReadID,'PlasticPhases') + groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases') do ph = 1_pInt,size(phase_plasticity) write(PlasticItem,*) ph,'_' - call HDF5_read(plasticState(ph)%state0,groupPlasticID,trim(PlasticItem)//'convergedStateConst') + call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst') enddo + call HDF5_closeGroup(groupPlasticID) - groupHomogID = HDF5_openGroup2(fileReadID,'HomogStates') + groupHomogID = HDF5_openGroup(fileHandle,'HomogStates') do homog = 1_pInt, material_Nhomogenization write(HomogItem,*) homog,'_' - call HDF5_read(homogState(homog)%state0, groupHomogID,trim(HomogItem)//'convergedStateHomog') + call HDF5_read(groupHomogID,homogState(homog)%state0, trim(HomogItem)//'convergedStateHomog') enddo + call HDF5_closeGroup(groupHomogID) + + call HDF5_closeFile(fileHandle) restartRead = .false. endif end subroutine CPFEM_init + !-------------------------------------------------------------------------------------------------- !> @brief forwards data after successful increment !-------------------------------------------------------------------------------------------------- @@ -203,8 +208,6 @@ subroutine CPFEM_age() homogState, & thermalState, & damageState, & - vacancyfluxState, & - hydrogenfluxState, & material_phase, & phase_plasticity, & phase_Nsources @@ -231,84 +234,102 @@ subroutine CPFEM_age() use HDF5_utilities, only: & HDF5_openFile, & HDF5_closeFile, & + HDF5_addGroup, & HDF5_closeGroup, & - HDF5_addGroup2, & HDF5_write use hdf5 use DAMASK_interface, only: & getSolverJobName implicit none - - integer(pInt) :: i, k, l, m, ph, homog, mySource + integer(pInt) :: i, ph, homog, mySource character(len=32) :: rankStr, PlasticItem, HomogItem integer(HID_T) :: fileHandle, groupPlastic, groupHomog - integer :: hdferr - integer(HSIZE_T) :: hdfsize -if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & - write(6,'(a)') '<< CPFEM >> aging states' + if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + write(6,'(a)') '<< CPFEM >> aging states' - crystallite_F0 = crystallite_partionedF ! crystallite deformation (_subF is perturbed...) - crystallite_Fp0 = crystallite_Fp ! crystallite plastic deformation - crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity - crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation - crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity - crystallite_dPdF0 = crystallite_dPdF ! crystallite stiffness - crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress - - forall (i = 1:size(plasticState)) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array - - do i = 1, size(sourceState) - do mySource = 1,phase_Nsources(i) - sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array - enddo; enddo - - do homog = 1_pInt, material_Nhomogenization - homogState (homog)%state0 = homogState (homog)%state - thermalState (homog)%state0 = thermalState (homog)%state - damageState (homog)%state0 = damageState (homog)%state - vacancyfluxState (homog)%state0 = vacancyfluxState (homog)%state - hydrogenfluxState(homog)%state0 = hydrogenfluxState(homog)%state - enddo + crystallite_F0 = crystallite_partionedF + crystallite_Fp0 = crystallite_Fp + crystallite_Lp0 = crystallite_Lp + crystallite_Fi0 = crystallite_Fi + crystallite_Li0 = crystallite_Li + crystallite_dPdF0 = crystallite_dPdF + crystallite_Tstar0_v = crystallite_Tstar_v + + forall (i = 1:size(plasticState)) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array + + do i = 1, size(sourceState) + do mySource = 1,phase_Nsources(i) + sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array + enddo; enddo + + do homog = 1_pInt, material_Nhomogenization + homogState (homog)%state0 = homogState (homog)%state + thermalState (homog)%state0 = thermalState (homog)%state + damageState (homog)%state0 = damageState (homog)%state + enddo -if (restartWrite) then - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & - write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file' - write(rankStr,'(a1,i0)')'_',worldrank + if (restartWrite) then + if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file' + + write(rankStr,'(a1,i0)')'_',worldrank + fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','w') + + call HDF5_write(fileHandle,material_phase, 'recordedPhase') + call HDF5_write(fileHandle,crystallite_F0, 'convergedF') + call HDF5_write(fileHandle,crystallite_Fp0, 'convergedFp') + call HDF5_write(fileHandle,crystallite_Fi0, 'convergedFi') + call HDF5_write(fileHandle,crystallite_Lp0, 'convergedLp') + call HDF5_write(fileHandle,crystallite_Li0, 'convergedLi') + call HDF5_write(fileHandle,crystallite_dPdF0, 'convergeddPdF') + call HDF5_write(fileHandle,crystallite_Tstar0_v,'convergedTstar') + + groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases') + do ph = 1_pInt,size(phase_plasticity) + write(PlasticItem,*) ph,'_' + call HDF5_write(groupPlastic,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst') + enddo + call HDF5_closeGroup(groupPlastic) - fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','w') - - call HDF5_write(material_phase, fileHandle,'recordedPhase') - call HDF5_write(crystallite_F0, fileHandle,'convergedF') - call HDF5_write(crystallite_Fp0, fileHandle,'convergedFp') - call HDF5_write(crystallite_Fi0, fileHandle,'convergedFi') - call HDF5_write(crystallite_Lp0, fileHandle,'convergedLp') - call HDF5_write(crystallite_Li0, fileHandle,'convergedLi') - call HDF5_write(crystallite_dPdF0, fileHandle,'convergeddPdF') - call HDF5_write(crystallite_Tstar0_v,fileHandle,'convergedTstar') - - groupPlastic = HDF5_addGroup2(fileHandle,'PlasticPhases') - do ph = 1_pInt,size(phase_plasticity) - write(PlasticItem,*) ph,'_' - call HDF5_write(plasticState(ph)%state0,groupPlastic,trim(PlasticItem)//'convergedStateConst') - enddo - call HDF5_closeGroup(groupPlastic) + groupHomog = HDF5_addGroup(fileHandle,'HomogStates') + do homog = 1_pInt, material_Nhomogenization + write(HomogItem,*) homog,'_' + call HDF5_write(groupHomog,homogState(homog)%state0,trim(HomogItem)//'convergedStateHomog') + enddo + call HDF5_closeGroup(groupHomog) + + call HDF5_closeFile(fileHandle) + restartWrite = .false. + endif - groupHomog = HDF5_addGroup2(fileHandle,'HomogStates') - do homog = 1_pInt, material_Nhomogenization - write(HomogItem,*) homog,'_' - call HDF5_write(homogState(homog)%state0,groupHomog,trim(HomogItem)//'convergedStateHomog') - enddo - call HDF5_closeGroup(groupHomog) - - call HDF5_closeFile(fileHandle) - restartWrite = .false. -endif - -if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & - write(6,'(a)') '<< CPFEM >> done aging states' + if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + write(6,'(a)') '<< CPFEM >> done aging states' end subroutine CPFEM_age +!-------------------------------------------------------------------------------------------------- +!> @brief triggers writing of the results +!-------------------------------------------------------------------------------------------------- +subroutine CPFEM_results(inc,time) + use prec, only: & + pInt + use results + use HDF5_utilities + use constitutive, only: & + constitutive_results + + implicit none + integer(pInt), intent(in) :: inc + real(pReal), intent(in) :: time + + call results_openJobFile + call results_addIncrement(inc,time) + call constitutive_results() + call results_removeLink('current') ! ToDo: put this into closeJobFile + call results_closeJobFile + +end subroutine CPFEM_results + end module CPFEM2 diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index d6827543a..fca67c97d 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -46,7 +46,8 @@ program DAMASK_spectral grid, & geomSize use CPFEM2, only: & - CPFEM_initAll + CPFEM_initAll, & + CPFEM_results use FEsolving, only: & restartWrite, & restartInc @@ -80,6 +81,7 @@ program DAMASK_spectral use spectral_mech_Polarisation use spectral_damage use spectral_thermal + use results implicit none @@ -157,6 +159,9 @@ program DAMASK_spectral write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + + call results_openJobFile() + call results_closeJobFile() !-------------------------------------------------------------------------------------------------- ! initialize field solver information nActiveFields = 1 @@ -420,6 +425,7 @@ program DAMASK_spectral writeUndeformed: if (interface_restartInc < 1_pInt) then write(6,'(1/,a)') ' ... writing initial configuration to file ........................' + call CPFEM_results(0_pInt,0.0_pReal) do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1? min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) @@ -596,6 +602,7 @@ program DAMASK_spectral if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write') enddo fileOffset = fileOffset + sum(outputSize) ! forward to current file position + call CPFEM_results(totalIncsCounter,time) endif if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ... .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 43a7a26e8..2a05f101c 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -4,39 +4,38 @@ !> @author Jennifer Nastola, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !-------------------------------------------------------------------------------------------------- -module HDF5_Utilities - use prec - use IO - use HDF5 +module HDF5_utilities + use prec + use IO + use HDF5 #ifdef PETSc - use PETSC + use PETSC #endif implicit none - private - integer(HID_T), public, protected :: tempCoordinates, tempResults - integer(HID_T), private :: resultsFile, currentIncID, plist_id - integer(pInt), private :: currentInc + public + integer(pInt), parameter, private :: & + HDF5_ERR_TYPE = 4_pInt !< kind of the integer return in the HDF5 library !-------------------------------------------------------------------------------------------------- !> @brief reads pInt or pReal data of defined shape from file !-------------------------------------------------------------------------------------------------- interface HDF5_read - module procedure HDF5_read_pReal_1 - module procedure HDF5_read_pReal_2 - module procedure HDF5_read_pReal_3 - module procedure HDF5_read_pReal_4 - module procedure HDF5_read_pReal_5 - module procedure HDF5_read_pReal_6 - module procedure HDF5_read_pReal_7 + module procedure HDF5_read_pReal1 + module procedure HDF5_read_pReal2 + module procedure HDF5_read_pReal3 + module procedure HDF5_read_pReal4 + module procedure HDF5_read_pReal5 + module procedure HDF5_read_pReal6 + module procedure HDF5_read_pReal7 - module procedure HDF5_read_pInt_1 - module procedure HDF5_read_pInt_2 - module procedure HDF5_read_pInt_3 - module procedure HDF5_read_pInt_4 - module procedure HDF5_read_pInt_5 - module procedure HDF5_read_pInt_6 - module procedure HDF5_read_pInt_7 !ABOVE 8 DIMENSIONS IT GIVES ERROR: THE CALL TO H5DREAD_F DOESNT WORK + module procedure HDF5_read_pInt1 + module procedure HDF5_read_pInt2 + module procedure HDF5_read_pInt3 + module procedure HDF5_read_pInt4 + module procedure HDF5_read_pInt5 + module procedure HDF5_read_pInt6 + module procedure HDF5_read_pInt7 end interface HDF5_read @@ -58,51 +57,46 @@ module HDF5_Utilities module procedure HDF5_write_pInt4 module procedure HDF5_write_pInt5 module procedure HDF5_write_pInt6 - module procedure HDF5_write_pInt7 !ABOVE 8 DIMENSIONS IT GIVES ERROR: THE CALL TO H5DREAD_F DOESNT WORK + module procedure HDF5_write_pInt7 end interface HDF5_write - + +!-------------------------------------------------------------------------------------------------- +!> @brief attached attributes of type char,pInt or pReal to a file/dataset/group +!-------------------------------------------------------------------------------------------------- + interface HDF5_addAttribute + module procedure HDF5_addAttribute_str + module procedure HDF5_addAttribute_pInt + module procedure HDF5_addAttribute_pReal + end interface HDF5_addAttribute + + +!-------------------------------------------------------------------------------------------------- public :: & - HDF5_Utilities_init, & - HDF5_mappingPhase, & - HDF5_mappingHomog, & - HDF5_mappingCrystallite, & - HDF5_backwardMappingPhase, & - HDF5_backwardMappingHomog, & - HDF5_backwardMappingCrystallite, & - HDF5_mappingCells, & - HDF5_addGroup ,& + HDF5_utilities_init, & + HDF5_openFile, & + HDF5_closeFile, & + HDF5_addAttribute, & HDF5_closeGroup ,& HDF5_openGroup, & - HDF5_openGroup2, & - HDF5_forwardResults, & - HDF5_writeVectorDataset, & - HDF5_writeScalarDataset, & - HDF5_writeTensorDataset, & - HDF5_closeJobFile, & - HDF5_removeLink, & - HDF5_createFile, & - HDF5_closeFile, & - HDF5_addGroup2, & - HDF5_openFile, & + HDF5_addGroup, & HDF5_read, & - HDF5_write + HDF5_write, & + HDF5_setLink, & + HDF5_objectExists contains -subroutine HDF5_Utilities_init +subroutine HDF5_utilities_init use, intrinsic :: & iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) implicit none - integer :: hdferr - integer(SIZE_T) :: typeSize + integer(HDF5_ERR_TYPE) :: hdferr + integer(SIZE_T) :: typeSize write(6,'(/,a)') ' <<<+- HDF5_Utilities init -+>>>' #include "compilation_info.f90" - !currentInc = -1_pInt ToDo - !call HDF5_createJobFile ToDo - !-------------------------------------------------------------------------------------------------- !initialize HDF5 library and check if integer and float type size match call h5open_f(hdferr) @@ -114,97 +108,22 @@ subroutine HDF5_Utilities_init if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5tget_size_f (double)') if (int(pReal,SIZE_T)/=typeSize) call IO_error(0_pInt,ext_msg='pReal does not match H5T_NATIVE_DOUBLE') -end subroutine HDF5_Utilities_init +end subroutine HDF5_utilities_init -!-------------------------------------------------------------------------------------------------- -!> @brief creates and initializes HDF5 output files -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_createJobFile - use hdf5 - use DAMASK_interface, only: & - getSolverJobName - - implicit none - integer :: hdferr - character(len=1024) :: path -#ifdef PETSc -#include - - call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5pcreate_f') - call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5pset_fapl_mpio_f') -#endif - -!-------------------------------------------------------------------------------------------------- -! open file - path = trim(getSolverJobName())//'.'//'hdf5' - !call h5fcreate_f(path,H5F_ACC_TRUNC_F,resultsFile,hdferr) - call h5fcreate_f(path,H5F_ACC_TRUNC_F,resultsFile,hdferr,access_prp = plist_id) - if (hdferr < 0) call IO_error(100_pInt,ext_msg=path) - call HDF5_addStringAttribute(resultsFile,'createdBy',DAMASKVERSION) - call h5pclose_f(plist_id, hdferr) !neu - -end subroutine HDF5_createJobFile - - -!-------------------------------------------------------------------------------------------------- -!> @brief creates and initializes HDF5 output files -!-------------------------------------------------------------------------------------------------- - integer(HID_T) function HDF5_createFile(path) - use hdf5 - use DAMASK_interface, only: & - getSolverJobName - - implicit none - integer :: hdferr - integer(SIZE_T) :: typeSize - character(len=*), intent(in) :: path -#ifdef PETSc -#include -#endif - call h5open_f(hdferr) !############################################################ DANGEROUS -#ifdef PETSc - call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5pcreate_f') - call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5pset_fapl_mpio_f') -#endif -!-------------------------------------------------------------------------------------------------- -! create a file - !call h5fcreate_f(path,H5F_ACC_TRUNC_F,resultsFile,hdferr) - call h5fcreate_f(path,H5F_ACC_TRUNC_F,HDF5_createFile,hdferr,access_prp = plist_id) - if (hdferr < 0) call IO_error(100_pInt,ext_msg=path) - !call HDF5_addStringAttribute(HDF5_createFile,'createdBy',DAMASKVERSION) - call h5pclose_f(plist_id, hdferr) !neu - -end function HDF5_createFile - -!-------------------------------------------------------------------------------------------------- -!> @brief close the opened HDF5 output file -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_closeJobFile() - use hdf5 - - implicit none - integer :: hdferr - call HDF5_removeLink('current') - call h5fclose_f(resultsFile,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_closeJobFile: h5fclose_f',el=hdferr) -! call h5close_f(hdferr) - -end subroutine HDF5_closeJobFile !-------------------------------------------------------------------------------------------------- !> @brief open and initializes HDF5 output file !-------------------------------------------------------------------------------------------------- -integer(HID_T) function HDF5_openFile(fileName,mode) +integer(HID_T) function HDF5_openFile(fileName,mode,parallel) implicit none character(len=*), intent(in) :: fileName character, intent(in), optional :: mode + logical, intent(in), optional :: parallel + character :: m - integer :: hdferr + integer(HID_T) :: plist_id + integer(HDF5_ERR_TYPE) :: hdferr if (present(mode)) then m = mode @@ -212,2130 +131,2938 @@ integer(HID_T) function HDF5_openFile(fileName,mode) m = 'r' endif - if (m == 'w') then - call h5fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fcreate_f',el=hdferr) + call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5pcreate_f') + +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5pset_fapl_mpio_f') + endif; endif +#endif + + if (m == 'w') then + call h5fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr,access_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fcreate_f') elseif(m == 'a') then - call h5fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (a)',el=hdferr) + call h5fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (a)') elseif(m == 'r') then - call h5fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (r)',el=hdferr) + call h5fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f (r)') else - call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f unknown access mode',el=hdferr) + call IO_error(1_pInt,ext_msg='HDF5_openFile: h5fopen_f unknown access mode') endif + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_openFile: h5pclose_f') + end function HDF5_openFile + !-------------------------------------------------------------------------------------------------- !> @brief close the opened HDF5 output file !-------------------------------------------------------------------------------------------------- subroutine HDF5_closeFile(fileHandle) implicit none - integer :: hdferr integer(HID_T), intent(in) :: fileHandle + + integer(HDF5_ERR_TYPE) :: hdferr + call h5fclose_f(fileHandle,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_closeFile: h5fclose_f',el=hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_closeFile: h5fclose_f') end subroutine HDF5_closeFile + !-------------------------------------------------------------------------------------------------- -!> @brief adds a new group to the results file +!> @brief adds a new group to the fileHandle !-------------------------------------------------------------------------------------------------- -integer(HID_T) function HDF5_addGroup(groupName) - use hdf5 +integer(HID_T) function HDF5_addGroup(fileHandle,groupName) implicit none + integer(HID_T), intent(in) :: fileHandle character(len=*), intent(in) :: groupName - integer :: hdferr - call h5gcreate_f(resultsFile, trim(groupName), HDF5_addGroup, hdferr) + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: aplist_id + + !------------------------------------------------------------------------------------------------- + ! creating a property list for data access properties + call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5pcreate_f ('//trim(groupName)//')') + + !------------------------------------------------------------------------------------------------- + ! setting I/O mode to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')') + + !------------------------------------------------------------------------------------------------- + ! Create group + call h5gcreate_f(fileHandle, trim(groupName), HDF5_addGroup, hdferr, OBJECT_NAMELEN_DEFAULT_F,gapl_id = aplist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5gcreate_f ('//trim(groupName)//')') end function HDF5_addGroup !-------------------------------------------------------------------------------------------------- -!> @brief adds a new group to the fileHandle (additional to addGroup2) +!> @brief open an existing group of a file !-------------------------------------------------------------------------------------------------- -integer(HID_T) function HDF5_addGroup2(fileHandle,groupName) - use hdf5 +integer(HID_T) function HDF5_openGroup(fileHandle,groupName) implicit none + integer(HID_T), intent(in) :: fileHandle character(len=*), intent(in) :: groupName - integer(HID_T), intent(in) :: fileHandle - integer :: hdferr - - call h5gcreate_f(fileHandle, trim(groupName), HDF5_addGroup2, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup2: h5gcreate_f ('//trim(groupName)//')') - -end function HDF5_addGroup2 -!-------------------------------------------------------------------------------------------------- -!> @brief open a group from the results file -!-------------------------------------------------------------------------------------------------- -integer(HID_T) function HDF5_openGroup(groupName) - use hdf5 + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: aplist_id + logical :: is_collective + + + !------------------------------------------------------------------------------------------------- + ! creating a property list for data access properties + call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5pcreate_f ('//trim(groupName)//')') - implicit none - character(len=*), intent(in) :: groupName - integer :: hdferr - - call h5gopen_f(resultsFile, trim(groupName), HDF5_openGroup, hdferr) + !------------------------------------------------------------------------------------------------- + ! setting I/O mode to collective + call h5pget_all_coll_metadata_ops_f(aplist_id, is_collective, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')') + + !------------------------------------------------------------------------------------------------- + ! opening the group + call h5gopen_f(fileHandle, trim(groupName), HDF5_openGroup, hdferr, gapl_id = aplist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5gopen_f ('//trim(groupName)//')') end function HDF5_openGroup -!-------------------------------------------------------------------------------------------------- -!> @brief open an existing group of a file -!-------------------------------------------------------------------------------------------------- -integer(HID_T) function HDF5_openGroup2(FileReadID,groupName) - use hdf5 - - implicit none - character(len=*), intent(in) :: groupName - integer :: hdferr - integer(HID_T), intent(in) :: FileReadID - - call h5gopen_f(FileReadID, trim(groupName), HDF5_openGroup2, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup2: h5gopen_f ('//trim(groupName)//')') - -end function HDF5_openGroup2 - -!-------------------------------------------------------------------------------------------------- -!> @brief set link to object in results file -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_setLink(path,link) - use hdf5 - - implicit none - character(len=*), intent(in) :: path, link - integer :: hdferr - logical :: linkExists - - call h5lexists_f(resultsFile, link,linkExists, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lexists_soft_f ('//trim(link)//')') - if (linkExists) then - call h5ldelete_f(resultsFile,link, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5ldelete_soft_f ('//trim(link)//')') - endif - call h5lcreate_soft_f(path, resultsFile, link, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lcreate_soft_f ('//trim(path)//' '//trim(link)//')') - -end subroutine HDF5_setLink - -!-------------------------------------------------------------------------------------------------- -!> @brief remove link to an object -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_removeLink(link) - use hdf5 - - implicit none - character(len=*), intent(in) :: link - integer :: hdferr - - call h5ldelete_f(resultsFile,link, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_removeLink: h5ldelete_soft_f ('//trim(link)//')') - -end subroutine HDF5_removeLink !-------------------------------------------------------------------------------------------------- !> @brief close a group !-------------------------------------------------------------------------------------------------- -subroutine HDF5_closeGroup(ID) - use hdf5 +subroutine HDF5_closeGroup(group_id) implicit none - integer(HID_T), intent(in) :: ID - integer :: hdferr + integer(HID_T), intent(in) :: group_id + integer(HDF5_ERR_TYPE) :: hdferr - call h5gclose_f(ID, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = int(ID,pInt)) + call h5gclose_f(group_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = int(group_id,pInt)) end subroutine HDF5_closeGroup + !-------------------------------------------------------------------------------------------------- -!> @brief adds a StringAttribute to the results file +!> @brief check whether a group or a dataset exists !-------------------------------------------------------------------------------------------------- -subroutine HDF5_addStringAttribute(entity,attrLabel,attrValue) - use hdf5 +logical function HDF5_objectExists(loc_id,path) implicit none - integer(HID_T), intent(in) :: entity + integer(HID_T), intent(in) :: loc_id + character(len=*), intent(in), optional :: path + integer(HDF5_ERR_TYPE) :: hdferr + character(len=256) :: p + + if (present(path)) then + p = trim(path) + else + p = '.' + endif + + call h5lexists_f(loc_id, p, HDF5_objectExists, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f') + + if(HDF5_objectExists) then + call h5oexists_by_name_f(loc_id, p, HDF5_objectExists, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f') + endif + +end function HDF5_objectExists + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a string attribute to the path given relative to the location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) + + implicit none + integer(HID_T), intent(in) :: loc_id character(len=*), intent(in) :: attrLabel, attrValue - integer :: hdferr + character(len=*), intent(in), optional :: path + integer(HDF5_ERR_TYPE) :: hdferr integer(HID_T) :: attr_id, space_id, type_id + logical :: attrExists + character(len=256) :: p + + if (present(path)) then + p = trim(path) + else + p = '.' + endif call h5screate_f(H5S_SCALAR_F,space_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5screate_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5screate_f') call h5tcopy_f(H5T_NATIVE_CHARACTER, type_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5tcopy_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5tcopy_f') call h5tset_size_f(type_id, int(len(trim(attrValue)),HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5tset_size_f') - call h5acreate_f(entity, trim(attrLabel),type_id,space_id,attr_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5acreate_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5tset_size_f') + call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5aexists_by_name_f') + if (attrExists) then + call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5adelete_by_name_f') + endif + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5acreate_f') call h5awrite_f(attr_id, type_id, trim(attrValue), int([1],HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5awrite_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5awrite_f') call h5aclose_f(attr_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5aclose_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5aclose_f') call h5tclose_f(type_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5tclose_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5tclose_f') call h5sclose_f(space_id,hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5sclose_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_str: h5sclose_f') + +end subroutine HDF5_addAttribute_str -end subroutine HDF5_addStringAttribute !-------------------------------------------------------------------------------------------------- -!> @brief adds the unique mapping from spatial position and constituent ID to results +!> @brief adds a integer attribute to the path given relative to the location !-------------------------------------------------------------------------------------------------- -subroutine HDF5_mappingPhase(mapping,mapping2,Nconstituents,material_phase,phase_name,dataspace_size,mpiOffset,mpiOffset_phase) +subroutine HDF5_addAttribute_pInt(loc_id,attrLabel,attrValue,path) + + implicit none + integer(HID_T), intent(in) :: loc_id + character(len=*), intent(in) :: attrLabel + integer(pInt), intent(in) :: attrValue + character(len=*), intent(in), optional :: path + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: attr_id, space_id, type_id + logical :: attrExists + character(len=256) :: p + + if (present(path)) then + p = trim(path) + else + p = '.' + endif + + call h5screate_f(H5S_SCALAR_F,space_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5screate_f') + call h5tcopy_f(H5T_NATIVE_INTEGER, type_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5tcopy_f') + call h5tset_size_f(type_id, 1_HSIZE_T, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5tset_size_f') + call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5aexists_by_name_f') + if (attrExists) then + call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5adelete_by_name_f') + endif + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5acreate_f') + call h5awrite_f(attr_id, type_id, attrValue, int([1],HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5awrite_f') + call h5aclose_f(attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5aclose_f') + call h5tclose_f(type_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5tclose_f') + call h5sclose_f(space_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pInt: h5sclose_f') + +end subroutine HDF5_addAttribute_pInt + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a integer attribute to the path given relative to the location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addAttribute_pReal(loc_id,attrLabel,attrValue,path) + + implicit none + integer(HID_T), intent(in) :: loc_id + character(len=*), intent(in) :: attrLabel + real(pReal), intent(in) :: attrValue + character(len=*), intent(in), optional :: path + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: attr_id, space_id, type_id + logical :: attrExists + character(len=256) :: p + + if (present(path)) then + p = trim(path) + else + p = '.' + endif + + call h5screate_f(H5S_SCALAR_F,space_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5screate_f') + call h5tcopy_f(H5T_NATIVE_DOUBLE, type_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5tcopy_f') + call h5tset_size_f(type_id, 8_HSIZE_T, hdferr) ! ToDo + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5tset_size_f') + call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5aexists_by_name_f') + if (attrExists) then + call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5adelete_by_name_f') + endif + call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5acreate_f') + call h5awrite_f(attr_id, type_id, attrValue, int([1],HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5awrite_f') + call h5aclose_f(attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5aclose_f') + call h5tclose_f(type_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5tclose_f') + call h5sclose_f(space_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addAttribute_pReal: h5sclose_f') + +end subroutine HDF5_addAttribute_pReal + + +!-------------------------------------------------------------------------------------------------- +!> @brief set link to object in results file +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_setLink(loc_id,target_name,link_name) use hdf5 implicit none - integer(pInt), intent(in) :: Nconstituents, dataspace_size, mpiOffset - integer(pInt), intent(in), dimension(:) :: mapping, mapping2 - character(len=*), intent(in), dimension(:) :: phase_name - integer(pInt), intent(in), dimension(:) :: mpiOffset_phase - integer(pInt), intent(in), dimension(:,:,:) :: material_phase + character(len=*), intent(in) :: target_name, link_name + integer(HID_T), intent(in) :: loc_id + integer(HDF5_ERR_TYPE) :: hdferr + logical :: linkExists - character(len=len(phase_name(1))), dimension(:), allocatable :: namesNA - character(len=len(phase_name(1))) :: a - character(len=*), parameter :: n = "NULL" + call h5lexists_f(loc_id, link_name,linkExists, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lexists_soft_f ('//trim(link_name)//')') + if (linkExists) then + call h5ldelete_f(loc_id,link_name, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5ldelete_soft_f ('//trim(link_name)//')') + endif + call h5lcreate_soft_f(target_name, loc_id, link_name, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lcreate_soft_f ('//trim(target_name)//' '//trim(link_name)//')') - integer(pInt) :: hdferr, NmatPoints, i, j, k - integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace - integer(HID_T) :: dt5_id ! Memory datatype identifier - integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size - - integer(HSIZE_T), dimension(2) :: counter - integer(HSSIZE_T), dimension(2) :: fileOffset - integer(pInt), dimension(:,:), allocatable :: arrOffset - - a = n - allocate(namesNA(0:size(phase_name)),source=[a,phase_name]) - NmatPoints = size(mapping,1)/Nconstituents - mapping_ID = HDF5_openGroup("current/mapGeometry") - - allocate(arrOffset(Nconstituents,NmatPoints)) - do i=1_pInt, NmatPoints - do k=1_pInt, Nconstituents - do j=1_pInt, size(phase_name) - if(material_phase(k,1,i) == j) & - arrOffset(k,i) = mpiOffset_phase(j) - enddo - enddo - enddo +end subroutine HDF5_setLink !-------------------------------------------------------------------------------------------------- -! create dataspace - call h5screate_simple_f(2, int([Nconstituents,dataspace_size],HSIZE_T), space_id, hdferr, & - int([Nconstituents,dataspace_size],HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') - +!> @brief subroutine for reading dataset of type pReal with 1 dimensions !-------------------------------------------------------------------------------------------------- -! compound type - ! First calculate total size by calculating sizes of each member - ! - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) - typesize = len(phase_name(1)) - CALL h5tset_size_f(dt5_id, typesize, hdferr) - CALL h5tget_size_f(dt5_id, type_sizec, hdferr) - CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr) - type_size = type_sizec + type_sizei - call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') +subroutine HDF5_read_pReal1(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize - call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 0') - call h5tinsert_f(dtype_id, "Position", type_sizec, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 2') + implicit none + real(pReal), intent(inout), dimension(:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel -!-------------------------------------------------------------------------------------------------- -! create Dataset - call h5dcreate_f(mapping_id, 'constitutive', dtype_id, space_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase') -!-------------------------------------------------------------------------------------------------- -! Create memory types (one compound datatype for each member) - call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f instance_id') - call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f instance_id') + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(1) :: myStart - call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f position_id') - call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f position_id') +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return -!-------------------------------------------------------------------------------------------------- -! Define and select hyperslabs - counter(1) = Nconstituents ! how big i am - counter(2) = NmatPoints - fileOffset(1) = 0 ! where i start to write my data - fileOffset(2) = mpiOffset - - call h5screate_simple_f(2, counter, memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5screate_simple_f') - call h5dget_space_f(dset_id, space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dget_space_f') - call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- - ! Create property list for collective dataset write -#ifdef PETSc +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pcreate_f') - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pset_dxpl_mpio_f') -#endif +!------------------------------------------------------------------------------------------------- +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- -! write data by fields in the datatype. Fields order is not important. - call h5dwrite_f(dset_id, name_id, reshape(namesNA(mapping),[Nconstituents,NmatPoints]), & - int([Nconstituents, dataspace_size],HSIZE_T), hdferr, & - file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f position_id') - - call h5dwrite_f(dset_id, position_id, reshape(mapping2-1_pInt,[Nconstituents,NmatPoints])+arrOffset, & - int([Nconstituents, dataspace_size],HSIZE_T), hdferr, & - file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f instance_id') - -!-------------------------------------------------------------------------------------------------- -! close types, dataspaces - call h5tclose_f(dtype_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f dtype_id') - call h5tclose_f(position_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f position_id') - call h5tclose_f(name_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f name_id ') - call h5tclose_f(dt5_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f dt5_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dclose_f') - call h5sclose_f(space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sclose_f space_id') - call h5sclose_f(memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sclose_f memspace') - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pclose_f') - call HDF5_closeGroup(mapping_ID) - -end subroutine HDF5_mappingPhase - -!-------------------------------------------------------------------------------------------------- -!> @brief adds the backward mapping from spatial position and constituent ID to results -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_backwardMappingPhase(material_phase,phasememberat,phase_name,dataspace_size,mpiOffset,mpiOffset_phase) - use hdf5 - - implicit none - integer(pInt), intent(in), dimension(:,:,:) :: material_phase, phasememberat - character(len=*), intent(in), dimension(:) :: phase_name - integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_phase - integer(pInt), intent(in) :: mpiOffset - - integer(pInt) :: hdferr, NmatPoints, Nconstituents, i, j - integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace - integer(SIZE_T) :: type_size - - integer(pInt), dimension(:,:), allocatable :: arr - - integer(HSIZE_T), dimension(1) :: counter - integer(HSSIZE_T), dimension(1) :: fileOffset - - character(len=64) :: phaseID - - Nconstituents = size(phasememberat,1) - NmatPoints = count(material_phase /=0_pInt)/Nconstituents - - allocate(arr(2,NmatPoints*Nconstituents)) - - do i=1_pInt, NmatPoints - do j=Nconstituents-1_pInt, 0_pInt, -1_pInt - arr(1,Nconstituents*i-j) = i-1_pInt - enddo - enddo - arr(2,:) = pack(material_phase,material_phase/=0_pInt) - - do i=1_pInt, size(phase_name) - write(phaseID, '(i0)') i - mapping_ID = HDF5_openGroup('/current/constitutive/'//trim(phaseID)//'_'//phase_name(i)) - NmatPoints = count(material_phase == i) - -!-------------------------------------------------------------------------------------------------- - ! create dataspace - call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, & - int([dataspace_size(i)],HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') - -!-------------------------------------------------------------------------------------------------- - ! compound type - call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) - call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') - - call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f 0') - -!-------------------------------------------------------------------------------------------------- - ! create Dataset - call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase') - -!-------------------------------------------------------------------------------------------------- - ! Create memory types (one compound datatype for each member) - call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tcreate_f position_id') - call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f position_id') - -!-------------------------------------------------------------------------------------------------- - ! Define and select hyperslabs - counter = NmatPoints ! how big i am - fileOffset = mpiOffset_phase(i) ! where i start to write my data - - call h5screate_simple_f(1, counter, memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5screate_simple_f') - call h5dget_space_f(dset_id, space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dget_space_f') - call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- - ! Create property list for collective dataset write + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(1) #ifdef PETSc - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pcreate_f') + if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal1: MPI_allreduce') + endif; endif #endif + myStart = int([sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:0),sum(readSize)] + !-------------------------------------------------------------------------------------------------- - ! write data by fields in the datatype. Fields order is not important. - call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset, int([dataspace_size(i)],HSIZE_T),& - hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dwrite_f instance_id') +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5pset_all_coll_metadata_ops_f') +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dopen_f') !-------------------------------------------------------------------------------------------------- - !close types, dataspaces - call h5tclose_f(dtype_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f dtype_id') - call h5tclose_f(position_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f position_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dclose_f') - call h5sclose_f(space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sclose_f space_id') - call h5sclose_f(memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sclose_f memspace') - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pclose_f') - call HDF5_closeGroup(mapping_ID) - - enddo - -end subroutine HDF5_backwardMappingPhase +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dget_space_f') !-------------------------------------------------------------------------------------------------- -!> @brief adds the unique mapping from spatial position and constituent ID to results -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_mappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog) - use hdf5 - - implicit none - integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat - character(len=*), intent(in), dimension(:) :: homogenization_name - integer(pInt), intent(in), dimension(:) :: mpiOffset_homog - integer(pInt), intent(in) :: dataspace_size, mpiOffset - - integer(pInt) :: hdferr, NmatPoints, i, j - integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace - - integer(HID_T) :: dt5_id ! Memory datatype identifier - integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size - - integer(HSIZE_T), dimension(1) :: counter - integer(HSSIZE_T), dimension(1) :: fileOffset - integer(pInt), dimension(:), allocatable :: arrOffset - - NmatPoints = count(material_homog /=0_pInt) - mapping_ID = HDF5_openGroup("current/mapGeometry") - - allocate(arrOffset(NmatPoints)) - do i=1_pInt, NmatPoints - do j=1_pInt, size(homogenization_name) - if(material_homog(1,i) == j) & - arrOffset(i) = mpiOffset_homog(j) - enddo - enddo +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5sselect_hyperslab_f') !-------------------------------------------------------------------------------------------------- -! create dataspace - call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, & - int([dataspace_size],HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') - -!-------------------------------------------------------------------------------------------------- -! compound type - ! First calculate total size by calculating sizes of each member - ! - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) - typesize = len(homogenization_name(1)) - CALL h5tset_size_f(dt5_id, typesize, hdferr) - CALL h5tget_size_f(dt5_id, type_sizec, hdferr) - CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr) - type_size = type_sizec + type_sizei - call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') - - call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 0') - call h5tinsert_f(dtype_id, "Position", type_sizec, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 2') - -!-------------------------------------------------------------------------------------------------- -! create Dataset - call h5dcreate_f(mapping_id, 'homogenization', dtype_id, space_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog') - -!-------------------------------------------------------------------------------------------------- -! Create memory types (one compound datatype for each member) - call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f instance_id') - call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f instance_id') - - call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f position_id') - call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f position_id') - -!-------------------------------------------------------------------------------------------------- -! Define and select hyperslabs - counter = NmatPoints ! how big i am - fileOffset = mpiOffset ! where i start to write my data - - call h5screate_simple_f(1, counter, memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5screate_simple_f') - call h5dget_space_f(dset_id, space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dget_space_f') - call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- -! Create property list for collective dataset write -#ifdef PETSc - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pcreate_f') - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pset_dxpl_mpio_f') -#endif - -!-------------------------------------------------------------------------------------------------- -! write data by fields in the datatype. Fields order is not important. - call h5dwrite_f(dset_id, name_id, homogenization_name(pack(material_homog,material_homog/=0_pInt)), & - int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & - mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f position_id') - - call h5dwrite_f(dset_id, position_id, pack(homogmemberat-1_pInt,homogmemberat/=0_pInt) + arrOffset, & - int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & - mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f instance_id') +! read + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dread_f') !-------------------------------------------------------------------------------------------------- !close types, dataspaces -call h5tclose_f(dtype_id, hdferr) -if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f dtype_id') -call h5tclose_f(position_id, hdferr) -if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f position_id') -call h5tclose_f(name_id, hdferr) -if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f name_id ') -call h5tclose_f(dt5_id, hdferr) -if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f dt5_id') -call h5dclose_f(dset_id, hdferr) -if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dclose_f') -call h5sclose_f(space_id, hdferr) -if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sclose_f space_id') -call h5sclose_f(memspace, hdferr) -if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sclose_f memspace') -call h5pclose_f(plist_id, hdferr) -if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pclose_f') -call HDF5_closeGroup(mapping_ID) + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal1: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pReal1 -end subroutine HDF5_mappingHomog !-------------------------------------------------------------------------------------------------- -!> @brief adds the backward mapping from spatial position and constituent ID to results +!> @brief subroutine for reading dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_backwardMappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog) - use hdf5 +subroutine HDF5_read_pReal2(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat - character(len=*), intent(in), dimension(:) :: homogenization_name - integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_homog - integer(pInt), intent(in) :: mpiOffset + real(pReal), intent(inout), dimension(:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt) :: hdferr, NmatPoints, i - integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace - integer(SIZE_T) :: type_size - integer(pInt), dimension(:,:), allocatable :: arr + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(2) :: myStart - integer(HSIZE_T), dimension(1) :: counter - integer(HSSIZE_T), dimension(1) :: fileOffset +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return - character(len=64) :: homogID - - NmatPoints = count(material_homog /=0_pInt) - allocate(arr(2,NmatPoints)) - - arr(1,:) = (/(i, i=0_pint,NmatPoints-1_pInt)/) - arr(2,:) = pack(material_homog,material_homog/=0_pInt) - - do i=1_pInt, size(homogenization_name) - write(homogID, '(i0)') i - mapping_ID = HDF5_openGroup('/current/homogenization/'//trim(homogID)//'_'//homogenization_name(i)) +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) +!------------------------------------------------------------------------------------------------- +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - ! create dataspace - call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, & - int([dataspace_size(i)],HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') - -!-------------------------------------------------------------------------------------------------- - ! compound type - call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) - call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') - - call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f 0') - -!-------------------------------------------------------------------------------------------------- - ! create Dataset - call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog') - -!-------------------------------------------------------------------------------------------------- - ! Create memory types (one compound datatype for each member) - call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tcreate_f position_id') - call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f position_id') - -!-------------------------------------------------------------------------------------------------- - ! Define and select hyperslabs - counter = NmatPoints ! how big i am - fileOffset = mpiOffset_homog(i) ! where i start to write my data - - call h5screate_simple_f(1, counter, memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5screate_simple_f') - call h5dget_space_f(dset_id, space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dget_space_f') - call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- - ! Create property list for collective dataset write + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(2) #ifdef PETSc - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pcreate_f') + if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal2: MPI_allreduce') + endif; endif #endif + myStart = int([0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:1),sum(readSize)] + !-------------------------------------------------------------------------------------------------- - ! write data by fields in the datatype. Fields order is not important. - call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset,int([dataspace_size(i)],HSIZE_T),& - hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dwrite_f instance_id') +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5pset_all_coll_metadata_ops_f') +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dopen_f') !-------------------------------------------------------------------------------------------------- - !close types, dataspaces - call h5tclose_f(dtype_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f dtype_id') - call h5tclose_f(position_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f position_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dclose_f') - call h5sclose_f(space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sclose_f space_id') - call h5sclose_f(memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sclose_f memspace') - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pclose_f') - call HDF5_closeGroup(mapping_ID) - - enddo - -end subroutine HDF5_backwardMappingHomog +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dget_space_f') !-------------------------------------------------------------------------------------------------- -!> @brief adds the unique mapping from spatial position and constituent ID to results -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_mappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst) - use hdf5 - - implicit none - integer(pInt), intent(in), dimension(:,:) :: crystalliteAt - integer(pInt), intent(in), dimension(:,:,:) :: crystmemberAt - character(len=*), intent(in), dimension(:) :: crystallite_name - integer(pInt), intent(in), dimension(:) :: mpiOffset_cryst - integer(pInt), intent(in) :: dataspace_size, mpiOffset - - integer :: hdferr - integer(pInt) :: NmatPoints, Nconstituents, i, j - integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, plist_id, memspace - - integer(HID_T), dimension(:), allocatable :: position_id - - integer(HID_T) :: dt5_id ! Memory datatype identifier - integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size - - integer(HSIZE_T), dimension(1) :: counter - integer(HSSIZE_T), dimension(1) :: fileOffset - integer(pInt), dimension(:), allocatable :: arrOffset - - character(len=64) :: m - - Nconstituents = size(crystmemberAt,1) - NmatPoints = count(crystalliteAt /=0_pInt) - mapping_ID = HDF5_openGroup("current/mapGeometry") - - allocate(position_id(Nconstituents)) - - allocate(arrOffset(NmatPoints)) - do i=1_pInt, NmatPoints - do j=1_pInt, size(crystallite_name) - if(crystalliteAt(1,i) == j) & - arrOffset(i) = Nconstituents*mpiOffset_cryst(j) - enddo - enddo +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5sselect_hyperslab_f') !-------------------------------------------------------------------------------------------------- -! create dataspace - call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, & - int([dataspace_size],HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') - -!-------------------------------------------------------------------------------------------------- -! compound type - ! First calculate total size by calculating sizes of each member - ! - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) - typesize = len(crystallite_name(1)) - CALL h5tset_size_f(dt5_id, typesize, hdferr) - CALL h5tget_size_f(dt5_id, type_sizec, hdferr) - CALL h5tget_size_f(H5T_STD_I32LE, type_sizei, hdferr) - type_size = type_sizec + type_sizei*Nconstituents - call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') - - call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 0') - do i=1_pInt, Nconstituents - write(m, '(i0)') i - call h5tinsert_f(dtype_id, "Position "//trim(m), type_sizec+(i-1)*type_sizei, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 2 '//trim(m)) - enddo - -!-------------------------------------------------------------------------------------------------- -! create Dataset - call h5dcreate_f(mapping_id, 'crystallite', dtype_id, space_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite') - -!-------------------------------------------------------------------------------------------------- -! Create memory types (one compound datatype for each member) - call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f instance_id') - call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f instance_id') - - do i=1_pInt, Nconstituents - write(m, '(i0)') i - call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id(i), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f position_id') - call h5tinsert_f(position_id(i), "Position "//trim(m), 0_SIZE_T, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f position_id') - enddo - -!-------------------------------------------------------------------------------------------------- -! Define and select hyperslabs - counter = NmatPoints ! how big i am - fileOffset = mpiOffset ! where i start to write my data - - call h5screate_simple_f(1, counter, memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5screate_simple_f') - call h5dget_space_f(dset_id, space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dget_space_f') - call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- - ! Create property list for collective dataset write -#ifdef PETSc - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pcreate_f') - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pset_dxpl_mpio_f') -#endif - -!-------------------------------------------------------------------------------------------------- -! write data by fields in the datatype. Fields order is not important. - call h5dwrite_f(dset_id, name_id, crystallite_name(pack(crystalliteAt,crystalliteAt/=0_pInt)), & - int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & - mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f position_id') - - do i=1_pInt, Nconstituents - call h5dwrite_f(dset_id, position_id(i), pack(crystmemberAt(i,:,:)-1_pInt,crystmemberAt(i,:,:)/=0_pInt)+arrOffset,& - int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & - mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f instance_id') - enddo +! read + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dread_f') !-------------------------------------------------------------------------------------------------- !close types, dataspaces - call h5tclose_f(dtype_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f dtype_id') - do i=1_pInt, Nconstituents - call h5tclose_f(position_id(i), hdferr) - enddo - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f position_id') - call h5tclose_f(name_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f name_id') - call h5tclose_f(dt5_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f dt5_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dclose_f') - call h5sclose_f(space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sclose_f space_id') - call h5sclose_f(memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sclose_f memspace') call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pclose_f') - call HDF5_closeGroup(mapping_ID) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal2: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal2: h5sclose_f/memspace_id') -end subroutine HDF5_mappingCrystallite +end subroutine HDF5_read_pReal2 !-------------------------------------------------------------------------------------------------- -!> @brief adds the backward mapping from spatial position and constituent ID to results +!> @brief subroutine for reading dataset of type pReal with 3 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_backwardMappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst) - use hdf5 +subroutine HDF5_read_pReal3(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(pInt), intent(in), dimension(:,:) :: crystalliteAt - integer(pInt), intent(in), dimension(:,:,:) :: crystmemberAt - character(len=*), intent(in), dimension(:) :: crystallite_name - integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_cryst - integer(pInt), intent(in) :: mpiOffset + real(pReal), intent(inout), dimension(:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(pInt) :: NmatPoints, Nconstituents, i, j - integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace - integer(SIZE_T) :: type_size - integer(pInt), dimension(:,:), allocatable :: h_arr, arr + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(3) :: myStart - integer(HSIZE_T), dimension(1) :: counter - integer(HSSIZE_T), dimension(1) :: fileOffset +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return - character(len=64) :: crystallID - - Nconstituents = size(crystmemberAt,1) - NmatPoints = count(crystalliteAt /=0_pInt) - - allocate(h_arr(2,NmatPoints)) - allocate(arr(2,Nconstituents*NmatPoints)) - - h_arr(1,:) = (/(i, i=0_pInt,NmatPoints-1_pInt)/) - h_arr(2,:) = pack(crystalliteAt,crystalliteAt/=0_pInt) - - do i=1_pInt, NmatPoints - do j=Nconstituents-1_pInt, 0_pInt, -1_pInt - arr(1,Nconstituents*i-j) = h_arr(1,i) - arr(2,Nconstituents*i-j) = h_arr(2,i) - enddo - enddo - - do i=1_pInt, size(crystallite_name) - if (crystallite_name(i) == 'none') cycle - write(crystallID, '(i0)') i - mapping_ID = HDF5_openGroup('/current/crystallite/'//trim(crystallID)//'_'//crystallite_name(i)) - NmatPoints = count(crystalliteAt == i) +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) +!------------------------------------------------------------------------------------------------- +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- - ! create dataspace - call h5screate_simple_f(1, int([Nconstituents*dataspace_size(i)],HSIZE_T), space_id, hdferr, & - int([Nconstituents*dataspace_size(i)],HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') - -!-------------------------------------------------------------------------------------------------- - ! compound type - call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) - call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') - - call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f 0') - -!-------------------------------------------------------------------------------------------------- - ! create Dataset - call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite') - -!-------------------------------------------------------------------------------------------------- - ! Create memory types - call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tcreate_f position_id') - call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f position_id') - -!-------------------------------------------------------------------------------------------------- - ! Define and select hyperslabs - counter = Nconstituents*NmatPoints ! how big i am - fileOffset = Nconstituents*mpiOffset_cryst(i) ! where i start to write my data - - call h5screate_simple_f(1, counter, memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5screate_simple_f') - call h5dget_space_f(dset_id, space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dget_space_f') - call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sselect_hyperslab_f') - -!-------------------------------------------------------------------------------------------------- - ! Create property list for collective dataset write + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(3) #ifdef PETSc - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pcreate_f') + if (present(parallel)) then; if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pset_dxpl_mpio_f') + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal3: MPI_allreduce') + endif; endif #endif + myStart = int([0,0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:2),sum(readSize)] + !-------------------------------------------------------------------------------------------------- - ! write data by fields in the datatype. Fields order is not important. - call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i) + mpiOffset,& - int([Nconstituents*dataspace_size(i)],HSIZE_T), hdferr, file_space_id = space_id, & - mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dwrite_f instance_id') +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5pset_all_coll_metadata_ops_f') +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dopen_f') !-------------------------------------------------------------------------------------------------- - !close types, dataspaces - call h5tclose_f(dtype_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f dtype_id') - call h5tclose_f(position_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f position_id') - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dclose_f') - call h5sclose_f(space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sclose_f space_id') - call h5sclose_f(memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sclose_f memspace') - call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pclose_f') - call HDF5_closeGroup(mapping_ID) - - enddo - -end subroutine HDF5_backwardMappingCrystallite +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dget_space_f') !-------------------------------------------------------------------------------------------------- -!> @brief adds the unique cell to node mapping -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_mappingCells(mapping) - use hdf5 - - implicit none - integer(pInt), intent(in), dimension(:) :: mapping - - integer :: hdferr, Nnodes - integer(HID_T) :: mapping_id, dset_id, space_id - - Nnodes=size(mapping) - mapping_ID = HDF5_openGroup("mapping") +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5sselect_hyperslab_f') !-------------------------------------------------------------------------------------------------- -! create dataspace - call h5screate_simple_f(1, int([Nnodes],HSIZE_T), space_id, hdferr, & - int([Nnodes],HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5screate_simple_f') - -!-------------------------------------------------------------------------------------------------- -! create Dataset - call h5dcreate_f(mapping_id, "Cell",H5T_NATIVE_INTEGER, space_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells') - -!-------------------------------------------------------------------------------------------------- -! write data by fields in the datatype. Fields order is not important. - call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, mapping, int([Nnodes],HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5dwrite_f instance_id') +! read + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dread_f') !-------------------------------------------------------------------------------------------------- !close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: plist_id') call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5dclose_f') - call h5sclose_f(space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5sclose_f') - call HDF5_closeGroup(mapping_ID) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal3: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal3: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pReal3 -end subroutine HDF5_mappingCells !-------------------------------------------------------------------------------------------------- -!> @brief creates a new 3D Tensor dataset in the given group location !!!TODO: really necessary? +!> @brief subroutine for reading dataset of type pReal with 4 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_addTensor3DDataset(group,Nnodes,tensorSize,label,SIunit) - use hdf5 +subroutine HDF5_read_pReal4(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(HID_T), intent(in) :: group - integer(pInt), intent(in) :: Nnodes, tensorSize - character(len=*), intent(in) :: SIunit, label + real(pReal), intent(inout), dimension(:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: space_id, dset_id - integer(HSIZE_T), dimension(3) :: dataShape - dataShape = int([tensorSize,tensorSize,Nnodes], HSIZE_T) + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(4) :: myStart + +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + +!------------------------------------------------------------------------------------------------- +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) +!-------------------------------------------------------------------------------------------------- + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(4) +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal4: MPI_allreduce') + endif; endif +#endif + myStart = int([0,0,0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:3),sum(readSize)] + !-------------------------------------------------------------------------------------------------- -! create dataspace - call h5screate_simple_f(3, dataShape, space_id, hdferr, dataShape) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addTensor3DDataset: h5screate_simple_f') +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5pset_all_coll_metadata_ops_f') +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dopen_f') !-------------------------------------------------------------------------------------------------- -! create Dataset - call h5dcreate_f(group, trim(label),H5T_NATIVE_DOUBLE, space_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addTensor3DDataset: h5dcreate_f') - call HDF5_addStringAttribute(dset_id,'unit',trim(SIunit)) +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! read + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dread_f') !-------------------------------------------------------------------------------------------------- !close types, dataspaces - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addTensor3DDataset: h5dclose_f') - call h5sclose_f(space_id, hdferr) - -end subroutine HDF5_addTensor3DDataset - -!-------------------------------------------------------------------------------------------------- -!> @brief creates a new vector dataset in the given group location !!!TODO: really necessary? -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_writeVectorDataset(group,dataset,label,SIunit,dataspace_size,mpiOffset) - use hdf5 - - implicit none - integer(HID_T), intent(in) :: group - character(len=*), intent(in) :: SIunit,label - integer(pInt), intent(in) :: dataspace_size, mpiOffset - real(pReal), intent(in), dimension(:,:) :: dataset - - integer :: hdferr, vectorSize - integer(HID_T) :: dset_id, space_id, memspace, plist_id - - integer(HSIZE_T), dimension(2) :: counter - integer(HSSIZE_T), dimension(2) :: fileOffset - - if(any(shape(dataset) == 0)) return - - vectorSize = size(dataset,1) - - call HDF5_addVectorDataset(group,dataspace_size,vectorSize,label,SIunit) ! here nNodes need to be global - call h5dopen_f(group, label, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5dopen_f') - - ! Define and select hyperslabs - counter(1) = vectorSize ! how big i am - counter(2) = size(dataset,2) - fileOffset(1) = 0 ! where i start to write my data - fileOffset(2) = mpiOffset - - call h5screate_simple_f(2, counter, memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5screate_simple_f') - call h5dget_space_f(dset_id, space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5dget_space_f') - call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5sselect_hyperslab_f') - - ! Create property list for collective dataset write -#ifdef PETSc - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5pcreate_f') - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5pset_dxpl_mpio_f') -#endif - - ! Write the dataset collectively - call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([vectorSize, dataspace_size],HSIZE_T), hdferr, & - file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5dwrite_f') - - call h5sclose_f(space_id, hdferr) - call h5sclose_f(memspace, hdferr) - call h5dclose_f(dset_id, hdferr) call h5pclose_f(plist_id, hdferr) - -end subroutine HDF5_writeVectorDataset - -!-------------------------------------------------------------------------------------------------- -!> @brief creates a new tensor dataset in the given group location -! by default, a 3x3 tensor is assumed !!!TODO: really necessary? -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_writeTensorDataset(group,dataset,label,SIunit,dataspace_size,mpiOffset) - use hdf5 - - implicit none - integer(HID_T), intent(in) :: group - character(len=*), intent(in) :: SIunit,label - integer(pInt), intent(in) :: dataspace_size, mpiOffset - real(pReal), intent(in), dimension(:,:,:) :: dataset - - integer :: hdferr, tensorSize - integer(HID_T) :: dset_id, space_id, memspace, plist_id - - integer(HSIZE_T), dimension(3) :: counter - integer(HSSIZE_T), dimension(3) :: fileOffset - - if(any(shape(dataset) == 0)) return - - tensorSize = size(dataset,1) - - call HDF5_addTensor3DDataset(group,dataspace_size,tensorSize,label,SIunit) - call h5dopen_f(group, label, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5dopen_f') - - ! Define and select hyperslabs - counter(1) = tensorSize ! how big i am - counter(2) = tensorSize - counter(3) = size(dataset,3) - fileOffset(1) = 0 ! where i start to write my data - fileOffset(2) = 0 - fileOffset(3) = mpiOffset - - call h5screate_simple_f(3, counter, memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5screate_simple_f') - call h5dget_space_f(dset_id, space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5dget_space_f') - call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5sselect_hyperslab_f') - - ! Create property list for collective dataset write -#ifdef PETSc - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5pcreate_f') - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5pset_dxpl_mpio_f') -#endif - - ! Write the dataset collectively - call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([tensorSize, dataspace_size],HSIZE_T), hdferr, & - file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5dwrite_f') - - call h5sclose_f(space_id, hdferr) - call h5sclose_f(memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: plist_id') call h5dclose_f(dset_id, hdferr) - call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal4: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal4: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pReal4 - end subroutine HDF5_writeTensorDataset !-------------------------------------------------------------------------------------------------- -!> @brief adds a new vector dataset to the given group location +!> @brief subroutine for reading dataset of type pReal with 5 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_addVectorDataset(group,nnodes,vectorSize,label,SIunit) - use hdf5 +subroutine HDF5_read_pReal5(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(HID_T), intent(in) :: group - integer(pInt), intent(in) :: nnodes,vectorSize - character(len=*), intent(in) :: SIunit,label + real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel + + + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(5) :: myStart + +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + +!------------------------------------------------------------------------------------------------- +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) +!-------------------------------------------------------------------------------------------------- + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(5) +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal5: MPI_allreduce') + endif; endif +#endif + myStart = int([0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:4),sum(readSize)] - integer :: hdferr - integer(HID_T) :: space_id, dset_id !-------------------------------------------------------------------------------------------------- -! create dataspace - call h5screate_simple_f(2, int([vectorSize,Nnodes],HSIZE_T), space_id, hdferr, & - int([vectorSize,Nnodes],HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addVectorDataset: h5screate_simple_f') +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5pset_all_coll_metadata_ops_f') +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dopen_f') !-------------------------------------------------------------------------------------------------- -! create Dataset - call h5dcreate_f(group, trim(label), H5T_NATIVE_DOUBLE, space_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addVectorDataset: h5dcreate_f') - call HDF5_addStringAttribute(dset_id,'unit',trim(SIunit)) +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! read + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dread_f') !-------------------------------------------------------------------------------------------------- !close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: plist_id') call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addVectorDataset: h5dclose_f') - call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal5: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal5: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pReal5 -end subroutine HDF5_addVectorDataset !-------------------------------------------------------------------------------------------------- -!> @brief writes to a new scalar dataset in the given group location +!> @brief subroutine for reading dataset of type pReal with 6 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_writeScalarDataset(group,dataset,label,SIunit,dataspace_size,mpiOffset) - use hdf5 +subroutine HDF5_read_pReal6(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(HID_T), intent(in) :: group - character(len=*), intent(in) :: SIunit,label - integer(pInt), intent(in) :: dataspace_size, mpiOffset - real(pReal), intent(in), dimension(:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr, nNodes - integer(HID_T) :: dset_id, space_id, memspace, plist_id - integer(HSIZE_T), dimension(1) :: counter - integer(HSIZE_T), dimension(1) :: fileOffset + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(6) :: myStart - nNodes = size(dataset) - if (nNodes < 1) return +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return - call HDF5_addScalarDataset(group,dataspace_size,label,SIunit) - call h5dopen_f(group, label, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5dopen_f') - - ! Define and select hyperslabs - counter = size(dataset) ! how big i am - fileOffset = mpiOffset ! where i start to write my data - - call h5screate_simple_f(1, counter, memspace, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5screate_simple_f') - call h5dget_space_f(dset_id, space_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5dget_space_f') - call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5sselect_hyperslab_f') - - ! Create property list for collective dataset write -#ifdef PETSc +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5pcreate_f') - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5pset_dxpl_mpio_f') + +!------------------------------------------------------------------------------------------------- +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) +!-------------------------------------------------------------------------------------------------- + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(6) +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal6: MPI_allreduce') + endif; endif +#endif + myStart = int([0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:5),sum(readSize)] + + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5pset_all_coll_metadata_ops_f') +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! read + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dread_f') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal6: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal6: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pReal6 + + +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for reading dataset of type pReal with 7 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_read_pReal7(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize + + implicit none + real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel + + + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(7) :: myStart + +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + +!------------------------------------------------------------------------------------------------- +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) +!-------------------------------------------------------------------------------------------------- + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(7) +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pReal7: MPI_allreduce') + endif; endif +#endif + myStart = int([0,0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:6),sum(readSize)] + + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5pset_all_coll_metadata_ops_f') +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! read + call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(globalShape,HSIZE_T), hdferr,& + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dread_f') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pReal7: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal7: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pReal7 + + +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for reading dataset of type pInt with 1 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_read_pInt1(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize + + implicit none + integer(pInt), intent(inout), dimension(:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel + + + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(1) :: myStart + +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + +!-------------------------------------------------------------------------------------------------- +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) +!-------------------------------------------------------------------------------------------------- + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(1) + +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt1: MPI_allreduce') + endif; endif #endif - ! Write the dataset collectively - call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([dataspace_size],HSIZE_T), hdferr, & - file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5dwrite_f') + myStart = int([sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:0),sum(readSize)] - call h5sclose_f(space_id, hdferr) - call h5sclose_f(memspace, hdferr) - call h5dclose_f(dset_id, hdferr) +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5pset_all_coll_metadata_ops_f') + +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! read + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dread_f') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt1: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pInt1 -end subroutine HDF5_writeScalarDataset !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pReal with 1 dimension +!> @brief subroutine for reading dataset of type pInt with 2 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pReal_1(dataset,loc_id,datasetName) +subroutine HDF5_read_pInt2(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:) :: dataset + integer(pInt), intent(inout), dimension(:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) + logical, intent(in), optional :: parallel - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape1: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_DOUBLE,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape1: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape1: h5dclose_f') -end subroutine HDF5_read_pReal_1 + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(2) :: myStart + +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pReal with 2 dimensions +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pReal_2(dataset,loc_id,datasetName) + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(2) + +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt2: MPI_allreduce') + endif; endif +#endif + + myStart = int([0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:1),sum(readSize)] + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5pset_all_coll_metadata_ops_f') + +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! read + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dread_f') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt2: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pInt2 + + +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for reading dataset of type pInt with 3 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_read_pInt3(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape2: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_DOUBLE,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape2: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape2: h5dclose_f') + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(3) :: myStart -end subroutine HDF5_read_pReal_2 +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pReal with 3 dimensions +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pReal_3(dataset,loc_id,datasetName) + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(3) + +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt3: MPI_allreduce') + endif; endif +#endif + + myStart = int([0,0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:2),sum(readSize)] + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5pset_all_coll_metadata_ops_f') + +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! read + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dread_f') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt3: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pInt3 + + +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for reading dataset of type pInt with 4 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_read_pInt4(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) + logical, intent(in), optional :: parallel - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape3: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_DOUBLE,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape3: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape3: h5dclose_f') -end subroutine HDF5_read_pReal_3 + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(4) :: myStart + +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pReal with 4 dimensions +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pReal_4(dataset,loc_id,datasetName) + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(4) + +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt4: MPI_allreduce') + endif; endif +#endif + + myStart = int([0,0,0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:3),sum(readSize)] + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5pset_all_coll_metadata_ops_f') + +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! read + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dread_f') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt4: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pInt4 + + +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for reading dataset of type pInt with 5 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_read_pInt5(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape4: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_DOUBLE,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape4: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape4: h5dclose_f') + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(5) :: myStart -end subroutine HDF5_read_pReal_4 +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pReal with 5 dimensions +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pReal_5(dataset,loc_id,datasetName) + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(5) + +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt5: MPI_allreduce') + endif; endif +#endif + + myStart = int([0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:4),sum(readSize)] + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5pset_all_coll_metadata_ops_f') + +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! read + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dread_f') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt5: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pInt5 + + +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for reading dataset of type pInt with 6 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_read_pInt6(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape5: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_DOUBLE,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape5: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape5: h5dclose_f') + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(6) :: myStart -end subroutine HDF5_read_pReal_5 +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pReal with 6 dimensions +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pReal_6(dataset,loc_id,datasetName) + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(6) + +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt6: MPI_allreduce') + endif; endif +#endif + + myStart = int([0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:5),sum(readSize)] + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5pset_all_coll_metadata_ops_f') + +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! read + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dread_f') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt6: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pInt6 + + +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for reading dataset of type pInt with 7 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_read_pInt7(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:,:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape6: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_DOUBLE,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape6: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape6: h5dclose_f') + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + readSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id + integer(HSIZE_T), dimension(7) :: myStart -end subroutine HDF5_read_pReal_6 +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pReal with 7 dimensions +! creating a property list for data access properties + call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) !-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pReal_7(dataset,loc_id,datasetName) + allocate(readSize(worldsize), source = 0_pInt) + readSize(worldrank+1) = localShape(7) + +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_read_pInt7: MPI_allreduce') + endif; endif +#endif + + myStart = int([0,0,0,0,0,0,sum(readSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:6),sum(readSize)] + +!-------------------------------------------------------------------------------------------------- +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt{}: h5screate_simple_f/memspace_id') +!-------------------------------------------------------------------------------------------------- +! set I/O mode for read operations to collective + call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5pset_all_coll_metadata_ops_f') + +!-------------------------------------------------------------------------------------------------- +! open the dataset in the file + call h5dopen_f(loc_id,datasetName,dset_id,hdferr,dapl_id = aplist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dopen_f') + +!-------------------------------------------------------------------------------------------------- +! get the space_id of dataset in the file + call h5dget_space_f(dset_id, filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dget_space_f') + +!-------------------------------------------------------------------------------------------------- +! select a hyperslab (the portion of the current process) in the file + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, int(localShape,HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! read + call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(globalShape,HSIZE_T), hdferr, & + file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dread_f') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: plist_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5dclose_f') + call h5sclose_f(filespace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5sclose_f/filespace_id') + call h5sclose_f(memspace_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_read_pInt7: h5sclose_f/memspace_id') + +end subroutine HDF5_read_pInt7 + +!-------------------------------------------------------------------------------------------------- +!> @brief subroutine for writing dataset of type pReal with 1 dimensions +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_write_pReal1(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:,:,:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape7: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_DOUBLE,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape7: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pReal_shape7: h5dclose_f') + integer(pInt), dimension(:), allocatable :: & + globalShape, & !< shape of the dataset (all processes) + localShape, & !< shape of the dataset (this process) + outputSize !< contribution of all processes + integer :: ierr + integer(HDF5_ERR_TYPE) :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(1) :: myStart -end subroutine HDF5_read_pReal_7 +!------------------------------------------------------------------------------------------------- +! determine shape of dataset + localShape = shape(dataset) + if (any(localShape(1:size(localShape)) == 0)) return + +!------------------------------------------------------------------------------------------------- +! creating a property list for transfer properties + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pInt with 1 dimension -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pInt_1(dataset,loc_id,datasetName) + allocate(outputSize(worldsize), source = 0_pInt) + outputSize(worldrank+1) = localShape(1) - implicit none - integer(pInt), intent(out), dimension(:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape +#ifdef PETSc + if (present(parallel)) then; if (parallel) then + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5pset_dxpl_mpio_f') + call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process + if (ierr /= 0) call IO_error(894_pInt,ext_msg='HDF5_write_pReal1: MPI_allreduce') + endif; endif +#endif - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) + myStart = int([sum(outputSize(1:worldrank))],HSIZE_T) + globalShape = [localShape(1:0),sum(outputSize)] - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape1: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_INTEGER,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape1: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape1: h5dclose_f') - -end subroutine HDF5_read_pInt_1 !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pInt with 2 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pInt_2(dataset,loc_id,datasetName) - - implicit none - integer(pInt), intent(out), dimension(:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape - - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) - - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape2: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_INTEGER,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape2: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape2: h5dclose_f') - -end subroutine HDF5_read_pInt_2 +! create dataspace in memory (local shape) + call h5screate_simple_f(size(localShape), int(localShape,HSIZE_T), memspace_id, hdferr, & + int(localShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dopen_f') !-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pInt with 3 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pInt_3(dataset,loc_id,datasetName) +! create dataspace in file (global shape) + call h5screate_simple_f(size(globalShape), int(globalShape,HSIZE_T), filespace_id, hdferr, & + int(globalShape,HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_write_pReal1: h5dget_space_f') - implicit none - integer(pInt), intent(out), dimension(:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape - - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) - - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape3: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_INTEGER,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape3: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape3: h5dclose_f') - -end subroutine HDF5_read_pInt_3 - -!-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pInt with 4 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pInt_4(dataset,loc_id,datasetName) - - implicit none - integer(pInt), intent(out), dimension(:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape - - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) - - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape4: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_INTEGER,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape4: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape4: h5dclose_f') - -end subroutine HDF5_read_pInt_4 - -!-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pInt with 5 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pInt_5(dataset,loc_id,datasetName) - - implicit none - integer(pInt), intent(out), dimension(:,:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape - - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) - - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape5: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_INTEGER,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape5: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape5: h5dclose_f') - -end subroutine HDF5_read_pInt_5 - -!-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pInt with 6 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pInt_6(dataset,loc_id,datasetName) - - implicit none - integer(pInt), intent(out), dimension(:,:,:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape - - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) - - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape6: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_INTEGER,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape6: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape6: h5dclose_f') - -end subroutine HDF5_read_pInt_6 - -!-------------------------------------------------------------------------------------------------- -!> @brief subroutine for reading dataset of the type pInt with 7 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_read_pInt_7(dataset,loc_id,datasetName) - - implicit none - integer(pInt), intent(out), dimension(:,:,:,:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - integer(pInt),dimension(:), allocatable :: myShape - - integer :: hdferr - integer(HID_T) :: dset_id - myShape = shape(dataset) - - call h5dopen_f(loc_id,datasetName,dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape7: h5dopen_f') - call h5dread_f(dset_id,H5T_NATIVE_INTEGER,dataset,int(myShape,HSIZE_T),hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape7: h5dread_f') - call h5dclose_f(dset_id,hdferr) - if (hdferr /= 0) call IO_error(0_pInt,ext_msg='HDF5_read_pInt__shape7: h5dclose_f') - -end subroutine HDF5_read_pInt_7 - -!-------------------------------------------------------------------------------------------------- -!> @brief subroutine for writing dataset of the type pReal with 1 dimensions -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pReal1(dataset,loc_id,datasetName) - - implicit none - real(pReal), intent(out), dimension(:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pReal with 2 dimensions +!> @brief subroutine for writing dataset of type pReal with 2 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pReal2(dataset,loc_id,datasetName) +subroutine HDF5_write_pReal2(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:) :: dataset + real(pReal), intent(inout), dimension(:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pReal with 3 dimensions +!> @brief subroutine for writing dataset of type pReal with 3 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pReal3(dataset,loc_id,datasetName) +subroutine HDF5_write_pReal3(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pReal with 4 dimensions +!> @brief subroutine for writing dataset of type pReal with 4 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pReal4(dataset,loc_id,datasetName) +subroutine HDF5_write_pReal4(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pReal with 5 dimensions +!> @brief subroutine for writing dataset of type pReal with 5 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pReal5(dataset,loc_id,datasetName) +subroutine HDF5_write_pReal5(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pReal with 6 dimensions +!> @brief subroutine for writing dataset of type pReal with 6 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pReal6(dataset,loc_id,datasetName) +subroutine HDF5_write_pReal6(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:,:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pReal with 7 dimensions +!> @brief subroutine for writing dataset of type pReal with 7 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pReal7(dataset,loc_id,datasetName) +subroutine HDF5_write_pReal7(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - real(pReal), intent(out), dimension(:,:,:,:,:,:,:) :: dataset + real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pInt with 1 dimensions +!> @brief subroutine for writing dataset of type pInt with 1 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pInt1(dataset,loc_id,datasetName) +subroutine HDF5_write_pInt1(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(pInt), intent(out), dimension(:) :: dataset + integer(pInt), intent(inout), dimension(:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pInt with 2 dimensions +!> @brief subroutine for writing dataset of type pInt with 2 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pInt2(dataset,loc_id,datasetName) +subroutine HDF5_write_pInt2(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(pInt), intent(out), dimension(:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pInt with 3 dimensions +!> @brief subroutine for writing dataset of type pInt with 3 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pInt3(dataset,loc_id,datasetName) +subroutine HDF5_write_pInt3(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(pInt), intent(out), dimension(:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pInt with 4 dimensions +!> @brief subroutine for writing dataset of type pInt with 4 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pInt4(dataset,loc_id,datasetName) +subroutine HDF5_write_pInt4(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(pInt), intent(out), dimension(:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pInt with 5 dimensions +!> @brief subroutine for writing dataset of type pInt with 5 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pInt5(dataset,loc_id,datasetName) +subroutine HDF5_write_pInt5(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(pInt), intent(out), dimension(:,:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pInt with 6 dimensions +!> @brief subroutine for writing dataset of type pInt with 6 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pInt6(dataset,loc_id,datasetName) +subroutine HDF5_write_pInt6(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(pInt), intent(out), dimension(:,:,:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief subroutine for writing dataset of the type pInt with 7 dimensions +!> @brief subroutine for writing dataset of type pInt with 7 dimensions !-------------------------------------------------------------------------------------------------- -subroutine HDF5_write_pInt7(dataset,loc_id,datasetName) +subroutine HDF5_write_pInt7(loc_id,dataset,datasetName,parallel) + use numerics, only: & + worldrank, & + worldsize implicit none - integer(pInt), intent(out), dimension(:,:,:,:,:,:,:) :: dataset + integer(pInt), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer(pInt), dimension(:), allocatable :: myShape ! @brief adds a new scalar dataset to the given group location -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_addScalarDataset(group,nnodes,label,SIunit) - use hdf5 - implicit none - integer(HID_T), intent(in) :: group - integer(pInt), intent(in) :: nnodes - character(len=*), intent(in) :: SIunit,label +end module HDF5_Utilities + + + + + - integer :: hdferr - integer(HID_T) :: space_id, dset_id -!-------------------------------------------------------------------------------------------------- -! create dataspace - call h5screate_simple_f(1, int([Nnodes],HSIZE_T), space_id, hdferr, & - int([Nnodes],HSIZE_T)) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addScalarDataset: h5screate_simple_f') -!-------------------------------------------------------------------------------------------------- -! create Dataset - call h5dcreate_f(group, trim(label),H5T_NATIVE_DOUBLE, space_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addScalarDataset: h5dcreate_f') - call HDF5_addStringAttribute(dset_id,'unit',trim(SIunit)) -!-------------------------------------------------------------------------------------------------- -!close types, dataspaces - call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addScalarDataset: h5dclose_f') - call h5sclose_f(space_id, hdferr) -end subroutine HDF5_addScalarDataset -!-------------------------------------------------------------------------------------------------- -!> @brief copies the current temp results to the actual results file -!-------------------------------------------------------------------------------------------------- -subroutine HDF5_forwardResults(time) - use hdf5 - use IO, only: & - IO_intOut - implicit none - integer :: hdferr - integer(HID_T) :: currentIncID - real(pReal), intent(in) :: time - character(len=1024) :: myName - currentInc = currentInc +1_pInt - write(6,*) 'forward results';flush(6) - write(myName,'(a,'//IO_intOut(currentInc)//')') 'inc',currentInc - currentIncID = HDF5_addGroup(myName) - call HDF5_setLink(myName,'current') -! call HDF5_flush(resultsFile) - call HDF5_closeGroup(currentIncID) -end subroutine HDF5_forwardResults -end module HDF5_Utilities \ No newline at end of file diff --git a/src/IO.f90 b/src/IO.f90 index af59b11b9..193580fcc 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -1251,6 +1251,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'negative number systems requested' case (145_pInt) msg = 'too many systems requested' + case (146_pInt) + msg = 'number of values does not match' !-------------------------------------------------------------------------------------------------- ! material error messages and related messages in mesh diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 36f0244ef..4feb52bed 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -4,12 +4,12 @@ !> @details List of files needed by MSC.Marc, Abaqus/Explicit, and Abaqus/Standard !-------------------------------------------------------------------------------------------------- #include "IO.f90" -#ifdef DAMASKHDF5 -#include "HDF5_utilities.f90" -#endif #include "numerics.f90" #include "debug.f90" #include "config.f90" +#ifdef DAMASKHDF5 +#include "HDF5_utilities.f90" +#endif #include "math.f90" #include "FEsolving.f90" #include "mesh.f90" @@ -21,14 +21,9 @@ #include "source_damage_isoDuctile.f90" #include "source_damage_anisoBrittle.f90" #include "source_damage_anisoDuctile.f90" -#include "source_vacancy_phenoplasticity.f90" -#include "source_vacancy_irradiation.f90" -#include "source_vacancy_thermalfluc.f90" #include "kinematics_cleavage_opening.f90" #include "kinematics_slipplane_opening.f90" #include "kinematics_thermal_expansion.f90" -#include "kinematics_vacancy_strain.f90" -#include "kinematics_hydrogen_strain.f90" #include "plastic_none.f90" #include "plastic_isotropic.f90" #include "plastic_phenopowerlaw.f90" @@ -47,12 +42,5 @@ #include "damage_none.f90" #include "damage_local.f90" #include "damage_nonlocal.f90" -#include "vacancyflux_isoconc.f90" -#include "vacancyflux_isochempot.f90" -#include "vacancyflux_cahnhilliard.f90" -#include "porosity_none.f90" -#include "porosity_phasefield.f90" -#include "hydrogenflux_isoconc.f90" -#include "hydrogenflux_cahnhilliard.f90" #include "homogenization.f90" #include "CPFEM.f90" diff --git a/src/config.f90 b/src/config.f90 index 441dd953c..b79442e62 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -1,4 +1,4 @@ -!-------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- !> @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 @@ -220,7 +220,7 @@ subroutine parseFile(sectionNames,part,line, & partPosition = [partPosition, i] ! needed when actually storing content do i = 1_pInt, size(partPosition) -1_pInt - sectionNames(i) = trim(adjustl(fileContent(partPosition(i)))) + sectionNames(i) = trim(adjustl(IO_getTag(fileContent(partPosition(i)),'[',']'))) do j = partPosition(i) + 1_pInt, partPosition(i+1) -1_pInt call part(i)%add(trim(adjustl(fileContent(j)))) enddo @@ -318,7 +318,7 @@ subroutine show(this) do while (associated(item%next)) write(6,'(a)') ' '//trim(item%string%val) item => item%next - end do + enddo end subroutine show @@ -391,7 +391,7 @@ logical function keyExists(this,key) do while (associated(item%next) .and. .not. keyExists) keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) item => item%next - end do + enddo end function keyExists @@ -417,7 +417,7 @@ integer(pInt) function countKeys(this,key) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) & countKeys = countKeys + 1_pInt item => item%next - end do + enddo end function countKeys @@ -451,7 +451,7 @@ real(pReal) function getFloat(this,key,defaultVal) getFloat = IO_FloatValue(item%string%val,item%string%pos,2) endif item => item%next - end do + enddo if (.not. found) call IO_error(140_pInt,ext_msg=key) @@ -487,7 +487,7 @@ integer(pInt) function getInt(this,key,defaultVal) getInt = IO_IntValue(item%string%val,item%string%pos,2) endif item => item%next - end do + enddo if (.not. found) call IO_error(140_pInt,ext_msg=key) @@ -538,7 +538,7 @@ character(len=65536) function getString(this,key,defaultVal,raw) endif endif item => item%next - end do + enddo if (.not. found) call IO_error(140_pInt,ext_msg=key) @@ -550,7 +550,7 @@ end function getString !> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all !! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- -function getFloats(this,key,defaultVal,requiredShape) +function getFloats(this,key,defaultVal,requiredShape,requiredSize) use IO, only: & IO_error, & IO_stringValue, & @@ -561,7 +561,8 @@ function getFloats(this,key,defaultVal,requiredShape) class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key real(pReal), dimension(:), intent(in), optional :: defaultVal - integer(pInt), dimension(:), intent(in), optional :: requiredShape + integer(pInt), dimension(:), intent(in), optional :: requiredShape ! not useful (is always 1D array) + integer(pInt), intent(in), optional :: requiredSize type(tPartitionedStringList), pointer :: item integer(pInt) :: i logical :: found, & @@ -583,11 +584,14 @@ function getFloats(this,key,defaultVal,requiredShape) enddo endif item => item%next - end do + enddo if (.not. found) then if (present(defaultVal)) then; getFloats = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif endif + if (present(requiredSize)) then + if(requiredSize /= size(getFloats)) call IO_error(146,ext_msg=key) + endif end function getFloats @@ -597,7 +601,7 @@ end function getFloats !> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all !! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- -function getInts(this,key,defaultVal,requiredShape) +function getInts(this,key,defaultVal,requiredShape,requiredSize) use IO, only: & IO_error, & IO_stringValue, & @@ -608,7 +612,8 @@ function getInts(this,key,defaultVal,requiredShape) class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key integer(pInt), dimension(:), intent(in), optional :: defaultVal, & - requiredShape + requiredShape ! not useful (is always 1D array) + integer(pInt), intent(in), optional :: requiredSize type(tPartitionedStringList), pointer :: item integer(pInt) :: i logical :: found, & @@ -630,11 +635,14 @@ function getInts(this,key,defaultVal,requiredShape) enddo endif item => item%next - end do + enddo if (.not. found) then if (present(defaultVal)) then; getInts = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif endif + if (present(requiredSize)) then + if(requiredSize /= size(getInts)) call IO_error(146,ext_msg=key) + endif end function getInts @@ -704,7 +712,7 @@ function getStrings(this,key,defaultVal,requiredShape,raw) endif notAllocated endif item => item%next - end do + enddo if (.not. found) then if (present(defaultVal)) then; getStrings = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 8294047e7..ccaf01c33 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -25,7 +25,8 @@ module constitutive constitutive_SandItsTangents, & constitutive_collectDotState, & constitutive_collectDeltaState, & - constitutive_postResults + constitutive_postResults, & + constitutive_results private :: & constitutive_hooke_SandItsTangents @@ -88,14 +89,9 @@ subroutine constitutive_init() SOURCE_damage_isoDuctile_ID, & SOURCE_damage_anisoBrittle_ID, & SOURCE_damage_anisoDuctile_ID, & - SOURCE_vacancy_phenoplasticity_ID, & - SOURCE_vacancy_irradiation_ID, & - SOURCE_vacancy_thermalfluc_ID, & KINEMATICS_cleavage_opening_ID, & KINEMATICS_slipplane_opening_ID, & KINEMATICS_thermal_expansion_ID, & - KINEMATICS_vacancy_strain_ID, & - KINEMATICS_hydrogen_strain_ID, & ELASTICITY_HOOKE_label, & PLASTICITY_NONE_label, & PLASTICITY_ISOTROPIC_label, & @@ -110,9 +106,6 @@ subroutine constitutive_init() SOURCE_damage_isoDuctile_label, & SOURCE_damage_anisoBrittle_label, & SOURCE_damage_anisoDuctile_label, & - SOURCE_vacancy_phenoplasticity_label, & - SOURCE_vacancy_irradiation_label, & - SOURCE_vacancy_thermalfluc_label, & plasticState, & sourceState @@ -129,14 +122,9 @@ subroutine constitutive_init() use source_damage_isoDuctile use source_damage_anisoBrittle use source_damage_anisoDuctile - use source_vacancy_phenoplasticity - use source_vacancy_irradiation - use source_vacancy_thermalfluc use kinematics_cleavage_opening use kinematics_slipplane_opening use kinematics_thermal_expansion - use kinematics_vacancy_strain - use kinematics_hydrogen_strain implicit none integer(pInt), parameter :: FILEUNIT = 204_pInt @@ -162,7 +150,7 @@ subroutine constitutive_init() if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init - if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then @@ -179,9 +167,6 @@ subroutine constitutive_init() if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init(FILEUNIT) if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init(FILEUNIT) if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init(FILEUNIT) - if (any(phase_source == SOURCE_vacancy_phenoplasticity_ID)) call source_vacancy_phenoplasticity_init(FILEUNIT) - if (any(phase_source == SOURCE_vacancy_irradiation_ID)) call source_vacancy_irradiation_init(FILEUNIT) - if (any(phase_source == SOURCE_vacancy_thermalfluc_ID)) call source_vacancy_thermalfluc_init(FILEUNIT) !-------------------------------------------------------------------------------------------------- ! parse kinematic mechanisms from config file @@ -189,8 +174,6 @@ subroutine constitutive_init() if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init(FILEUNIT) if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init(FILEUNIT) if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init(FILEUNIT) - if (any(phase_kinematics == KINEMATICS_vacancy_strain_ID)) call kinematics_vacancy_strain_init(FILEUNIT) - if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) close(FILEUNIT) call config_deallocate('material.config/phase') @@ -283,21 +266,6 @@ subroutine constitutive_init() outputName = SOURCE_damage_anisoDuctile_label thisOutput => source_damage_anisoDuctile_output thisSize => source_damage_anisoDuctile_sizePostResult - case (SOURCE_vacancy_phenoplasticity_ID) sourceType - ins = source_vacancy_phenoplasticity_instance(ph) - outputName = SOURCE_vacancy_phenoplasticity_label - thisOutput => source_vacancy_phenoplasticity_output - thisSize => source_vacancy_phenoplasticity_sizePostResult - case (SOURCE_vacancy_irradiation_ID) sourceType - ins = source_vacancy_irradiation_instance(ph) - outputName = SOURCE_vacancy_irradiation_label - thisOutput => source_vacancy_irradiation_output - thisSize => source_vacancy_irradiation_sizePostResult - case (SOURCE_vacancy_thermalfluc_ID) sourceType - ins = source_vacancy_thermalfluc_instance(ph) - outputName = SOURCE_vacancy_thermalfluc_label - thisOutput => source_vacancy_thermalfluc_output - thisSize => source_vacancy_thermalfluc_sizePostResult case default sourceType knownSource = .false. end select sourceType @@ -512,8 +480,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e dLp_dMp = 0.0_pReal case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp),ipc,ip,el) - dLp_dMp = math_Plain99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType of = phasememberAt(ipc,ip,el) @@ -521,8 +490,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp),ipc,ip,el) - dLp_dMp = math_Plain99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp, Mp,instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp), & @@ -560,6 +530,7 @@ end subroutine constitutive_LpAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient +! ToDo: MD: S is Mi? !-------------------------------------------------------------------------------------------------- subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, el) use prec, only: & @@ -568,8 +539,12 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e math_I3, & math_inv33, & math_det33, & - math_mul33x33 + math_mul33x33, & + math_Mandel6to33 use material, only: & + phasememberAt, & + phase_plasticity, & + phase_plasticityInstance, & phase_plasticity, & material_phase, & phase_kinematics, & @@ -577,9 +552,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e PLASTICITY_isotropic_ID, & KINEMATICS_cleavage_opening_ID, & KINEMATICS_slipplane_opening_ID, & - KINEMATICS_thermal_expansion_ID, & - KINEMATICS_vacancy_strain_ID, & - KINEMATICS_hydrogen_strain_ID + KINEMATICS_thermal_expansion_ID use plastic_isotropic, only: & plastic_isotropic_LiAndItsTangent use kinematics_cleavage_opening, only: & @@ -588,10 +561,6 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e kinematics_slipplane_opening_LiAndItsTangent use kinematics_thermal_expansion, only: & kinematics_thermal_expansion_LiAndItsTangent - use kinematics_vacancy_strain, only: & - kinematics_vacancy_strain_LiAndItsTangent - use kinematics_hydrogen_strain, only: & - kinematics_hydrogen_strain_LiAndItsTangent implicit none integer(pInt), intent(in) :: & @@ -607,19 +576,18 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e real(pReal), intent(out), dimension(3,3,3,3) :: & dLi_dS, & !< derivative of Li with respect to S dLi_dFi + real(pReal), dimension(3,3) :: & - my_Li !< intermediate velocity gradient - real(pReal), dimension(3,3,3,3) :: & - my_dLi_dS - real(pReal), dimension(3,3) :: & + my_Li, & !< intermediate velocity gradient FiInv, & temp_33 + real(pReal), dimension(3,3,3,3) :: & + my_dLi_dS real(pReal) :: & detFi integer(pInt) :: & - k !< counter in kinematics loop - integer(pInt) :: & - i, j + k, i, j, & + instance, of Li = 0.0_pReal dLi_dS = 0.0_pReal @@ -627,7 +595,9 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_isotropic_ID) plasticityType - call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el) + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, math_Mandel6to33(S6),instance,of) case default plasticityType my_Li = 0.0_pReal my_dLi_dS = 0.0_pReal @@ -644,10 +614,6 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el) case (KINEMATICS_thermal_expansion_ID) kinematicsType call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el) - case (KINEMATICS_vacancy_strain_ID) kinematicsType - call kinematics_vacancy_strain_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el) - case (KINEMATICS_hydrogen_strain_ID) kinematicsType - call kinematics_hydrogen_strain_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el) case default kinematicsType my_Li = 0.0_pReal my_dLi_dS = 0.0_pReal @@ -684,15 +650,9 @@ pure function constitutive_initialFi(ipc, ip, el) phase_kinematics, & phase_Nkinematics, & material_phase, & - KINEMATICS_thermal_expansion_ID, & - KINEMATICS_vacancy_strain_ID, & - KINEMATICS_hydrogen_strain_ID + KINEMATICS_thermal_expansion_ID use kinematics_thermal_expansion, only: & kinematics_thermal_expansion_initialStrain - use kinematics_vacancy_strain, only: & - kinematics_vacancy_strain_initialStrain - use kinematics_hydrogen_strain, only: & - kinematics_hydrogen_strain_initialStrain implicit none integer(pInt), intent(in) :: & @@ -711,12 +671,6 @@ pure function constitutive_initialFi(ipc, ip, el) case (KINEMATICS_thermal_expansion_ID) kinematicsType constitutive_initialFi = & constitutive_initialFi + kinematics_thermal_expansion_initialStrain(ipc, ip, el) - case (KINEMATICS_vacancy_strain_ID) kinematicsType - constitutive_initialFi = & - constitutive_initialFi + kinematics_vacancy_strain_initialStrain(ipc, ip, el) - case (KINEMATICS_hydrogen_strain_ID) kinematicsType - constitutive_initialFi = & - constitutive_initialFi + kinematics_hydrogen_strain_initialStrain(ipc, ip, el) end select kinematicsType enddo KinematicsLoop @@ -771,10 +725,7 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip phase_stiffnessDegradation, & damage, & damageMapping, & - porosity, & - porosityMapping, & - STIFFNESS_DEGRADATION_damage_ID, & - STIFFNESS_DEGRADATION_porosity_ID + STIFFNESS_DEGRADATION_damage_ID implicit none integer(pInt), intent(in) :: & @@ -804,8 +755,6 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip degradationType: select case(phase_stiffnessDegradation(d,material_phase(ipc,ip,el))) case (STIFFNESS_DEGRADATION_damage_ID) degradationType C = C * damage(ho)%p(damageMapping(ho)%p(ip,el))**2_pInt - case (STIFFNESS_DEGRADATION_porosity_ID) degradationType - C = C * porosity(ho)%p(porosityMapping(ho)%p(ip,el))**2_pInt end select degradationType enddo DegradationLoop @@ -916,7 +865,9 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_dotState (math_Mandel33to6(Mp),ipc,ip,el) + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_isotropic_dotState (Mp,instance,of) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType of = phasememberAt(ipc,ip,el) @@ -924,7 +875,9 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac call plastic_phenopowerlaw_dotState(Mp,instance,of) case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_dotState(math_Mandel33to6(Mp),ipc,ip,el) + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_kinehardening_dotState(Mp,instance,of) case (PLASTICITY_DISLOTWIN_ID) plasticityType of = phasememberAt(ipc,ip,el) @@ -980,25 +933,21 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el) math_Mandel33to6, & math_mul33x33 use material, only: & + phasememberAt, & + phase_plasticityInstance, & phase_plasticity, & phase_source, & phase_Nsources, & material_phase, & PLASTICITY_KINEHARDENING_ID, & PLASTICITY_NONLOCAL_ID, & - SOURCE_damage_isoBrittle_ID, & - SOURCE_vacancy_irradiation_ID, & - SOURCE_vacancy_thermalfluc_ID + SOURCE_damage_isoBrittle_ID use plastic_kinehardening, only: & plastic_kinehardening_deltaState use plastic_nonlocal, only: & plastic_nonlocal_deltaState use source_damage_isoBrittle, only: & source_damage_isoBrittle_deltaState - use source_vacancy_irradiation, only: & - source_vacancy_irradiation_deltaState - use source_vacancy_thermalfluc, only: & - source_vacancy_thermalfluc_deltaState implicit none integer(pInt), intent(in) :: & @@ -1011,19 +960,22 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el) Fe, & !< elastic deformation gradient Fi !< intermediate deformation gradient real(pReal), dimension(3,3) :: & - Mstar + Mp integer(pInt) :: & - s !< counter in source loop + s, & !< counter in source loop + instance, of - Mstar = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6)) + Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6)) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_deltaState(math_Mandel33to6(Mstar),ipc,ip,el) + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_kinehardening_deltaState(Mp,instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_deltaState(math_Mandel33to6(Mstar),ip,el) + call plastic_nonlocal_deltaState(math_Mandel33to6(Mp),ip,el) end select plasticityType @@ -1035,12 +987,6 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el) call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(ipc,ip,el), Fe, & ipc, ip, el) - case (SOURCE_vacancy_irradiation_ID) sourceType - call source_vacancy_irradiation_deltaState(ipc, ip, el) - - case (SOURCE_vacancy_thermalfluc_ID) sourceType - call source_vacancy_thermalfluc_deltaState(ipc, ip, el) - end select sourceType enddo SourceLoop @@ -1140,8 +1086,10 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_ISOTROPIC_ID) plasticityType + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) constitutive_postResults(startPos:endPos) = & - plastic_isotropic_postResults(S6,ipc,ip,el) + plastic_isotropic_postResults(Mp,instance,of) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType of = phasememberAt(ipc,ip,el) @@ -1150,8 +1098,10 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) plastic_phenopowerlaw_postResults(Mp,instance,of) case (PLASTICITY_KINEHARDENING_ID) plasticityType + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) constitutive_postResults(startPos:endPos) = & - plastic_kinehardening_postResults(S6,ipc,ip,el) + plastic_kinehardening_postResults(Mp,instance,of) case (PLASTICITY_DISLOTWIN_ID) plasticityType of = phasememberAt(ipc,ip,el) @@ -1187,4 +1137,43 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) end function constitutive_postResults + +!-------------------------------------------------------------------------------------------------- +!> @brief writes constitutive results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine constitutive_results() + use material, only: & + PLASTICITY_ISOTROPIC_ID, & + PLASTICITY_PHENOPOWERLAW_ID, & + PLASTICITY_KINEHARDENING_ID, & + PLASTICITY_DISLOTWIN_ID, & + PLASTICITY_DISLOUCLA_ID, & + PLASTICITY_NONLOCAL_ID +#if defined(PETSc) || defined(DAMASKHDF5) + use results + use HDF5_utilities + use config, only: & + config_name_phase => phase_name ! anticipate logical name + + use material, only: & + phase_plasticityInstance, & + material_phase_plasticity_type => phase_plasticity + use plastic_phenopowerlaw, only: & + plastic_phenopowerlaw_results + + implicit none + integer(pInt) :: p + call HDF5_closeGroup(results_addGroup('current/phase')) + do p=1,size(config_name_phase) + call HDF5_closeGroup(results_addGroup('current/phase/'//trim(config_name_phase(p)))) + if (material_phase_plasticity_type(p) == PLASTICITY_PHENOPOWERLAW_ID) then + call plastic_phenopowerlaw_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p))) + endif + enddo + +#endif + + +end subroutine constitutive_results + end module constitutive diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 9e40150d9..32b033ffe 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -25,10 +25,7 @@ module homogenization materialpoint_sizeResults, & homogenization_maxSizePostResults, & thermal_maxSizePostResults, & - damage_maxSizePostResults, & - vacancyflux_maxSizePostResults, & - porosity_maxSizePostResults, & - hydrogenflux_maxSizePostResults + damage_maxSizePostResults real(pReal), dimension(:,:,:,:), allocatable, private :: & materialpoint_subF0, & !< def grad of IP at beginning of homogenization increment @@ -100,13 +97,6 @@ subroutine homogenization_init use damage_none use damage_local use damage_nonlocal - use vacancyflux_isoconc - use vacancyflux_isochempot - use vacancyflux_cahnhilliard - use porosity_none - use porosity_phasefield - use hydrogenflux_isoconc - use hydrogenflux_cahnhilliard use IO use numerics, only: & worldrank @@ -155,33 +145,6 @@ subroutine homogenization_init if (any(damage_type == DAMAGE_nonlocal_ID)) & call damage_nonlocal_init(FILEUNIT) -!-------------------------------------------------------------------------------------------------- -! parse vacancy transport from config file - call IO_checkAndRewind(FILEUNIT) - if (any(vacancyflux_type == VACANCYFLUX_isoconc_ID)) & - call vacancyflux_isoconc_init() - if (any(vacancyflux_type == VACANCYFLUX_isochempot_ID)) & - call vacancyflux_isochempot_init(FILEUNIT) - if (any(vacancyflux_type == VACANCYFLUX_cahnhilliard_ID)) & - call vacancyflux_cahnhilliard_init(FILEUNIT) - -!-------------------------------------------------------------------------------------------------- -! parse porosity from config file - call IO_checkAndRewind(FILEUNIT) - if (any(porosity_type == POROSITY_none_ID)) & - call porosity_none_init() - if (any(porosity_type == POROSITY_phasefield_ID)) & - call porosity_phasefield_init(FILEUNIT) - -!-------------------------------------------------------------------------------------------------- -! parse hydrogen transport from config file - call IO_checkAndRewind(FILEUNIT) - if (any(hydrogenflux_type == HYDROGENFLUX_isoconc_ID)) & - call hydrogenflux_isoconc_init() - if (any(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID)) & - call hydrogenflux_cahnhilliard_init(FILEUNIT) - close(FILEUNIT) - !-------------------------------------------------------------------------------------------------- ! write description file for homogenization output mainProcess2: if (worldrank == 0) then @@ -275,83 +238,6 @@ subroutine homogenization_init enddo endif endif - i = vacancyflux_typeInstance(p) ! which instance of this vacancy flux type - valid = .true. ! assume valid - select case(vacancyflux_type(p)) ! split per vacancy flux type - case (VACANCYFLUX_isoconc_ID) - outputName = VACANCYFLUX_isoconc_label - thisNoutput => null() - thisOutput => null() - thisSize => null() - case (VACANCYFLUX_isochempot_ID) - outputName = VACANCYFLUX_isochempot_label - thisNoutput => vacancyflux_isochempot_Noutput - thisOutput => vacancyflux_isochempot_output - thisSize => vacancyflux_isochempot_sizePostResult - case (VACANCYFLUX_cahnhilliard_ID) - outputName = VACANCYFLUX_cahnhilliard_label - thisNoutput => vacancyflux_cahnhilliard_Noutput - thisOutput => vacancyflux_cahnhilliard_output - thisSize => vacancyflux_cahnhilliard_sizePostResult - case default - valid = .false. - end select - if (valid) then - write(FILEUNIT,'(a)') '(vacancyflux)'//char(9)//trim(outputName) - if (vacancyflux_type(p) /= VACANCYFLUX_isoconc_ID) then - do e = 1,thisNoutput(i) - write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) - enddo - endif - endif - i = porosity_typeInstance(p) ! which instance of this porosity type - valid = .true. ! assume valid - select case(porosity_type(p)) ! split per porosity type - case (POROSITY_none_ID) - outputName = POROSITY_none_label - thisNoutput => null() - thisOutput => null() - thisSize => null() - case (POROSITY_phasefield_ID) - outputName = POROSITY_phasefield_label - thisNoutput => porosity_phasefield_Noutput - thisOutput => porosity_phasefield_output - thisSize => porosity_phasefield_sizePostResult - case default - valid = .false. - end select - if (valid) then - write(FILEUNIT,'(a)') '(porosity)'//char(9)//trim(outputName) - if (porosity_type(p) /= POROSITY_none_ID) then - do e = 1,thisNoutput(i) - write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) - enddo - endif - endif - i = hydrogenflux_typeInstance(p) ! which instance of this hydrogen flux type - valid = .true. ! assume valid - select case(hydrogenflux_type(p)) ! split per hydrogen flux type - case (HYDROGENFLUX_isoconc_ID) - outputName = HYDROGENFLUX_isoconc_label - thisNoutput => null() - thisOutput => null() - thisSize => null() - case (HYDROGENFLUX_cahnhilliard_ID) - outputName = HYDROGENFLUX_cahnhilliard_label - thisNoutput => hydrogenflux_cahnhilliard_Noutput - thisOutput => hydrogenflux_cahnhilliard_output - thisSize => hydrogenflux_cahnhilliard_sizePostResult - case default - valid = .false. - end select - if (valid) then - write(FILEUNIT,'(a)') '(hydrogenflux)'//char(9)//trim(outputName) - if (hydrogenflux_type(p) /= HYDROGENFLUX_isoconc_ID) then - do e = 1,thisNoutput(i) - write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i) - enddo - endif - endif endif enddo close(FILEUNIT) @@ -381,25 +267,16 @@ subroutine homogenization_init homogenization_maxSizePostResults = 0_pInt thermal_maxSizePostResults = 0_pInt damage_maxSizePostResults = 0_pInt - vacancyflux_maxSizePostResults = 0_pInt - porosity_maxSizePostResults = 0_pInt - hydrogenflux_maxSizePostResults = 0_pInt do p = 1,size(config_homogenization) homogenization_maxSizePostResults = max(homogenization_maxSizePostResults,homogState (p)%sizePostResults) thermal_maxSizePostResults = max(thermal_maxSizePostResults, thermalState (p)%sizePostResults) damage_maxSizePostResults = max(damage_maxSizePostResults ,damageState (p)%sizePostResults) - vacancyflux_maxSizePostResults = max(vacancyflux_maxSizePostResults ,vacancyfluxState (p)%sizePostResults) - porosity_maxSizePostResults = max(porosity_maxSizePostResults ,porosityState (p)%sizePostResults) - hydrogenflux_maxSizePostResults = max(hydrogenflux_maxSizePostResults ,hydrogenfluxState(p)%sizePostResults) enddo materialpoint_sizeResults = 1 & ! grain count + 1 + homogenization_maxSizePostResults & ! homogSize & homogResult + thermal_maxSizePostResults & + damage_maxSizePostResults & - + vacancyflux_maxSizePostResults & - + porosity_maxSizePostResults & - + hydrogenflux_maxSizePostResults & + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results + constitutive_source_maxSizePostResults) @@ -458,9 +335,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) homogState, & thermalState, & damageState, & - vacancyfluxState, & - porosityState, & - hydrogenfluxState, & phase_Nsources, & mappingHomogenization, & phaseAt, phasememberAt, & @@ -567,18 +441,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & damageState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal damage state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - vacancyfluxState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal vacancy transport state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - porosityState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal porosity state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - hydrogenfluxState(mappingHomogenization(2,i,e))%State0( :,mappingHomogenization(1,i,e)) ! ...internal hydrogen transport state enddo NiterationHomog = 0_pInt @@ -652,18 +514,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & damageState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) ! ...internal damage state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - vacancyfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e))! ...internal vacancy transport state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - porosityState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e))! ...internal porosity state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = & - hydrogenfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e))! ...internal hydrogen transport state materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad endif steppingNeeded @@ -727,18 +577,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & damageState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal damage state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - vacancyfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & - vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal vacancy transport state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - porosityState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & - porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal porosity state - forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & - hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) & - hydrogenfluxState(mappingHomogenization(2,i,e))%State( :,mappingHomogenization(1,i,e)) = & - hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal hydrogen transport state endif endif converged @@ -844,9 +682,6 @@ subroutine materialpoint_postResults homogState, & thermalState, & damageState, & - vacancyfluxState, & - porosityState, & - hydrogenfluxState, & plasticState, & sourceState, & material_phase, & @@ -875,10 +710,7 @@ subroutine materialpoint_postResults theSize = homogState (mappingHomogenization(2,i,e))%sizePostResults & + thermalState (mappingHomogenization(2,i,e))%sizePostResults & - + damageState (mappingHomogenization(2,i,e))%sizePostResults & - + vacancyfluxState (mappingHomogenization(2,i,e))%sizePostResults & - + porosityState (mappingHomogenization(2,i,e))%sizePostResults & - + hydrogenfluxState(mappingHomogenization(2,i,e))%sizePostResults + + damageState (mappingHomogenization(2,i,e))%sizePostResults materialpoint_results(thePos+1,i,e) = real(theSize,pReal) ! tell size of homogenization results thePos = thePos + 1_pInt @@ -970,12 +802,10 @@ function homogenization_updateState(ip,el) homogenization_type, & thermal_type, & damage_type, & - vacancyflux_type, & homogenization_maxNgrains, & HOMOGENIZATION_RGC_ID, & THERMAL_adiabatic_ID, & - DAMAGE_local_ID, & - VACANCYFLUX_isochempot_ID + DAMAGE_local_ID use crystallite, only: & crystallite_P, & crystallite_dPdF, & @@ -987,8 +817,6 @@ function homogenization_updateState(ip,el) thermal_adiabatic_updateState use damage_local, only: & damage_local_updateState - use vacancyflux_isochempot, only: & - vacancyflux_isochempot_updateState implicit none integer(pInt), intent(in) :: & @@ -1029,15 +857,6 @@ function homogenization_updateState(ip,el) el) end select chosenDamage - chosenVacancyflux: select case (vacancyflux_type(mesh_element(3,el))) - case (VACANCYFLUX_isochempot_ID) chosenVacancyflux - homogenization_updateState = & - homogenization_updateState .and. & - vacancyflux_isochempot_updateState(materialpoint_subdt(ip,el), & - ip, & - el) - end select chosenVacancyflux - end function homogenization_updateState @@ -1107,15 +926,9 @@ function homogenization_postResults(ip,el) homogState, & thermalState, & damageState, & - vacancyfluxState, & - porosityState, & - hydrogenfluxState, & homogenization_type, & thermal_type, & damage_type, & - vacancyflux_type, & - porosity_type, & - hydrogenflux_type, & HOMOGENIZATION_NONE_ID, & HOMOGENIZATION_ISOSTRAIN_ID, & HOMOGENIZATION_RGC_ID, & @@ -1124,14 +937,7 @@ function homogenization_postResults(ip,el) THERMAL_conduction_ID, & DAMAGE_none_ID, & DAMAGE_local_ID, & - DAMAGE_nonlocal_ID, & - VACANCYFLUX_isoconc_ID, & - VACANCYFLUX_isochempot_ID, & - VACANCYFLUX_cahnhilliard_ID, & - POROSITY_none_ID, & - POROSITY_phasefield_ID, & - HYDROGENFLUX_isoconc_ID, & - HYDROGENFLUX_cahnhilliard_ID + DAMAGE_nonlocal_ID use homogenization_RGC, only: & homogenization_RGC_postResults use thermal_adiabatic, only: & @@ -1142,14 +948,6 @@ function homogenization_postResults(ip,el) damage_local_postResults use damage_nonlocal, only: & damage_nonlocal_postResults - use vacancyflux_isochempot, only: & - vacancyflux_isochempot_postResults - use vacancyflux_cahnhilliard, only: & - vacancyflux_cahnhilliard_postResults - use porosity_phasefield, only: & - porosity_phasefield_postResults - use hydrogenflux_cahnhilliard, only: & - hydrogenflux_cahnhilliard_postResults implicit none integer(pInt), intent(in) :: & @@ -1157,10 +955,7 @@ function homogenization_postResults(ip,el) el !< element number real(pReal), dimension( homogState (mappingHomogenization(2,ip,el))%sizePostResults & + thermalState (mappingHomogenization(2,ip,el))%sizePostResults & - + damageState (mappingHomogenization(2,ip,el))%sizePostResults & - + vacancyfluxState (mappingHomogenization(2,ip,el))%sizePostResults & - + porosityState (mappingHomogenization(2,ip,el))%sizePostResults & - + hydrogenfluxState(mappingHomogenization(2,ip,el))%sizePostResults) :: & + + damageState (mappingHomogenization(2,ip,el))%sizePostResults) :: & homogenization_postResults integer(pInt) :: & startPos, endPos @@ -1204,39 +999,6 @@ function homogenization_postResults(ip,el) damage_nonlocal_postResults(ip, el) end select chosenDamage - startPos = endPos + 1_pInt - endPos = endPos + vacancyfluxState(mappingHomogenization(2,ip,el))%sizePostResults - chosenVacancyflux: select case (vacancyflux_type(mesh_element(3,el))) - case (VACANCYFLUX_isoconc_ID) chosenVacancyflux - - case (VACANCYFLUX_isochempot_ID) chosenVacancyflux - homogenization_postResults(startPos:endPos) = & - vacancyflux_isochempot_postResults(ip, el) - case (VACANCYFLUX_cahnhilliard_ID) chosenVacancyflux - homogenization_postResults(startPos:endPos) = & - vacancyflux_cahnhilliard_postResults(ip, el) - end select chosenVacancyflux - - startPos = endPos + 1_pInt - endPos = endPos + porosityState(mappingHomogenization(2,ip,el))%sizePostResults - chosenPorosity: select case (porosity_type(mesh_element(3,el))) - case (POROSITY_none_ID) chosenPorosity - - case (POROSITY_phasefield_ID) chosenPorosity - homogenization_postResults(startPos:endPos) = & - porosity_phasefield_postResults(ip, el) - end select chosenPorosity - - startPos = endPos + 1_pInt - endPos = endPos + hydrogenfluxState(mappingHomogenization(2,ip,el))%sizePostResults - chosenHydrogenflux: select case (hydrogenflux_type(mesh_element(3,el))) - case (HYDROGENFLUX_isoconc_ID) chosenHydrogenflux - - case (HYDROGENFLUX_cahnhilliard_ID) chosenHydrogenflux - homogenization_postResults(startPos:endPos) = & - hydrogenflux_cahnhilliard_postResults(ip, el) - end select chosenHydrogenflux - end function homogenization_postResults end module homogenization diff --git a/src/hydrogenflux_cahnhilliard.f90 b/src/hydrogenflux_cahnhilliard.f90 deleted file mode 100644 index 3a42a49e1..000000000 --- a/src/hydrogenflux_cahnhilliard.f90 +++ /dev/null @@ -1,508 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for conservative transport of solute hydrogen -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module hydrogenflux_cahnhilliard - use prec, only: & - pReal, & - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - hydrogenflux_cahnhilliard_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - hydrogenflux_cahnhilliard_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - hydrogenflux_cahnhilliard_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - hydrogenflux_cahnhilliard_Noutput !< number of outputs per instance of this damage - - real(pReal), parameter, private :: & - kB = 1.3806488e-23_pReal !< Boltzmann constant in J/Kelvin - - enum, bind(c) - enumerator :: undefined_ID, & - hydrogenConc_ID - end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - hydrogenflux_cahnhilliard_outputID !< ID of each post result output - - - public :: & - hydrogenflux_cahnhilliard_init, & - hydrogenflux_cahnhilliard_getMobility33, & - hydrogenflux_cahnhilliard_getDiffusion33, & - hydrogenflux_cahnhilliard_getFormationEnergy, & - hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent, & - hydrogenflux_cahnhilliard_getChemPotAndItsTangent, & - hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate, & - hydrogenflux_cahnhilliard_postResults - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine hydrogenflux_cahnhilliard_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF - use material, only: & - hydrogenflux_type, & - hydrogenflux_typeInstance, & - homogenization_Noutput, & - HYDROGENFLUX_cahnhilliard_label, & - HYDROGENFLUX_cahnhilliard_ID, & - material_homog, & - mappingHomogenization, & - hydrogenfluxState, & - hydrogenfluxMapping, & - hydrogenConc, & - hydrogenConcRate, & - hydrogenflux_initialCh - use config, only: & - material_partHomogenization, & - material_partPhase - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o - integer(pInt) :: sizeState - integer(pInt) :: NofMyHomog - character(len=65536) :: & - tag = '', & - line = '' - - write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID),pInt) - if (maxNinstance == 0_pInt) return - - allocate(hydrogenflux_cahnhilliard_sizePostResults(maxNinstance), source=0_pInt) - allocate(hydrogenflux_cahnhilliard_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) - allocate(hydrogenflux_cahnhilliard_output (maxval(homogenization_Noutput),maxNinstance)) - hydrogenflux_cahnhilliard_output = '' - allocate(hydrogenflux_cahnhilliard_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) - allocate(hydrogenflux_cahnhilliard_Noutput (maxNinstance), source=0_pInt) - - rewind(fileUnit) - section = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to - line = IO_read(fileUnit) - enddo - - parsingHomog: do while (trim(line) /= IO_EOF) ! read through sections of homog part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next homog section - section = section + 1_pInt ! advance homog section counter - cycle ! skip to next line - endif - - if (section > 0_pInt ) then; if (hydrogenflux_type(section) == HYDROGENFLUX_cahnhilliard_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = hydrogenflux_typeInstance(section) ! which instance of my hydrogenflux is present homog - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('hydrogenconc') - hydrogenflux_cahnhilliard_Noutput(instance) = hydrogenflux_cahnhilliard_Noutput(instance) + 1_pInt - hydrogenflux_cahnhilliard_outputID(hydrogenflux_cahnhilliard_Noutput(instance),instance) = hydrogenConc_ID - hydrogenflux_cahnhilliard_output(hydrogenflux_cahnhilliard_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - end select - endif; endif - enddo parsingHomog - - rewind(fileUnit) - section = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - initializeInstances: do section = 1_pInt, size(hydrogenflux_type) - if (hydrogenflux_type(section) == HYDROGENFLUX_cahnhilliard_ID) then - NofMyHomog=count(material_homog==section) - instance = hydrogenflux_typeInstance(section) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,hydrogenflux_cahnhilliard_Noutput(instance) - select case(hydrogenflux_cahnhilliard_outputID(o,instance)) - case(hydrogenConc_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - hydrogenflux_cahnhilliard_sizePostResult(o,instance) = mySize - hydrogenflux_cahnhilliard_sizePostResults(instance) = hydrogenflux_cahnhilliard_sizePostResults(instance) + mySize - endif - enddo outputsLoop - -! allocate state arrays - sizeState = 0_pInt - hydrogenfluxState(section)%sizeState = sizeState - hydrogenfluxState(section)%sizePostResults = hydrogenflux_cahnhilliard_sizePostResults(instance) - allocate(hydrogenfluxState(section)%state0 (sizeState,NofMyHomog)) - allocate(hydrogenfluxState(section)%subState0(sizeState,NofMyHomog)) - allocate(hydrogenfluxState(section)%state (sizeState,NofMyHomog)) - - nullify(hydrogenfluxMapping(section)%p) - hydrogenfluxMapping(section)%p => mappingHomogenization(1,:,:) - deallocate(hydrogenConc (section)%p) - deallocate(hydrogenConcRate(section)%p) - allocate (hydrogenConc (section)%p(NofMyHomog), source=hydrogenflux_initialCh(section)) - allocate (hydrogenConcRate(section)%p(NofMyHomog), source=0.0_pReal) - - endif - - enddo initializeInstances - -end subroutine hydrogenflux_cahnhilliard_init - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized solute mobility tensor in reference configuration -!-------------------------------------------------------------------------------------------------- -function hydrogenflux_cahnhilliard_getMobility33(ip,el) - use lattice, only: & - lattice_hydrogenfluxMobility33 - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element - use crystallite, only: & - crystallite_push33ToRef - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - hydrogenflux_cahnhilliard_getMobility33 - integer(pInt) :: & - grain - - hydrogenflux_cahnhilliard_getMobility33 = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - hydrogenflux_cahnhilliard_getMobility33 = hydrogenflux_cahnhilliard_getMobility33 + & - crystallite_push33ToRef(grain,ip,el,lattice_hydrogenfluxMobility33(:,:,material_phase(grain,ip,el))) - enddo - - hydrogenflux_cahnhilliard_getMobility33 = & - hydrogenflux_cahnhilliard_getMobility33/real(homogenization_Ngrains(mesh_element(3,el)),pReal) - -end function hydrogenflux_cahnhilliard_getMobility33 - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized solute nonlocal diffusion tensor in reference configuration -!-------------------------------------------------------------------------------------------------- -function hydrogenflux_cahnhilliard_getDiffusion33(ip,el) - use lattice, only: & - lattice_hydrogenfluxDiffusion33 - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element - use crystallite, only: & - crystallite_push33ToRef - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - hydrogenflux_cahnhilliard_getDiffusion33 - integer(pInt) :: & - grain - - hydrogenflux_cahnhilliard_getDiffusion33 = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - hydrogenflux_cahnhilliard_getDiffusion33 = hydrogenflux_cahnhilliard_getDiffusion33 + & - crystallite_push33ToRef(grain,ip,el,lattice_hydrogenfluxDiffusion33(:,:,material_phase(grain,ip,el))) - enddo - - hydrogenflux_cahnhilliard_getDiffusion33 = & - hydrogenflux_cahnhilliard_getDiffusion33/real(homogenization_Ngrains(mesh_element(3,el)),pReal) - -end function hydrogenflux_cahnhilliard_getDiffusion33 - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized solution energy -!-------------------------------------------------------------------------------------------------- -function hydrogenflux_cahnhilliard_getFormationEnergy(ip,el) - use lattice, only: & - lattice_hydrogenFormationEnergy, & - lattice_hydrogenVol, & - lattice_hydrogenSurfaceEnergy - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal) :: & - hydrogenflux_cahnhilliard_getFormationEnergy - integer(pInt) :: & - grain - - hydrogenflux_cahnhilliard_getFormationEnergy = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - hydrogenflux_cahnhilliard_getFormationEnergy = hydrogenflux_cahnhilliard_getFormationEnergy + & - lattice_hydrogenFormationEnergy(material_phase(grain,ip,el))/ & - lattice_hydrogenVol(material_phase(grain,ip,el))/ & - lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el)) - enddo - - hydrogenflux_cahnhilliard_getFormationEnergy = & - hydrogenflux_cahnhilliard_getFormationEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal) - -end function hydrogenflux_cahnhilliard_getFormationEnergy - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized hydrogen entropy coefficient -!-------------------------------------------------------------------------------------------------- -function hydrogenflux_cahnhilliard_getEntropicCoeff(ip,el) - use lattice, only: & - lattice_hydrogenVol, & - lattice_hydrogenSurfaceEnergy - use material, only: & - homogenization_Ngrains, & - material_homog, & - material_phase, & - temperature, & - thermalMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal) :: & - hydrogenflux_cahnhilliard_getEntropicCoeff - integer(pInt) :: & - grain - - hydrogenflux_cahnhilliard_getEntropicCoeff = 0.0_pReal - do grain = 1, homogenization_Ngrains(material_homog(ip,el)) - hydrogenflux_cahnhilliard_getEntropicCoeff = hydrogenflux_cahnhilliard_getEntropicCoeff + & - kB/ & - lattice_hydrogenVol(material_phase(grain,ip,el))/ & - lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el)) - enddo - - hydrogenflux_cahnhilliard_getEntropicCoeff = hydrogenflux_cahnhilliard_getEntropicCoeff* & - temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el))/ & - real(homogenization_Ngrains(material_homog(ip,el)),pReal) - -end function hydrogenflux_cahnhilliard_getEntropicCoeff - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized kinematic contribution to chemical potential -!-------------------------------------------------------------------------------------------------- -subroutine hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCh, Ch, ip, el) - use lattice, only: & - lattice_hydrogenSurfaceEnergy - use material, only: & - homogenization_Ngrains, & - material_homog, & - phase_kinematics, & - phase_Nkinematics, & - material_phase, & - KINEMATICS_hydrogen_strain_ID - use crystallite, only: & - crystallite_Tstar_v, & - crystallite_Fi0, & - crystallite_Fi - use kinematics_hydrogen_strain, only: & - kinematics_hydrogen_strain_ChemPotAndItsTangent - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Ch - real(pReal), intent(out) :: & - KPot, dKPot_dCh - real(pReal) :: & - my_KPot, my_dKPot_dCh - integer(pInt) :: & - grain, kinematics - - KPot = 0.0_pReal - dKPot_dCh = 0.0_pReal - do grain = 1_pInt,homogenization_Ngrains(material_homog(ip,el)) - do kinematics = 1_pInt, phase_Nkinematics(material_phase(grain,ip,el)) - select case (phase_kinematics(kinematics,material_phase(grain,ip,el))) - case (KINEMATICS_hydrogen_strain_ID) - call kinematics_hydrogen_strain_ChemPotAndItsTangent(my_KPot, my_dKPot_dCh, & - crystallite_Tstar_v(1:6,grain,ip,el), & - crystallite_Fi0(1:3,1:3,grain,ip,el), & - crystallite_Fi (1:3,1:3,grain,ip,el), & - grain,ip, el) - - case default - my_KPot = 0.0_pReal - my_dKPot_dCh = 0.0_pReal - - end select - KPot = KPot + my_KPot/lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el)) - dKPot_dCh = dKPot_dCh + my_dKPot_dCh/lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el)) - enddo - enddo - - KPot = KPot/real(homogenization_Ngrains(material_homog(ip,el)),pReal) - dKPot_dCh = dKPot_dCh/real(homogenization_Ngrains(material_homog(ip,el)),pReal) - -end subroutine hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized chemical potential -!-------------------------------------------------------------------------------------------------- -subroutine hydrogenflux_cahnhilliard_getChemPotAndItsTangent(ChemPot,dChemPot_dCh,Ch,ip,el) - use numerics, only: & - hydrogenBoundPenalty, & - hydrogenPolyOrder - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Ch - real(pReal), intent(out) :: & - ChemPot, & - dChemPot_dCh - real(pReal) :: & - kBT, KPot, dKPot_dCh - integer(pInt) :: & - o - - ChemPot = hydrogenflux_cahnhilliard_getFormationEnergy(ip,el) - dChemPot_dCh = 0.0_pReal - kBT = hydrogenflux_cahnhilliard_getEntropicCoeff(ip,el) - do o = 1_pInt, hydrogenPolyOrder - ChemPot = ChemPot + kBT*((2.0_pReal*Ch - 1.0_pReal)**real(2_pInt*o-1_pInt,pReal))/ & - real(2_pInt*o-1_pInt,pReal) - dChemPot_dCh = dChemPot_dCh + 2.0_pReal*kBT*(2.0_pReal*Ch - 1.0_pReal)**real(2_pInt*o-2_pInt,pReal) - enddo - - call hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCh, Ch, ip, el) - ChemPot = ChemPot + KPot - dChemPot_dCh = dChemPot_dCh + dKPot_dCh - - if (Ch < 0.0_pReal) then - ChemPot = ChemPot - 3.0_pReal*hydrogenBoundPenalty*Ch*Ch - dChemPot_dCh = dChemPot_dCh - 6.0_pReal*hydrogenBoundPenalty*Ch - elseif (Ch > 1.0_pReal) then - ChemPot = ChemPot + 3.0_pReal*hydrogenBoundPenalty*(1.0_pReal - Ch)*(1.0_pReal - Ch) - dChemPot_dCh = dChemPot_dCh - 6.0_pReal*hydrogenBoundPenalty*(1.0_pReal - Ch) - endif - -end subroutine hydrogenflux_cahnhilliard_getChemPotAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief updates hydrogen concentration with solution from Cahn-Hilliard PDE for solute transport -!-------------------------------------------------------------------------------------------------- -subroutine hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate(Ch,Chdot,ip,el) - use material, only: & - mappingHomogenization, & - hydrogenConc, & - hydrogenConcRate, & - hydrogenfluxMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Ch, & - Chdot - integer(pInt) :: & - homog, & - offset - - homog = mappingHomogenization(2,ip,el) - offset = hydrogenfluxMapping(homog)%p(ip,el) - hydrogenConc (homog)%p(offset) = Ch - hydrogenConcRate(homog)%p(offset) = Chdot - -end subroutine hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of hydrogen transport results -!-------------------------------------------------------------------------------------------------- -function hydrogenflux_cahnhilliard_postResults(ip,el) - use material, only: & - mappingHomogenization, & - hydrogenflux_typeInstance, & - hydrogenConc, & - hydrogenfluxMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(hydrogenflux_cahnhilliard_sizePostResults(hydrogenflux_typeInstance(mappingHomogenization(2,ip,el)))) :: & - hydrogenflux_cahnhilliard_postResults - - integer(pInt) :: & - instance, homog, offset, o, c - - homog = mappingHomogenization(2,ip,el) - offset = hydrogenfluxMapping(homog)%p(ip,el) - instance = hydrogenflux_typeInstance(homog) - - c = 0_pInt - hydrogenflux_cahnhilliard_postResults = 0.0_pReal - - do o = 1_pInt,hydrogenflux_cahnhilliard_Noutput(instance) - select case(hydrogenflux_cahnhilliard_outputID(o,instance)) - - case (hydrogenConc_ID) - hydrogenflux_cahnhilliard_postResults(c+1_pInt) = hydrogenConc(homog)%p(offset) - c = c + 1 - end select - enddo -end function hydrogenflux_cahnhilliard_postResults - -end module hydrogenflux_cahnhilliard diff --git a/src/hydrogenflux_isoconc.f90 b/src/hydrogenflux_isoconc.f90 deleted file mode 100644 index 836d29198..000000000 --- a/src/hydrogenflux_isoconc.f90 +++ /dev/null @@ -1,62 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for constant hydrogen concentration -!-------------------------------------------------------------------------------------------------- -module hydrogenflux_isoconc - - implicit none - private - - public :: & - hydrogenflux_isoconc_init - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields, reads information from material configuration file -!-------------------------------------------------------------------------------------------------- -subroutine hydrogenflux_isoconc_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use prec, only: & - pReal, & - pInt - use IO, only: & - IO_timeStamp - use material - use config - - implicit none - integer(pInt) :: & - homog, & - NofMyHomog - - write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - initializeInstances: do homog = 1_pInt, material_Nhomogenization - - myhomog: if (hydrogenflux_type(homog) == HYDROGENFLUX_isoconc_ID) then - NofMyHomog = count(material_homog == homog) - hydrogenfluxState(homog)%sizeState = 0_pInt - hydrogenfluxState(homog)%sizePostResults = 0_pInt - allocate(hydrogenfluxState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) - allocate(hydrogenfluxState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) - allocate(hydrogenfluxState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal) - - deallocate(hydrogenConc (homog)%p) - deallocate(hydrogenConcRate(homog)%p) - allocate (hydrogenConc (homog)%p(1), source=hydrogenflux_initialCh(homog)) - allocate (hydrogenConcRate(homog)%p(1), source=0.0_pReal) - - endif myhomog - enddo initializeInstances - - -end subroutine hydrogenflux_isoconc_init - -end module hydrogenflux_isoconc diff --git a/src/kinematics_hydrogen_strain.f90 b/src/kinematics_hydrogen_strain.f90 deleted file mode 100644 index 516ca286f..000000000 --- a/src/kinematics_hydrogen_strain.f90 +++ /dev/null @@ -1,263 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine incorporating kinematics resulting from interstitial hydrogen -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module kinematics_hydrogen_strain - use prec, only: & - pReal, & - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - kinematics_hydrogen_strain_sizePostResults, & !< cumulative size of post results - kinematics_hydrogen_strain_offset, & !< which kinematics is my current damage mechanism? - kinematics_hydrogen_strain_instance !< instance of damage kinematics mechanism - - integer(pInt), dimension(:,:), allocatable, target, public :: & - kinematics_hydrogen_strain_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - kinematics_hydrogen_strain_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - kinematics_hydrogen_strain_Noutput !< number of outputs per instance of this damage - - real(pReal), dimension(:), allocatable, private :: & - kinematics_hydrogen_strain_coeff - - public :: & - kinematics_hydrogen_strain_init, & - kinematics_hydrogen_strain_initialStrain, & - kinematics_hydrogen_strain_LiAndItsTangent, & - kinematics_hydrogen_strain_ChemPotAndItsTangent - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine kinematics_hydrogen_strain_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF - use material, only: & - phase_kinematics, & - phase_Nkinematics, & - phase_Noutput, & - KINEMATICS_hydrogen_strain_label, & - KINEMATICS_hydrogen_strain_ID - use config, only: & - material_Nphase, & - MATERIAL_partPhase - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,kinematics - character(len=65536) :: & - tag = '', & - line = '' - - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_hydrogen_strain_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(phase_kinematics == KINEMATICS_hydrogen_strain_ID),pInt) - if (maxNinstance == 0_pInt) return - - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(kinematics_hydrogen_strain_offset(material_Nphase), source=0_pInt) - allocate(kinematics_hydrogen_strain_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - kinematics_hydrogen_strain_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_hydrogen_strain_ID) - do kinematics = 1, phase_Nkinematics(phase) - if (phase_kinematics(kinematics,phase) == kinematics_hydrogen_strain_ID) & - kinematics_hydrogen_strain_offset(phase) = kinematics - enddo - enddo - - allocate(kinematics_hydrogen_strain_sizePostResults(maxNinstance), source=0_pInt) - allocate(kinematics_hydrogen_strain_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(kinematics_hydrogen_strain_output(maxval(phase_Noutput),maxNinstance)) - kinematics_hydrogen_strain_output = '' - allocate(kinematics_hydrogen_strain_Noutput(maxNinstance), source=0_pInt) - allocate(kinematics_hydrogen_strain_coeff(maxNinstance), source=0.0_pReal) - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_hydrogen_strain_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = kinematics_hydrogen_strain_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('hydrogen_strain_coeff') - kinematics_hydrogen_strain_coeff(instance) = IO_floatValue(line,chunkPos,2_pInt) - - end select - endif; endif - enddo parsingFile - -end subroutine kinematics_hydrogen_strain_init - -!-------------------------------------------------------------------------------------------------- -!> @brief report initial hydrogen strain based on current hydrogen conc deviation from -!> equillibrium (0) -!-------------------------------------------------------------------------------------------------- -pure function kinematics_hydrogen_strain_initialStrain(ipc, ip, el) - use math, only: & - math_I3 - use material, only: & - material_phase, & - material_homog, & - hydrogenConc, & - hydrogenfluxMapping - use lattice, only: & - lattice_equilibriumHydrogenConcentration - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - kinematics_hydrogen_strain_initialStrain !< initial thermal strain (should be small strain, though) - integer(pInt) :: & - phase, & - homog, offset, instance - - phase = material_phase(ipc,ip,el) - instance = kinematics_hydrogen_strain_instance(phase) - homog = material_homog(ip,el) - offset = hydrogenfluxMapping(homog)%p(ip,el) - - kinematics_hydrogen_strain_initialStrain = & - (hydrogenConc(homog)%p(offset) - lattice_equilibriumHydrogenConcentration(phase)) * & - kinematics_hydrogen_strain_coeff(instance)* math_I3 - -end function kinematics_hydrogen_strain_initialStrain - -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the velocity gradient -!-------------------------------------------------------------------------------------------------- -subroutine kinematics_hydrogen_strain_LiAndItsTangent(Li, dLi_dTstar3333, ipc, ip, el) - use material, only: & - material_phase, & - material_homog, & - hydrogenConc, & - hydrogenConcRate, & - hydrogenfluxMapping - use math, only: & - math_I3 - use lattice, only: & - lattice_equilibriumHydrogenConcentration - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(out), dimension(3,3) :: & - Li !< thermal velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLi_dTstar3333 !< derivative of Li with respect to Tstar (4th-order tensor) - integer(pInt) :: & - phase, & - instance, & - homog, offset - real(pReal) :: & - Ch, ChEq, ChDot - - phase = material_phase(ipc,ip,el) - instance = kinematics_hydrogen_strain_instance(phase) - homog = material_homog(ip,el) - offset = hydrogenfluxMapping(homog)%p(ip,el) - Ch = hydrogenConc(homog)%p(offset) - ChDot = hydrogenConcRate(homog)%p(offset) - ChEq = lattice_equilibriumHydrogenConcentration(phase) - - Li = ChDot*math_I3* & - kinematics_hydrogen_strain_coeff(instance)/ & - (1.0_pReal + kinematics_hydrogen_strain_coeff(instance)*(Ch - ChEq)) - dLi_dTstar3333 = 0.0_pReal - -end subroutine kinematics_hydrogen_strain_LiAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief contains the kinematic contribution to hydrogen chemical potential -!-------------------------------------------------------------------------------------------------- -subroutine kinematics_hydrogen_strain_ChemPotAndItsTangent(ChemPot, dChemPot_dCh, Tstar_v, Fi0, Fi, ipc, ip, el) - use material, only: & - material_phase - use math, only: & - math_inv33, & - math_mul33x33, & - math_Mandel6to33, & - math_transpose33 - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(in), dimension(6) :: & - Tstar_v - real(pReal), intent(in), dimension(3,3) :: & - Fi0, Fi - real(pReal), intent(out) :: & - ChemPot, dChemPot_dCh - integer(pInt) :: & - phase, & - instance - - phase = material_phase(ipc,ip,el) - instance = kinematics_hydrogen_strain_instance(phase) - - ChemPot = -kinematics_hydrogen_strain_coeff(instance)* & - sum(math_mul33x33(Fi,math_Mandel6to33(Tstar_v))* & - math_mul33x33(math_mul33x33(Fi,math_inv33(Fi0)),Fi)) - dChemPot_dCh = 0.0_pReal - -end subroutine kinematics_hydrogen_strain_ChemPotAndItsTangent - -end module kinematics_hydrogen_strain diff --git a/src/kinematics_vacancy_strain.f90 b/src/kinematics_vacancy_strain.f90 deleted file mode 100644 index 7ecc7fe6e..000000000 --- a/src/kinematics_vacancy_strain.f90 +++ /dev/null @@ -1,264 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine incorporating kinematics resulting from vacancy point defects -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module kinematics_vacancy_strain - use prec, only: & - pReal, & - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - kinematics_vacancy_strain_sizePostResults, & !< cumulative size of post results - kinematics_vacancy_strain_offset, & !< which kinematics is my current damage mechanism? - kinematics_vacancy_strain_instance !< instance of damage kinematics mechanism - - integer(pInt), dimension(:,:), allocatable, target, public :: & - kinematics_vacancy_strain_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - kinematics_vacancy_strain_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - kinematics_vacancy_strain_Noutput !< number of outputs per instance of this damage - - real(pReal), dimension(:), allocatable, private :: & - kinematics_vacancy_strain_coeff - - public :: & - kinematics_vacancy_strain_init, & - kinematics_vacancy_strain_initialStrain, & - kinematics_vacancy_strain_LiAndItsTangent, & - kinematics_vacancy_strain_ChemPotAndItsTangent - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine kinematics_vacancy_strain_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF - use material, only: & - phase_kinematics, & - phase_Nkinematics, & - phase_Noutput, & - KINEMATICS_vacancy_strain_label, & - KINEMATICS_vacancy_strain_ID - use config, only: & - material_Nphase, & - MATERIAL_partPhase - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,kinematics - character(len=65536) :: & - tag = '', & - line = '' - - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(phase_kinematics == KINEMATICS_vacancy_strain_ID),pInt) - if (maxNinstance == 0_pInt) return - - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(kinematics_vacancy_strain_offset(material_Nphase), source=0_pInt) - allocate(kinematics_vacancy_strain_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - kinematics_vacancy_strain_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_vacancy_strain_ID) - do kinematics = 1, phase_Nkinematics(phase) - if (phase_kinematics(kinematics,phase) == kinematics_vacancy_strain_ID) & - kinematics_vacancy_strain_offset(phase) = kinematics - enddo - enddo - - allocate(kinematics_vacancy_strain_sizePostResults(maxNinstance), source=0_pInt) - allocate(kinematics_vacancy_strain_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(kinematics_vacancy_strain_output(maxval(phase_Noutput),maxNinstance)) - kinematics_vacancy_strain_output = '' - allocate(kinematics_vacancy_strain_Noutput(maxNinstance), source=0_pInt) - allocate(kinematics_vacancy_strain_coeff(maxNinstance), source=0.0_pReal) - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_vacancy_strain_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - instance = kinematics_vacancy_strain_instance(phase) ! which instance of my damage is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('vacancy_strain_coeff') - kinematics_vacancy_strain_coeff(instance) = IO_floatValue(line,chunkPos,2_pInt) - - end select - endif; endif - enddo parsingFile - -end subroutine kinematics_vacancy_strain_init - -!-------------------------------------------------------------------------------------------------- -!> @brief report initial vacancy strain based on current vacancy conc deviation from equillibrium -!-------------------------------------------------------------------------------------------------- -pure function kinematics_vacancy_strain_initialStrain(ipc, ip, el) - use math, only: & - math_I3 - use material, only: & - material_phase, & - material_homog, & - vacancyConc, & - vacancyfluxMapping - use lattice, only: & - lattice_equilibriumVacancyConcentration - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - kinematics_vacancy_strain_initialStrain !< initial thermal strain (should be small strain, though) - integer(pInt) :: & - phase, & - homog, offset, instance - - phase = material_phase(ipc,ip,el) - instance = kinematics_vacancy_strain_instance(phase) - homog = material_homog(ip,el) - offset = vacancyfluxMapping(homog)%p(ip,el) - - kinematics_vacancy_strain_initialStrain = & - (vacancyConc(homog)%p(offset) - lattice_equilibriumVacancyConcentration(phase)) * & - kinematics_vacancy_strain_coeff(instance)* math_I3 - -end function kinematics_vacancy_strain_initialStrain - -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the velocity gradient -!-------------------------------------------------------------------------------------------------- -subroutine kinematics_vacancy_strain_LiAndItsTangent(Li, dLi_dTstar3333, ipc, ip, el) - use material, only: & - material_phase, & - material_homog, & - vacancyConc, & - vacancyConcRate, & - vacancyfluxMapping - use math, only: & - math_I3 - use lattice, only: & - lattice_equilibriumVacancyConcentration - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(out), dimension(3,3) :: & - Li !< thermal velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLi_dTstar3333 !< derivative of Li with respect to Tstar (4th-order tensor) - integer(pInt) :: & - phase, & - instance, & - homog, offset - real(pReal) :: & - Cv, CvEq, CvDot - - phase = material_phase(ipc,ip,el) - instance = kinematics_vacancy_strain_instance(phase) - homog = material_homog(ip,el) - offset = vacancyfluxMapping(homog)%p(ip,el) - - Cv = vacancyConc(homog)%p(offset) - CvDot = vacancyConcRate(homog)%p(offset) - CvEq = lattice_equilibriumvacancyConcentration(phase) - - Li = CvDot*math_I3* & - kinematics_vacancy_strain_coeff(instance)/ & - (1.0_pReal + kinematics_vacancy_strain_coeff(instance)*(Cv - CvEq)) - - dLi_dTstar3333 = 0.0_pReal - -end subroutine kinematics_vacancy_strain_LiAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief contains the kinematic contribution to vacancy chemical potential -!-------------------------------------------------------------------------------------------------- -subroutine kinematics_vacancy_strain_ChemPotAndItsTangent(ChemPot, dChemPot_dCv, Tstar_v, Fi0, Fi, ipc, ip, el) - use material, only: & - material_phase - use math, only: & - math_inv33, & - math_mul33x33, & - math_Mandel6to33, & - math_transpose33 - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(in), dimension(6) :: & - Tstar_v - real(pReal), intent(in), dimension(3,3) :: & - Fi0, Fi - real(pReal), intent(out) :: & - ChemPot, dChemPot_dCv - integer(pInt) :: & - phase, & - instance - - phase = material_phase(ipc,ip,el) - instance = kinematics_vacancy_strain_instance(phase) - - ChemPot = -kinematics_vacancy_strain_coeff(instance)* & - sum(math_mul33x33(Fi,math_Mandel6to33(Tstar_v))* & - math_mul33x33(math_mul33x33(Fi,math_inv33(Fi0)),Fi)) - dChemPot_dCv = 0.0_pReal - -end subroutine kinematics_vacancy_strain_ChemPotAndItsTangent - -end module kinematics_vacancy_strain diff --git a/src/material.f90 b/src/material.f90 index c9dd28079..8356f43c7 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -36,29 +36,16 @@ module material SOURCE_damage_isoDuctile_label = 'damage_isoductile', & SOURCE_damage_anisoBrittle_label = 'damage_anisobrittle', & SOURCE_damage_anisoDuctile_label = 'damage_anisoductile', & - SOURCE_vacancy_phenoplasticity_label = 'vacancy_phenoplasticity', & - SOURCE_vacancy_irradiation_label = 'vacancy_irradiation', & - SOURCE_vacancy_thermalfluc_label = 'vacancy_thermalfluctuation', & KINEMATICS_thermal_expansion_label = 'thermal_expansion', & KINEMATICS_cleavage_opening_label = 'cleavage_opening', & KINEMATICS_slipplane_opening_label = 'slipplane_opening', & - KINEMATICS_vacancy_strain_label = 'vacancy_strain', & - KINEMATICS_hydrogen_strain_label = 'hydrogen_strain', & STIFFNESS_DEGRADATION_damage_label = 'damage', & - STIFFNESS_DEGRADATION_porosity_label = 'porosity', & THERMAL_isothermal_label = 'isothermal', & THERMAL_adiabatic_label = 'adiabatic', & THERMAL_conduction_label = 'conduction', & DAMAGE_none_label = 'none', & DAMAGE_local_label = 'local', & DAMAGE_nonlocal_label = 'nonlocal', & - VACANCYFLUX_isoconc_label = 'isoconcentration', & - VACANCYFLUX_isochempot_label = 'isochemicalpotential', & - VACANCYFLUX_cahnhilliard_label = 'cahnhilliard', & - POROSITY_none_label = 'none', & - POROSITY_phasefield_label = 'phasefield', & - HYDROGENFLUX_isoconc_label = 'isoconcentration', & - HYDROGENFLUX_cahnhilliard_label = 'cahnhilliard', & HOMOGENIZATION_none_label = 'none', & HOMOGENIZATION_isostrain_label = 'isostrain', & HOMOGENIZATION_rgc_label = 'rgc' @@ -87,25 +74,19 @@ module material SOURCE_damage_isoBrittle_ID, & SOURCE_damage_isoDuctile_ID, & SOURCE_damage_anisoBrittle_ID, & - SOURCE_damage_anisoDuctile_ID, & - SOURCE_vacancy_phenoplasticity_ID, & - SOURCE_vacancy_irradiation_ID, & - SOURCE_vacancy_thermalfluc_ID + SOURCE_damage_anisoDuctile_ID end enum enum, bind(c) enumerator :: KINEMATICS_undefined_ID, & KINEMATICS_cleavage_opening_ID, & KINEMATICS_slipplane_opening_ID, & - KINEMATICS_thermal_expansion_ID, & - KINEMATICS_vacancy_strain_ID, & - KINEMATICS_hydrogen_strain_ID + KINEMATICS_thermal_expansion_ID end enum enum, bind(c) enumerator :: STIFFNESS_DEGRADATION_undefined_ID, & - STIFFNESS_DEGRADATION_damage_ID, & - STIFFNESS_DEGRADATION_porosity_ID + STIFFNESS_DEGRADATION_damage_ID end enum enum, bind(c) @@ -120,21 +101,6 @@ module material DAMAGE_nonlocal_ID end enum - enum, bind(c) - enumerator :: VACANCYFLUX_isoconc_ID, & - VACANCYFLUX_isochempot_ID, & - VACANCYFLUX_cahnhilliard_ID - end enum - - enum, bind(c) - enumerator :: POROSITY_none_ID, & - POROSITY_phasefield_ID - end enum - enum, bind(c) - enumerator :: HYDROGENFLUX_isoconc_ID, & - HYDROGENFLUX_cahnhilliard_ID - end enum - enum, bind(c) enumerator :: HOMOGENIZATION_undefined_ID, & HOMOGENIZATION_none_ID, & @@ -150,12 +116,6 @@ module material thermal_type !< thermal transport model integer(kind(DAMAGE_none_ID)), dimension(:), allocatable, public, protected :: & damage_type !< nonlocal damage model - integer(kind(VACANCYFLUX_isoconc_ID)), dimension(:), allocatable, public, protected :: & - vacancyflux_type !< vacancy transport model - integer(kind(POROSITY_none_ID)), dimension(:), allocatable, public, protected :: & - porosity_type !< porosity evolution model - integer(kind(HYDROGENFLUX_isoconc_ID)), dimension(:), allocatable, public, protected :: & - hydrogenflux_type !< hydrogen transport model integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable, public, protected :: & phase_source, & !< active sources mechanisms of each phase @@ -181,17 +141,11 @@ module material homogenization_typeInstance, & !< instance of particular type of each homogenization thermal_typeInstance, & !< instance of particular type of each thermal transport damage_typeInstance, & !< instance of particular type of each nonlocal damage - vacancyflux_typeInstance, & !< instance of particular type of each vacancy flux - porosity_typeInstance, & !< instance of particular type of each porosity model - hydrogenflux_typeInstance, & !< instance of particular type of each hydrogen flux microstructure_crystallite !< crystallite setting ID of each microstructure ! DEPRECATED !!!! real(pReal), dimension(:), allocatable, public, protected :: & thermal_initialT, & !< initial temperature per each homogenization - damage_initialPhi, & !< initial damage per each homogenization - vacancyflux_initialCv, & !< initial vacancy concentration per each homogenization - porosity_initialPhi, & !< initial posority per each homogenization - hydrogenflux_initialCh !< initial hydrogen concentration per each homogenization + damage_initialPhi !< initial damage per each homogenization ! NEW MAPPINGS integer(pInt), dimension(:), allocatable, public, protected :: & @@ -221,10 +175,7 @@ module material type(tState), allocatable, dimension(:), public :: & homogState, & thermalState, & - damageState, & - vacancyfluxState, & - porosityState, & - hydrogenfluxState + damageState integer(pInt), dimension(:,:,:), allocatable, public, protected :: & material_texture !< texture (index) of each grain,IP,element @@ -274,20 +225,12 @@ module material type(tHomogMapping), allocatable, dimension(:), public :: & thermalMapping, & !< mapping for thermal state/fields - damageMapping, & !< mapping for damage state/fields - vacancyfluxMapping, & !< mapping for vacancy conc state/fields - porosityMapping, & !< mapping for porosity state/fields - hydrogenfluxMapping !< mapping for hydrogen conc state/fields + damageMapping !< mapping for damage state/fields type(group_float), allocatable, dimension(:), public :: & temperature, & !< temperature field damage, & !< damage field - vacancyConc, & !< vacancy conc field - porosity, & !< porosity field - hydrogenConc, & !< hydrogen conc field - temperatureRate, & !< temperature change rate field - vacancyConcRate, & !< vacancy conc change field - hydrogenConcRate !< hydrogen conc change field + temperatureRate !< temperature change rate field public :: & material_init, & @@ -306,29 +249,16 @@ module material SOURCE_damage_isoDuctile_ID, & SOURCE_damage_anisoBrittle_ID, & SOURCE_damage_anisoDuctile_ID, & - SOURCE_vacancy_phenoplasticity_ID, & - SOURCE_vacancy_irradiation_ID, & - SOURCE_vacancy_thermalfluc_ID, & KINEMATICS_cleavage_opening_ID, & KINEMATICS_slipplane_opening_ID, & KINEMATICS_thermal_expansion_ID, & - KINEMATICS_vacancy_strain_ID, & - KINEMATICS_hydrogen_strain_ID, & STIFFNESS_DEGRADATION_damage_ID, & - STIFFNESS_DEGRADATION_porosity_ID, & THERMAL_isothermal_ID, & THERMAL_adiabatic_ID, & THERMAL_conduction_ID, & DAMAGE_none_ID, & DAMAGE_local_ID, & DAMAGE_nonlocal_ID, & - VACANCYFLUX_isoconc_ID, & - VACANCYFLUX_isochempot_ID, & - VACANCYFLUX_cahnhilliard_ID, & - POROSITY_none_ID, & - POROSITY_phasefield_ID, & - HYDROGENFLUX_isoconc_ID, & - HYDROGENFLUX_cahnhilliard_ID, & HOMOGENIZATION_none_ID, & HOMOGENIZATION_isostrain_ID, & HOMOGENIZATION_RGC_ID @@ -420,25 +350,14 @@ subroutine material_init() allocate(homogState (size(config_homogenization))) allocate(thermalState (size(config_homogenization))) allocate(damageState (size(config_homogenization))) - allocate(vacancyfluxState (size(config_homogenization))) - allocate(porosityState (size(config_homogenization))) - allocate(hydrogenfluxState (size(config_homogenization))) allocate(thermalMapping (size(config_homogenization))) allocate(damageMapping (size(config_homogenization))) - allocate(vacancyfluxMapping (size(config_homogenization))) - allocate(porosityMapping (size(config_homogenization))) - allocate(hydrogenfluxMapping(size(config_homogenization))) allocate(temperature (size(config_homogenization))) allocate(damage (size(config_homogenization))) - allocate(vacancyConc (size(config_homogenization))) - allocate(porosity (size(config_homogenization))) - allocate(hydrogenConc (size(config_homogenization))) allocate(temperatureRate (size(config_homogenization))) - allocate(vacancyConcRate (size(config_homogenization))) - allocate(hydrogenConcRate (size(config_homogenization))) do m = 1_pInt,size(config_microstructure) if(microstructure_crystallite(m) < 1_pInt .or. & @@ -511,17 +430,9 @@ subroutine material_init() do myHomog = 1,size(config_homogenization) thermalMapping (myHomog)%p => mappingHomogenizationConst damageMapping (myHomog)%p => mappingHomogenizationConst - vacancyfluxMapping (myHomog)%p => mappingHomogenizationConst - porosityMapping (myHomog)%p => mappingHomogenizationConst - hydrogenfluxMapping(myHomog)%p => mappingHomogenizationConst allocate(temperature (myHomog)%p(1), source=thermal_initialT(myHomog)) allocate(damage (myHomog)%p(1), source=damage_initialPhi(myHomog)) - allocate(vacancyConc (myHomog)%p(1), source=vacancyflux_initialCv(myHomog)) - allocate(porosity (myHomog)%p(1), source=porosity_initialPhi(myHomog)) - allocate(hydrogenConc (myHomog)%p(1), source=hydrogenflux_initialCh(myHomog)) allocate(temperatureRate (myHomog)%p(1), source=0.0_pReal) - allocate(vacancyConcRate (myHomog)%p(1), source=0.0_pReal) - allocate(hydrogenConcRate(myHomog)%p(1), source=0.0_pReal) enddo end subroutine material_init @@ -545,23 +456,14 @@ subroutine material_parseHomogenization allocate(homogenization_type(size(config_homogenization)), source=HOMOGENIZATION_undefined_ID) allocate(thermal_type(size(config_homogenization)), source=THERMAL_isothermal_ID) allocate(damage_type (size(config_homogenization)), source=DAMAGE_none_ID) - allocate(vacancyflux_type(size(config_homogenization)), source=VACANCYFLUX_isoconc_ID) - allocate(porosity_type (size(config_homogenization)), source=POROSITY_none_ID) - allocate(hydrogenflux_type(size(config_homogenization)), source=HYDROGENFLUX_isoconc_ID) allocate(homogenization_typeInstance(size(config_homogenization)), source=0_pInt) allocate(thermal_typeInstance(size(config_homogenization)), source=0_pInt) allocate(damage_typeInstance(size(config_homogenization)), source=0_pInt) - allocate(vacancyflux_typeInstance(size(config_homogenization)), source=0_pInt) - allocate(porosity_typeInstance(size(config_homogenization)), source=0_pInt) - allocate(hydrogenflux_typeInstance(size(config_homogenization)), source=0_pInt) allocate(homogenization_Ngrains(size(config_homogenization)), source=0_pInt) allocate(homogenization_Noutput(size(config_homogenization)), source=0_pInt) allocate(homogenization_active(size(config_homogenization)), source=.false.) !!!!!!!!!!!!!!! allocate(thermal_initialT(size(config_homogenization)), source=300.0_pReal) allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal) - allocate(vacancyflux_initialCv(size(config_homogenization)), source=0.0_pReal) - allocate(porosity_initialPhi(size(config_homogenization)), source=1.0_pReal) - allocate(hydrogenflux_initialCh(size(config_homogenization)), source=0.0_pReal) forall (h = 1_pInt:size(config_homogenization)) & homogenization_active(h) = any(mesh_homogenizationAt == h) @@ -620,53 +522,6 @@ subroutine material_parseHomogenization end select endif - - if (config_homogenization(h)%keyExists('vacancyflux')) then - vacancyflux_initialCv(h) = config_homogenization(h)%getFloat('cv0',defaultVal=0.0_pReal) - - tag = config_homogenization(h)%getString('vacancyflux') - select case (trim(tag)) - case(VACANCYFLUX_isoconc_label) - vacancyflux_type(h) = VACANCYFLUX_isoconc_ID - case(VACANCYFLUX_isochempot_label) - vacancyflux_type(h) = VACANCYFLUX_isochempot_ID - case(VACANCYFLUX_cahnhilliard_label) - vacancyflux_type(h) = VACANCYFLUX_cahnhilliard_ID - case default - call IO_error(500_pInt,ext_msg=trim(tag)) - end select - - endif - - if (config_homogenization(h)%keyExists('porosity')) then - !ToDo? - - tag = config_homogenization(h)%getString('porosity') - select case (trim(tag)) - case(POROSITY_NONE_label) - porosity_type(h) = POROSITY_none_ID - case(POROSITY_phasefield_label) - porosity_type(h) = POROSITY_phasefield_ID - case default - call IO_error(500_pInt,ext_msg=trim(tag)) - end select - - endif - - if (config_homogenization(h)%keyExists('hydrogenflux')) then - hydrogenflux_initialCh(h) = config_homogenization(h)%getFloat('ch0',defaultVal=0.0_pReal) - - tag = config_homogenization(h)%getString('hydrogenflux') - select case (trim(tag)) - case(HYDROGENFLUX_isoconc_label) - hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID - case(HYDROGENFLUX_cahnhilliard_label) - hydrogenflux_type(h) = HYDROGENFLUX_cahnhilliard_ID - case default - call IO_error(500_pInt,ext_msg=trim(tag)) - end select - - endif enddo @@ -674,9 +529,6 @@ subroutine material_parseHomogenization homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h)) thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h)) damage_typeInstance(h) = count(damage_type (1:h) == damage_type (h)) - vacancyflux_typeInstance(h) = count(vacancyflux_type (1:h) == vacancyflux_type (h)) - porosity_typeInstance(h) = count(porosity_type (1:h) == porosity_type (h)) - hydrogenflux_typeInstance(h) = count(hydrogenflux_type (1:h) == hydrogenflux_type (h)) enddo homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active) @@ -866,12 +718,6 @@ subroutine material_parsePhase phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID case (SOURCE_damage_anisoDuctile_label) phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID - case (SOURCE_vacancy_phenoplasticity_label) - phase_source(sourceCtr,p) = SOURCE_vacancy_phenoplasticity_ID - case (SOURCE_vacancy_irradiation_label) - phase_source(sourceCtr,p) = SOURCE_vacancy_irradiation_ID - case (SOURCE_vacancy_thermalfluc_label) - phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID end select enddo @@ -890,10 +736,6 @@ subroutine material_parsePhase phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID case (KINEMATICS_thermal_expansion_label) phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID - case (KINEMATICS_vacancy_strain_label) - phase_kinematics(kinematicsCtr,p) = KINEMATICS_vacancy_strain_ID - case (KINEMATICS_hydrogen_strain_label) - phase_kinematics(kinematicsCtr,p) = KINEMATICS_hydrogen_strain_ID end select enddo #if defined(__GFORTRAN__) @@ -907,8 +749,6 @@ subroutine material_parsePhase select case (trim(str(stiffDegradationCtr))) case (STIFFNESS_DEGRADATION_damage_label) phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID - case (STIFFNESS_DEGRADATION_porosity_label) - phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_porosity_ID end select enddo enddo diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 9006b092d..9d8703277 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -3,8 +3,7 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author David Cereceda, Lawrence Livermore National Laboratory !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine incoprorating dislocation and twinning physics -!> @details to be done +!> @brief crystal plasticity model for bcc metals, especially Tungsten !-------------------------------------------------------------------------------------------------- module plastic_disloUCLA use prec, only: & @@ -15,7 +14,6 @@ module plastic_disloUCLA private integer(pInt), dimension(:,:), allocatable, target, public :: & plastic_disloUCLA_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & plastic_disloUCLA_output !< name of each post result output @@ -23,50 +21,49 @@ module plastic_disloUCLA kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin enum, bind(c) - enumerator :: undefined_ID, & + enumerator :: & + undefined_ID, & rho_ID, & rhoDip_ID, & shearrate_ID, & accumulatedshear_ID, & mfp_ID, & - resolvedstress_ID, & thresholdstress_ID, & - dipoledistance_ID, & - stressexponent_ID + dipoledistance_ID end enum type, private :: tParameters real(pReal) :: & aTolRho, & grainSize, & - SolidSolutionStrength, & !< Strength due to elements in solid solution + SolidSolutionStrength, & !< Strength due to elements in solid solution mu, & - D0, & !< prefactor for self-diffusion coefficient - Qsd !< activation energy for dislocation climb + D0, & !< prefactor for self-diffusion coefficient + Qsd !< activation energy for dislocation climb real(pReal), allocatable, dimension(:) :: & - rho0, & !< initial edge dislocation density per slip system for each family and instance - rhoDip0, & !< initial edge dipole density per slip system for each family and instance - burgers, & !< absolute length of burgers vector [m] for each slip system and instance + rho0, & !< initial edge dislocation density + rhoDip0, & !< initial edge dipole density + burgers, & !< absolute length of burgers vector [m] nonSchmidCoeff, & minDipDistance, & - CLambda, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance + CLambda, & !< Adj. parameter for distance between 2 forest dislocations atomicVolume, & + tau_Peierls, & + tau0, & !* mobility law parameters - H0kp, & !< activation energy for glide [J] for each slip system and instance - v0, & !< dislocation velocity prefactor [m/s] for each family and instance - p, & !< p-exponent in glide velocity - q, & !< q-exponent in glide velocity - B, & !< friction coeff. B (kMC) - kink_height, & !< height of the kink pair - kink_width, & !< width of the kink pair - omega, & !< attempt frequency for kink pair nucleation - tau_Peierls + H0kp, & !< activation energy for glide [J] + v0, & !< dislocation velocity prefactor [m/s] + p, & !< p-exponent in glide velocity + q, & !< q-exponent in glide velocity + B, & !< friction coefficient + kink_height, & !< height of the kink pair + w, & !< width of the kink pair + omega !< attempt frequency for kink pair nucleation real(pReal), allocatable, dimension(:,:) :: & - interaction_SlipSlip, & !< slip resistance from slip activity + interaction_SlipSlip, & !< slip resistance from slip activity forestProjectionEdge real(pReal), allocatable, dimension(:,:,:) :: & - Schmid_slip, & - Schmid_twin, & + Schmid, & nonSchmid_pos, & nonSchmid_neg integer(pInt) :: & @@ -79,26 +76,25 @@ module plastic_disloUCLA dipoleformation end type !< container type for internal constitutive parameters - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) - type, private :: tDisloUCLAState real(pReal), pointer, dimension(:,:) :: & rhoEdge, & rhoEdgeDip, & - accshear_slip, & - whole + accshear end type type, private :: tDisloUCLAdependentState - real(pReal), allocatable, dimension(:,:) :: & + real(pReal), allocatable, dimension(:,:) :: & mfp, & + dislocationSpacing, & threshold_stress end type tDisloUCLAdependentState - type(tDisloUCLAState ), allocatable, dimension(:), private :: & - state, & - dotState + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tDisloUCLAState ), allocatable, dimension(:), private :: & + dotState, & + state type(tDisloUCLAdependentState), allocatable, dimension(:), private :: & dependentState @@ -111,7 +107,6 @@ module plastic_disloUCLA private :: & kinetics - contains @@ -141,42 +136,46 @@ subroutine plastic_disloUCLA_init() phase_plasticity, & phase_plasticityInstance, & phase_Noutput, & + material_allocatePlasticState, & PLASTICITY_DISLOUCLA_label, & PLASTICITY_DISLOUCLA_ID, & material_phase, & - plasticState, & - material_allocatePlasticState + plasticState use config, only: & MATERIAL_partPhase, & config_phase use lattice implicit none - integer(pInt) :: Ninstance,& - f,j,k,o, i, & - outputSize, & - offset_slip, index_myFamily, index_otherFamily, & - startIndex, endIndex, p, & - sizeState, sizeDotState, & - NipcMyPhase - character(len=pStringLen) :: & - structure = '',& - extmsg = '' - character(len=65536), dimension(:), allocatable :: outputs - integer(kind(undefined_ID)) :: outputID + integer(pInt) :: & + index_myFamily, index_otherFamily, & + f,j,k,o, & + Ninstance, & + p, i, & + NipcMyPhase, & + sizeState, sizeDotState, & + startIndex, endIndex + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOUCLA_label//' init -+>>>' + integer(kind(undefined_ID)) :: & + outputID + + character(len=pStringLen) :: & + structure = '',& + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_DISLOUCLA_label//' init -+>>>' write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78, 2016, 242-256' write(6,'(/,a)') ' http://dx.doi.org/10.1016/j.ijplas.2015.09.002' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" Ninstance = int(count(phase_plasticity == PLASTICITY_DISLOUCLA_ID),pInt) - if (Ninstance == 0_pInt) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance @@ -190,60 +189,68 @@ subroutine plastic_disloUCLA_init() allocate(dependentState(Ninstance)) - do p = 1_pInt, size(phase_plasticityInstance) + do p = 1_pInt, size(phase_plasticity) if (phase_plasticity(p) /= PLASTICITY_DISLOUCLA_ID) cycle associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & stt => state(phase_plasticityInstance(p)), & - dst => dependentState(phase_plasticityInstance(p))) + dst => dependentState(phase_plasticityInstance(p)), & + config => config_phase(p)) - structure = config_phase(p)%getString('lattice_structure') + structure = config%getString('lattice_structure') + +!-------------------------------------------------------------------------------------------------- +! optional parameters that need to be defined prm%mu = lattice_mu(p) - prm%aTolRho = config_phase(p)%getFloat('atol_rho') + prm%aTolRho = config%getFloat('atol_rho') + + ! sanity checks + if (prm%aTolRho <= 0.0_pReal) extmsg = trim(extmsg)//' atol_rho' + !-------------------------------------------------------------------------------------------------- ! slip related parameters - prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) + prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then - prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& - config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& + config%getFloat('c/a',defaultVal=0.0_pReal)) if(structure=='bcc') then - prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',& - defaultVal = emptyRealArray) + prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray) prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) else - prm%nonSchmid_pos = prm%Schmid_slip - prm%nonSchmid_neg = prm%Schmid_slip + prm%nonSchmid_pos = prm%Schmid + prm%nonSchmid_neg = prm%Schmid endif prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & - config_phase(p)%getFloats('interaction_slipslip'), & + config%getFloats('interaction_slipslip'), & structure(1:3)) - prm%rho0 = config_phase(p)%getFloats('rhoedge0', requiredShape=shape(prm%Nslip)) - prm%rhoDip0 = config_phase(p)%getFloats('rhoedgedip0', requiredShape=shape(prm%Nslip)) - prm%v0 = config_phase(p)%getFloats('v0', requiredShape=shape(prm%Nslip)) - prm%burgers = config_phase(p)%getFloats('slipburgers', requiredShape=shape(prm%Nslip)) - prm%H0kp = config_phase(p)%getFloats('qedge', requiredShape=shape(prm%Nslip)) + prm%rho0 = config%getFloats('rhoedge0', requiredShape=shape(prm%Nslip)) + prm%rhoDip0 = config%getFloats('rhoedgedip0', requiredShape=shape(prm%Nslip)) + prm%v0 = config%getFloats('v0', requiredShape=shape(prm%Nslip)) + prm%burgers = config%getFloats('slipburgers', requiredShape=shape(prm%Nslip)) + prm%H0kp = config%getFloats('qedge', requiredShape=shape(prm%Nslip)) - prm%clambda = config_phase(p)%getFloats('clambdaslip', requiredShape=shape(prm%Nslip)) - prm%tau_Peierls = config_phase(p)%getFloats('tau_peierls', requiredShape=shape(prm%Nslip)) - prm%p = config_phase(p)%getFloats('p_slip', requiredShape=shape(prm%Nslip), & - defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%q = config_phase(p)%getFloats('q_slip', requiredShape=shape(prm%Nslip), & - defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%kink_height = config_phase(p)%getFloats('kink_height', requiredShape=shape(prm%Nslip)) - prm%kink_width = config_phase(p)%getFloats('kink_width', requiredShape=shape(prm%Nslip)) - prm%omega = config_phase(p)%getFloats('omega', requiredShape=shape(prm%Nslip)) - prm%B = config_phase(p)%getFloats('friction_coeff', requiredShape=shape(prm%Nslip)) + prm%clambda = config%getFloats('clambdaslip', requiredShape=shape(prm%Nslip)) + prm%tau_Peierls = config%getFloats('tau_peierls', requiredShape=shape(prm%Nslip)) ! ToDo: Deprecated + prm%p = config%getFloats('p_slip', requiredShape=shape(prm%Nslip), & + defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%q = config%getFloats('q_slip', requiredShape=shape(prm%Nslip), & + defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%kink_height = config%getFloats('kink_height', requiredShape=shape(prm%Nslip)) + prm%w = config%getFloats('kink_width', requiredShape=shape(prm%Nslip)) + prm%omega = config%getFloats('omega', requiredShape=shape(prm%Nslip)) + prm%B = config%getFloats('friction_coeff', requiredShape=shape(prm%Nslip)) - prm%SolidSolutionStrength = config_phase(p)%getFloat('solidsolutionstrength') - prm%grainSize = config_phase(p)%getFloat('grainsize') - prm%D0 = config_phase(p)%getFloat('d0') - prm%Qsd = config_phase(p)%getFloat('qsd') - prm%atomicVolume = config_phase(p)%getFloat('catomicvolume') * prm%burgers**3.0_pReal - prm%minDipDistance = config_phase(p)%getFloat('cedgedipmindistance') * prm%burgers - prm%dipoleformation = config_phase(p)%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default + prm%SolidSolutionStrength = config%getFloat('solidsolutionstrength') ! ToDo: Deprecated + prm%grainSize = config%getFloat('grainsize') + prm%D0 = config%getFloat('d0') + prm%Qsd = config%getFloat('qsd') + prm%atomicVolume = config%getFloat('catomicvolume') * prm%burgers**3.0_pReal + prm%minDipDistance = config%getFloat('cedgedipmindistance') * prm%burgers + prm%dipoleformation = config%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default, ToDo: change to /key/-key ! expand: family => system prm%rho0 = math_expand(prm%rho0, prm%Nslip) @@ -253,7 +260,7 @@ subroutine plastic_disloUCLA_init() prm%H0kp = math_expand(prm%H0kp, prm%Nslip) prm%burgers = math_expand(prm%burgers, prm%Nslip) prm%kink_height = math_expand(prm%kink_height, prm%Nslip) - prm%kink_width = math_expand(prm%kink_width, prm%Nslip) + prm%w = math_expand(prm%w, prm%Nslip) prm%omega = math_expand(prm%omega, prm%Nslip) prm%tau_Peierls = math_expand(prm%tau_Peierls, prm%Nslip) prm%v0 = math_expand(prm%v0, prm%Nslip) @@ -262,42 +269,38 @@ subroutine plastic_disloUCLA_init() prm%atomicVolume = math_expand(prm%atomicVolume, prm%Nslip) prm%minDipDistance = math_expand(prm%minDipDistance, prm%Nslip) + prm%tau0 = prm%tau_peierls + prm%SolidSolutionStrength + ! sanity checks - if (any(prm%rho0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedge0' - if (any(prm%rhoDip0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedgedip0' - if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//' v0' - if (any(prm%burgers <= 0.0_pReal)) extmsg = trim(extmsg)//' slipburgers' - if (any(prm%H0kp <= 0.0_pReal)) extmsg = trim(extmsg)//' qedge' - if (any(prm%tau_peierls < 0.0_pReal)) extmsg = trim(extmsg)//' tau_peierls' - - if ( prm%D0 <= 0.0_pReal) extmsg = trim(extmsg)//' d0' - if ( prm%Qsd <= 0.0_pReal) extmsg = trim(extmsg)//' qsd' - - !if (plastic_disloUCLA_CAtomicVolume(instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOUCLA_label//')') - - ! if (plastic_disloUCLA_aTolRho(instance) <= 0.0_pReal) & - ! call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOUCLA_label//')') + if ( prm%D0 <= 0.0_pReal) extmsg = trim(extmsg)//' d0' + if ( prm%Qsd <= 0.0_pReal) extmsg = trim(extmsg)//' qsd' + if (any(prm%rho0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedge0' + if (any(prm%rhoDip0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedgedip0' + if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//' v0' + if (any(prm%burgers <= 0.0_pReal)) extmsg = trim(extmsg)//' slipburgers' + if (any(prm%H0kp <= 0.0_pReal)) extmsg = trim(extmsg)//' qedge' + if (any(prm%tau_peierls < 0.0_pReal)) extmsg = trim(extmsg)//' tau_peierls' + if (any(prm%minDipDistance <= 0.0_pReal)) extmsg = trim(extmsg)//' cedgedipmindistance or slipburgers' + if (any(prm%atomicVolume <= 0.0_pReal)) extmsg = trim(extmsg)//' catomicvolume or slipburgers' else slipActive allocate(prm%rho0(0)) allocate(prm%rhoDip0(0)) endif slipActive +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') & + call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//PLASTICITY_DISLOUCLA_label//')') -#if defined(__GFORTRAN__) - outputs = ['GfortranBug86277'] - outputs = config_phase(p)%getStrings('(output)',defaultVal=outputs) - if (outputs(1) == 'GfortranBug86277') outputs = emptyStringArray -#else - outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) -#endif +!-------------------------------------------------------------------------------------------------- +! output pararameters + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) - - do i = 1_pInt, size(outputs) + do i=1_pInt, size(outputs) outputID = undefined_ID - outputSize = prm%totalNslip select case(trim(outputs(i))) + case ('edge_density') outputID = merge(rho_ID,undefined_ID,prm%totalNslip>0_pInt) case ('dipole_density') @@ -308,39 +311,33 @@ subroutine plastic_disloUCLA_init() outputID = merge(accumulatedshear_ID,undefined_ID,prm%totalNslip>0_pInt) case ('mfp','mfp_slip') outputID = merge(mfp_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('resolved_stress','resolved_stress_slip') - outputID = merge(resolvedstress_ID,undefined_ID,prm%totalNslip>0_pInt) case ('threshold_stress','threshold_stress_slip') outputID = merge(thresholdstress_ID,undefined_ID,prm%totalNslip>0_pInt) case ('edge_dipole_distance') outputID = merge(dipoleDistance_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('stress_exponent') - outputID = merge(stressexponent_ID,undefined_ID,prm%totalNslip>0_pInt) + end select if (outputID /= undefined_ID) then plastic_disloUCLA_output(i,phase_plasticityInstance(p)) = outputs(i) - plastic_disloUCLA_sizePostResult(i,phase_plasticityInstance(p)) = outputSize + plastic_disloUCLA_sizePostResult(i,phase_plasticityInstance(p)) = prm%totalNslip prm%outputID = [prm%outputID, outputID] endif enddo - NipcMyPhase=count(material_phase==p) - !-------------------------------------------------------------------------------------------------- ! allocate state arrays - + NipcMyPhase = count(material_phase == p) sizeDotState = int(size(['rhoEdge ','rhoEdgeDip ','accshearslip']),pInt) * prm%totalNslip - sizeState = sizeDotState + sizeState = sizeDotState call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, & prm%totalNslip,0_pInt,0_pInt) - plasticState(p)%sizePostResults = sum(plastic_disloUCLA_sizePostResult(:,phase_plasticityInstance(p))) allocate(prm%forestProjectionEdge(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) - + i = 0_pInt mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(prm%Nslip(1:f-1_pInt)) @@ -355,114 +352,86 @@ subroutine plastic_disloUCLA_init() lattice_st(:,sum(lattice_NslipSystem(1:o-1,p))+k,p))) enddo; enddo enddo slipSystemsLoop - enddo mySlipFamilies + enddo mySlipFamilies - offset_slip = 2_pInt*plasticState(p)%nSlip - plasticState(p)%slipRate => & - plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) - plasticState(p)%accumulatedSlip => & - plasticState(p)%state (offset_slip+1:offset_slip+plasticState(p)%nSlip,1:NipcMyPhase) - - startIndex=1_pInt - endIndex=prm%totalNslip +!-------------------------------------------------------------------------------------------------- +! locally defined state aliases and initialization of state0 and aTolState + startIndex = 1_pInt + endIndex = prm%totalNslip stt%rhoEdge=>plasticState(p)%state(startIndex:endIndex,:) stt%rhoEdge= spread(prm%rho0,2,NipcMyPhase) dot%rhoEdge=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho - startIndex=endIndex+1_pInt - endIndex=endIndex+prm%totalNslip + startIndex = endIndex + 1_pInt + endIndex = endIndex + prm%totalNslip stt%rhoEdgeDip=>plasticState(p)%state(startIndex:endIndex,:) stt%rhoEdgeDip= spread(prm%rhoDip0,2,NipcMyPhase) dot%rhoEdgeDip=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho - startIndex=endIndex+1_pInt - endIndex=endIndex+prm%totalNslip - stt%accshear_slip=>plasticState(p)%state(startIndex:endIndex,:) - dot%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal + startIndex = endIndex + 1_pInt + endIndex = endIndex + prm%totalNslip + stt%accshear=>plasticState(p)%state(startIndex:endIndex,:) + dot%accshear=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal !ToDo: better make optional parameter + ! global alias + plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%accumulatedSlip => plasticState(p)%state(startIndex:endIndex,:) - dot%whole => plasticState(p)%dotState + allocate(dst%mfp(prm%totalNslip,NipcMyPhase), source=0.0_pReal) + allocate(dst%dislocationSpacing(prm%totalNslip,NipcMyPhase),source=0.0_pReal) + allocate(dst%threshold_stress(prm%totalNslip,NipcMyPhase), source=0.0_pReal) + plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally - allocate(dst%mfp(prm%totalNslip,NipcMyPhase),source=0.0_pReal) - allocate(dst%threshold_stress(prm%totalNslip,NipcMyPhase),source=0.0_pReal) - - - plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally end associate + enddo end subroutine plastic_disloUCLA_init -!-------------------------------------------------------------------------------------------------- -!> @brief calculates derived quantities from state -!-------------------------------------------------------------------------------------------------- -subroutine plastic_disloUCLA_dependentState(instance,of) - - implicit none - integer(pInt), intent(in) :: instance, of - - integer(pInt) :: & - i - real(pReal), dimension(param(instance)%totalNslip) :: & - invLambdaSlip ! 1/mean free distance between 2 forest dislocations seen by a moving dislocation - - associate(prm => param(instance), stt => state(instance),dst => dependentState(instance)) - - forall (i = 1_pInt:prm%totalNslip) - invLambdaSlip(i) = sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), & - prm%forestProjectionEdge(:,i))) & - / prm%Clambda(i) - dst%threshold_stress(i,of) = prm%mu*prm%burgers(i) & - * sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), & - prm%interaction_SlipSlip(i,:))) - end forall - - dst%mfp(:,of) = prm%grainSize/(1.0_pReal+prm%grainSize*invLambdaSlip) - end associate - - -end subroutine plastic_disloUCLA_dependentState - - !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- pure subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance,of) implicit none - integer(pInt), intent(in) :: instance, of - real(pReal), intent(in) :: Temperature - real(pReal), dimension(3,3), intent(in) :: Mp - real(pReal), dimension(3,3), intent(out) :: Lp - real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp + real(pReal), dimension(3,3), intent(out) :: & + Lp !< plastic velocity gradient + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp !< derivative of Lp with respect to the Mandel stress - integer(pInt) :: i,k,l,m,n + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + temperature !< temperature + integer(pInt), intent(in) :: & + instance, & + of + integer(pInt) :: & + i,k,l,m,n real(pReal), dimension(param(instance)%totalNslip) :: & - gdot_slip_pos,gdot_slip_neg,tau_slip_pos,tau_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg - - associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) + gdot_pos,gdot_neg, & + dgdot_dtau_pos,dgdot_dtau_neg Lp = 0.0_pReal dLp_dMp = 0.0_pReal - call kinetics(prm,stt,dst,Mp,Temperature,of, & - gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) - slipSystems: do i = 1_pInt, prm%totalNslip - Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i) + associate(prm => param(instance)) + + call kinetics(Mp,Temperature,instance,of,gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg) + do i = 1_pInt, prm%totalNslip + Lp = Lp + (gdot_pos(i)+gdot_neg(i))*prm%Schmid(1:3,1:3,i) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & - + dgdot_dtauslip_pos(i) * prm%Schmid_slip(k,l,i) * prm%nonSchmid_pos(m,n,i) & - + dgdot_dtauslip_neg(i) * prm%Schmid_slip(k,l,i) * prm%nonSchmid_neg(m,n,i) - enddo slipSystems - end associate + + dgdot_dtau_pos(i) * prm%Schmid(k,l,i) * prm%nonSchmid_pos(m,n,i) & + + dgdot_dtau_neg(i) * prm%Schmid(k,l,i) * prm%nonSchmid_neg(m,n,i) + enddo - Lp = 0.5_pReal * Lp - dLp_dMp = 0.5_pReal * dLp_dMp + end associate end subroutine plastic_disloUCLA_LpAndItsTangent @@ -479,61 +448,90 @@ subroutine plastic_disloUCLA_dotState(Mp,Temperature,instance,of) math_clip implicit none - real(pReal), dimension(3,3), intent(in):: & - Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), intent(in) :: & - temperature !< temperature at integration point - integer(pInt), intent(in) :: & - instance, of + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + temperature !< temperature + integer(pInt), intent(in) :: & + instance, & + of real(pReal) :: & VacancyDiffusion real(pReal), dimension(param(instance)%totalNslip) :: & - gdot_slip_pos, gdot_slip_neg,& - tau_slip_pos,& - tau_slip_neg, & - dgdot_dtauslip_neg,dgdot_dtauslip_pos,DotRhoDipFormation, ClimbVelocity, EdgeDipDistance, & + gdot_pos, gdot_neg,& + tau_pos,& + tau_neg, & + DotRhoDipFormation, ClimbVelocity, EdgeDipDistance, & DotRhoEdgeDipClimb associate(prm => param(instance), stt => state(instance),dot => dotState(instance), dst => dependentState(instance)) - call kinetics(prm,stt,dst,Mp,Temperature,of, & - gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) - - dot%whole(:,of) = 0.0_pReal - dot%accshear_slip(:,of) = (gdot_slip_pos+gdot_slip_neg)*0.5_pReal + call kinetics(Mp,Temperature,instance,of,& + gdot_pos,gdot_neg, & + tau_pos1 = tau_pos,tau_neg1 = tau_neg) + dot%accshear(:,of) = (gdot_pos+gdot_neg) ! ToDo: needs to be abs VacancyDiffusion = prm%D0*exp(-prm%Qsd/(kB*Temperature)) - where(dEq0(tau_slip_pos)) - EdgeDipDistance = dst%mfp(:,of) !ToDo MD@FR: correct? was not handled properly before + where(dEq0(tau_pos)) ! ToDo: use avg of pos and neg DotRhoDipFormation = 0.0_pReal DotRhoEdgeDipClimb = 0.0_pReal else where - EdgeDipDistance = math_clip((3.0_pReal*prm%mu*prm%burgers)/(16.0_pReal*PI*abs(tau_slip_pos)), & - prm%minDipDistance, & ! lower limit - dst%mfp(:,of)) ! upper limit - DotRhoDipFormation = merge(((2.0_pReal*EdgeDipDistance)/prm%burgers)* stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)), & + EdgeDipDistance = math_clip((3.0_pReal*prm%mu*prm%burgers)/(16.0_pReal*PI*abs(tau_pos)), & + prm%minDipDistance, & ! lower limit + dst%mfp(:,of)) ! upper limit + DotRhoDipFormation = merge(((2.0_pReal*EdgeDipDistance)/prm%burgers)* stt%rhoEdge(:,of)*abs(dot%accshear(:,of)), & ! ToDo: ignore region of spontaneous annihilation 0.0_pReal, & prm%dipoleformation) ClimbVelocity = (3.0_pReal*prm%mu*VacancyDiffusion*prm%atomicVolume/(2.0_pReal*pi*kB*Temperature)) & * (1.0_pReal/(EdgeDipDistance+prm%minDipDistance)) - DotRhoEdgeDipClimb = (4.0_pReal*ClimbVelocity*stt%rhoEdgeDip(:,of))/(EdgeDipDistance-prm%minDipDistance) + DotRhoEdgeDipClimb = (4.0_pReal*ClimbVelocity*stt%rhoEdgeDip(:,of))/(EdgeDipDistance-prm%minDipDistance) ! ToDo: Discuss with Franz: Stress dependency? end where - dot%rhoEdge(:,of) = abs(dot%accshear_slip(:,of))/(prm%burgers*dst%mfp(:,of)) & ! multiplication + dot%rhoEdge(:,of) = abs(dot%accshear(:,of))/(prm%burgers*dst%mfp(:,of)) & ! multiplication - DotRhoDipFormation & - - (2.0_pReal*prm%minDipDistance)/prm%burgers*stt%rhoEdge(:,of)*abs(dot%accshear_slip(:,of)) !* Spontaneous annihilation of 2 single edge dislocations - + - (2.0_pReal*prm%minDipDistance)/prm%burgers*stt%rhoEdge(:,of)*abs(dot%accshear(:,of)) !* Spontaneous annihilation of 2 single edge dislocations dot%rhoEdgeDip(:,of) = DotRhoDipFormation & - - (2.0_pReal*prm%minDipDistance)/prm%burgers* stt%rhoEdgeDip(:,of)*abs(dot%accshear_slip(:,of)) & !* Spontaneous annihilation of a single edge dislocation with a dipole constituent + - (2.0_pReal*prm%minDipDistance)/prm%burgers*stt%rhoEdgeDip(:,of)*abs(dot%accshear(:,of)) & !* Spontaneous annihilation of a single edge dislocation with a dipole constituent - DotRhoEdgeDipClimb -end associate + end associate end subroutine plastic_disloUCLA_dotState +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine plastic_disloUCLA_dependentState(instance,of) + + implicit none + integer(pInt), intent(in) :: & + instance, & + of + + integer(pInt) :: & + i + + associate(prm => param(instance), stt => state(instance),dst => dependentState(instance)) + + forall (i = 1_pInt:prm%totalNslip) + dst%dislocationSpacing(i,of) = sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), & + prm%forestProjectionEdge(:,i))) + dst%threshold_stress(i,of) = prm%mu*prm%burgers(i) & + * sqrt(dot_product(stt%rhoEdge(:,of)+stt%rhoEdgeDip(:,of), & + prm%interaction_SlipSlip(i,:))) + end forall + + dst%mfp(:,of) = prm%grainSize/(1.0_pReal+prm%grainSize*dst%dislocationSpacing(:,of)/prm%Clambda) + dst%dislocationSpacing(:,of) = dst%mfp(:,of) ! ToDo: Hack to recover wrong behavior for the moment + + end associate + +end subroutine plastic_disloUCLA_dependentState + + !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- @@ -541,14 +539,14 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe use prec, only: & dEq, dNeq0 use math, only: & - pi, & + PI, & math_mul33xx33 implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & - Temperature !< Mandel stress + temperature !< temperature integer(pInt), intent(in) :: & instance, & of @@ -559,14 +557,12 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe integer(pInt) :: & o,c,i real(pReal), dimension(param(instance)%totalNslip) :: & - gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos, & - gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg + gdot_pos,gdot_neg + + c = 0_pInt associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) - postResults = 0.0_pReal - c = 0_pInt - outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) @@ -574,32 +570,16 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdge(1_pInt:prm%totalNslip,of) case (rhoDip_ID) postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdgeDip(1_pInt:prm%totalNslip,of) - case (shearrate_ID,stressexponent_ID) - call kinetics(prm,stt,dst,Mp,Temperature,of, & - gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) - - if (prm%outputID(o) == shearrate_ID) then - postResults(c+1:c+prm%totalNslip) = (gdot_slip_pos + gdot_slip_neg)*0.5_pReal - elseif(prm%outputID(o) == stressexponent_ID) then - where (dNeq0(gdot_slip_pos+gdot_slip_neg)) - postResults(c+1_pInt:c + prm%totalNslip) = (tau_slip_pos+tau_slip_neg) * 0.5_pReal & - / (gdot_slip_pos+gdot_slip_neg) & - * (dgdot_dtauslip_pos+dgdot_dtauslip_neg) - else where - postResults(c+1_pInt:c + prm%totalNslip) = 0.0_pReal - end where - endif + case (shearrate_ID) + call kinetics(Mp,Temperature,instance,of,gdot_pos,gdot_neg) + postResults(c+1:c+prm%totalNslip) = gdot_pos + gdot_neg case (accumulatedshear_ID) - postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1_pInt:prm%totalNslip, of) + postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear(1_pInt:prm%totalNslip, of) case (mfp_ID) postResults(c+1_pInt:c+prm%totalNslip) = dst%mfp(1_pInt:prm%totalNslip, of) - case (resolvedstress_ID) - do i = 1_pInt, prm%totalNslip - postResults(c+i) =math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i)) - enddo case (thresholdstress_ID) postResults(c+1_pInt:c+prm%totalNslip) = dst%threshold_stress(1_pInt:prm%totalNslip,of) - case (dipoleDistance_ID) + case (dipoleDistance_ID) ! ToDo: Discuss required changes with Franz do i = 1_pInt, prm%totalNslip if (dNeq0(abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i))))) then postResults(c+i) = (3.0_pReal*prm%mu*prm%burgers(i)) & @@ -609,183 +589,161 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe endif postResults(c+i)=min(postResults(c+i),dst%mfp(i,of)) enddo + end select c = c + prm%totalNslip + enddo outputsLoop + end associate end function plastic_disloUCLA_postResults !-------------------------------------------------------------------------------------------------- -!> @brief return array of constitutive results +!> @brief Shear rates on slip systems, their derivatives with respect to resolved stress and the +! resolved stresss +!> @details Derivatives and resolved stress are calculated only optionally. +! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to +! have the optional arguments at the end !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics(prm,stt,dst,Mp,Temperature,of, & - gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg) +pure subroutine kinetics(Mp,Temperature,instance,of, & + gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg,tau_pos1,tau_neg1) use prec, only: & tol_math_check, & dEq, dNeq0 use math, only: & - pi, & -math_mul33xx33 + PI, & + math_mul33xx33 implicit none - type(tParameters), intent(in) :: & - prm - type(tDisloUCLAState), intent(in) :: & - stt - type(tDisloUCLAdependentState), intent(in) :: & - dst real(pReal), dimension(3,3), intent(in) :: & - Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), intent(in) :: & - temperature !< temperature at integration point - integer(pInt), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + temperature !< temperature + integer(pInt), intent(in) :: & + instance, & of - integer(pInt) :: & - j - real(pReal), intent(out), dimension(prm%totalNslip) :: & - gdot_slip_pos,dgdot_dtauslip_pos,tau_slip_pos,gdot_slip_neg,dgdot_dtauslip_neg,tau_slip_neg - real(pReal), dimension(prm%totalNslip) :: & - StressRatio, BoltzmannRatio, & + real(pReal), intent(out), dimension(param(instance)%totalNslip) :: & + gdot_pos, & + gdot_neg + real(pReal), intent(out), optional, dimension(param(instance)%totalNslip) :: & + dgdot_dtau_pos, & + dgdot_dtau_neg, & + tau_pos1, & + tau_neg1 + real(pReal), dimension(param(instance)%totalNslip) :: & + StressRatio, & StressRatio_p,StressRatio_pminus1, & - DotGamma0, dvel_slip, vel_slip + dvel, vel, & + tau_pos,tau_neg, & + needsGoodName ! ToDo: @Karo: any idea? + integer(pInt) :: j + + associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) do j = 1_pInt, prm%totalNslip - tau_slip_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) - tau_slip_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) + tau_pos(j) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,j)) + tau_neg(j) = math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,j)) enddo - BoltzmannRatio = prm%H0kp/(kB*Temperature) - DotGamma0 = stt%rhoEdge(:,of)*prm%burgers*prm%v0 - significantPositiveTau: where(abs(tau_slip_pos)-dst%threshold_stress(:,of) > tol_math_check) - StressRatio = (abs(tau_slip_pos)-dst%threshold_stress(:,of)) & - / (prm%solidSolutionStrength+prm%tau_Peierls) - StressRatio_p = StressRatio** prm%p - StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal) + if (present(tau_pos1)) tau_pos1 = tau_pos + if (present(tau_neg1)) tau_neg1 = tau_neg - vel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega & - * ( dst%mfp(:,of) - prm%kink_width ) & - * (tau_slip_pos & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) ) & - / ( & - 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_pos & - + prm%omega * prm%B & - *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & + associate(BoltzmannRatio => prm%H0kp/(kB*Temperature), & + DotGamma0 => stt%rhoEdge(:,of)*prm%burgers*prm%v0, & + effectiveLength => dst%mfp(:,of) - prm%w) + + significantPositiveTau: where(abs(tau_pos)-dst%threshold_stress(:,of) > tol_math_check) + StressRatio = (abs(tau_pos)-dst%threshold_stress(:,of))/prm%tau0 + StressRatio_p = StressRatio** prm%p + StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal) + needsGoodName = exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) + + vel = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega & + * effectiveLength * tau_pos * needsGoodName & + / ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_pos & + + prm%omega * prm%B * effectiveLength**2.0_pReal* needsGoodName & ) - gdot_slip_pos = DotGamma0 * sign(vel_slip,tau_slip_pos) + gdot_pos = DotGamma0 * sign(vel,tau_pos) * 0.5_pReal + else where significantPositiveTau + gdot_pos = 0.0_pReal + end where significantPositiveTau - dvel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega & - * ( dst%mfp(:,of) - prm%kink_width ) & - * ( & - (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & - + tau_slip_pos & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q))& - *BoltzmannRatio*prm%p& - *prm%q/& - (prm%solidSolutionStrength+prm%tau_Peierls)*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) ) & - ) & - * (2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_pos & - + prm%omega * prm%B & - *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & - ) & - - (tau_slip_pos & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) ) & - * (2.0_pReal*(prm%burgers**2.0_pReal) & - + prm%omega * prm%B & - *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q))& - *BoltzmannRatio*prm%p& - *prm%q/& - (prm%solidSolutionStrength+prm%tau_Peierls)*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) )& - ) & - ) & - / ( & - ( & - 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_pos & - + prm%omega * prm%B & - *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & - )**2.0_pReal & - ) + if (present(dgdot_dtau_pos)) then + significantPositiveTau2: where(abs(tau_pos)-dst%threshold_stress(:,of) > tol_math_check) + dvel = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega* effectiveLength & + * ( & + (needsGoodName + tau_pos * abs(needsGoodName)*BoltzmannRatio*prm%p & + * prm%q/prm%tau0 & + * StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) & + ) & + * ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_pos & + + prm%omega * prm%B* effectiveLength **2.0_pReal* needsGoodName & + ) & + - tau_pos * needsGoodName * (2.0_pReal*prm%burgers**2.0_pReal & + + prm%omega * prm%B *effectiveLength **2.0_pReal& + * (abs(needsGoodName)*BoltzmannRatio*prm%p *prm%q/prm%tau0 & + *StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) )& + ) & + ) & + /(2.0_pReal*prm%burgers**2.0_pReal*tau_pos & + + prm%omega * prm%B* effectiveLength**2.0_pReal* needsGoodName )**2.0_pReal - dgdot_dtauslip_pos = DotGamma0 * dvel_slip -else where significantPositiveTau - gdot_slip_pos = 0.0_pReal - dgdot_dtauslip_pos = 0.0_pReal -end where significantPositiveTau + dgdot_dtau_pos = DotGamma0 * dvel* 0.5_pReal + else where significantPositiveTau2 + dgdot_dtau_pos = 0.0_pReal + end where significantPositiveTau2 + endif - significantNegativeTau: where(abs(tau_slip_neg)-dst%threshold_stress(:,of) > tol_math_check) - StressRatio = (abs(tau_slip_neg)-dst%threshold_stress(:,of)) & - / (prm%solidSolutionStrength+prm%tau_Peierls) - StressRatio_p = StressRatio** prm%p - StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal) + significantNegativeTau: where(abs(tau_neg)-dst%threshold_stress(:,of) > tol_math_check) + StressRatio = (abs(tau_neg)-dst%threshold_stress(:,of))/prm%tau0 + StressRatio_p = StressRatio** prm%p + StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal) + needsGoodName = exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) - vel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega & - * ( dst%mfp(:,of) - prm%kink_width ) & - * (tau_slip_neg & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) ) & - / ( & - 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_neg & - + prm%omega * prm%B & - *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & + vel = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega & + * effectiveLength * tau_neg * needsGoodName & + / ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_neg & + + prm%omega * prm%B * effectiveLength**2.0_pReal* needsGoodName & ) - gdot_slip_neg = DotGamma0 * sign(vel_slip,tau_slip_neg) + gdot_neg = DotGamma0 * sign(vel,tau_neg) * 0.5_pReal + else where significantNegativeTau + gdot_neg = 0.0_pReal + end where significantNegativeTau - dvel_slip = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega & - * ( dst%mfp(:,of) - prm%kink_width ) & - * ( & - (exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & - + tau_slip_neg & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q))& - *BoltzmannRatio*prm%p& - *prm%q/& - (prm%solidSolutionStrength+prm%tau_Peierls)*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) ) & - ) & - * (2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_neg & - + prm%omega * prm%B & - *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & - ) & - - (tau_slip_neg & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) ) & - * (2.0_pReal*(prm%burgers**2.0_pReal) & - + prm%omega * prm%B & - *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & - * (abs(exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q))& - *BoltzmannRatio*prm%p& - *prm%q/& - (prm%solidSolutionStrength+prm%tau_Peierls)*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) )& - ) & - ) & - / ( & - ( & - 2.0_pReal*(prm%burgers**2.0_pReal)*tau_slip_neg & - + prm%omega * prm%B & - *(( dst%mfp(:,of) - prm%kink_width )**2.0_pReal) & - * exp(-BoltzmannRatio*(1-StressRatio_p) ** prm%q) & - )**2.0_pReal & - ) - - - dgdot_dtauslip_neg = DotGamma0 * dvel_slip -else where significantNegativeTau - gdot_slip_neg = 0.0_pReal - dgdot_dtauslip_neg = 0.0_pReal -end where significantNegativeTau + if (present(dgdot_dtau_neg)) then + significantNegativeTau2: where(abs(tau_neg)-dst%threshold_stress(:,of) > tol_math_check) + dvel = 2.0_pReal*prm%burgers * prm%kink_height * prm%omega* effectiveLength & + * ( & + (needsGoodName + tau_neg * abs(needsGoodName)*BoltzmannRatio*prm%p & + * prm%q/prm%tau0 & + * StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) & + ) & + * ( 2.0_pReal*(prm%burgers**2.0_pReal)*tau_neg & + + prm%omega * prm%B* effectiveLength **2.0_pReal* needsGoodName & + ) & + - tau_neg * needsGoodName * (2.0_pReal*prm%burgers**2.0_pReal & + + prm%omega * prm%B *effectiveLength **2.0_pReal& + * (abs(needsGoodName)*BoltzmannRatio*prm%p *prm%q/prm%tau0 & + *StressRatio_pminus1*(1-StressRatio_p)**(prm%q-1.0_pReal) )& + ) & + ) & + /(2.0_pReal*prm%burgers**2.0_pReal*tau_neg & + + prm%omega * prm%B* effectiveLength**2.0_pReal* needsGoodName )**2.0_pReal + dgdot_dtau_neg = DotGamma0 * dvel * 0.5_pReal + else where significantNegativeTau2 + dgdot_dtau_neg = 0.0_pReal + end where significantNegativeTau2 + end if + end associate + end associate end subroutine kinetics diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index d65fe583f..219226ad4 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -1,66 +1,68 @@ !-------------------------------------------------------------------------------------------------- !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for isotropic (ISOTROPIC) plasticity -!> @details Isotropic (ISOTROPIC) Plasticity which resembles the phenopowerlaw plasticity without +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief material subroutine for isotropic plasticity +!> @details Isotropic Plasticity which resembles the phenopowerlaw plasticity without !! resolving the stress on the slip systems. Will give the response of phenopowerlaw for an !! untextured polycrystal !-------------------------------------------------------------------------------------------------- module plastic_isotropic use prec, only: & - pReal,& + pReal, & pInt - + implicit none private integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_isotropic_sizePostResult !< size of each post result output + plastic_isotropic_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_isotropic_output !< name of each post result output - integer(pInt), dimension(:), allocatable, target, public :: & - plastic_isotropic_Noutput !< number of outputs per instance - - enum, bind(c) - enumerator :: undefined_ID, & - flowstress_ID, & - strainrate_ID + plastic_isotropic_output !< name of each post result output + + enum, bind(c) + enumerator :: & + undefined_ID, & + flowstress_ID, & + strainrate_ID end enum - type, private :: tParameters !< container type for internal constitutive parameters - integer(kind(undefined_ID)), allocatable, dimension(:) :: & - outputID - real(pReal) :: & - fTaylor, & - tau0, & - gdot0, & - n, & + type, private :: tParameters + real(pReal) :: & + fTaylor, & !< Taylor factor + tau0, & !< initial critical stress + gdot0, & !< reference strain rate + n, & !< stress exponent h0, & h0_slopeLnRate, & - tausat, & + tausat, & !< maximum critical stress a, & - aTolFlowstress, & - aTolShear, & tausat_SinhFitA, & tausat_SinhFitB, & tausat_SinhFitC, & - tausat_SinhFitD - logical :: & + tausat_SinhFitD, & + aTolFlowstress, & + aTolShear + integer(pInt) :: & + of_debug = 0_pInt + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID + logical :: & dilatation end type - type(tParameters), dimension(:), allocatable, target, private :: param !< containers of constitutive parameters (len Ninstance) - - type, private :: tIsotropicState !< internal state aliases - real(pReal), pointer, dimension(:) :: & ! scalars along NipcMyInstance + type, private :: tIsotropicState + real(pReal), pointer, dimension(:) :: & flowstress, & accumulatedShear end type - type(tIsotropicState), allocatable, dimension(:), private :: & !< state aliases per instance - state, & - dotState - public :: & + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tIsotropicState), allocatable, dimension(:), private :: & + dotState, & + state + + public :: & plastic_isotropic_init, & plastic_isotropic_LpAndItsTangent, & plastic_isotropic_LiAndItsTangent, & @@ -69,7 +71,6 @@ module plastic_isotropic contains - !-------------------------------------------------------------------------------------------------- !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks @@ -80,20 +81,29 @@ subroutine plastic_isotropic_init() compiler_version, & compiler_options #endif -use IO + use prec, only: & + pStringLen use debug, only: & +#ifdef DEBUG + debug_e, & + debug_i, & + debug_g, & + debug_levelExtensive, & +#endif debug_level, & debug_constitutive, & debug_levelBasic - use numerics, only: & - numerics_integrator - use math, only: & - math_Mandel3333to66, & - math_Voigt66to3333 + use IO, only: & + IO_error, & + IO_timeStamp use material, only: & +#ifdef DEBUG + phasememberAt, & +#endif phase_plasticity, & phase_plasticityInstance, & phase_Noutput, & + material_allocatePlasticState, & PLASTICITY_ISOTROPIC_label, & PLASTICITY_ISOTROPIC_ID, & material_phase, & @@ -101,148 +111,142 @@ use IO use config, only: & MATERIAL_partPhase, & config_phase - - use lattice + use lattice implicit none - - type(tParameters), pointer :: prm - integer(pInt) :: & - phase, & - instance, & - maxNinstance, & - sizeDotState, & - sizeState, & - sizeDeltaState - character(len=65536) :: & - extmsg = '' - integer(pInt) :: NipcMyPhase,i - character(len=65536), dimension(:), allocatable :: outputs + Ninstance, & + p, i, & + NipcMyPhase, & + sizeState, sizeDotState - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_ISOTROPIC_label//' init -+>>>' + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + + integer(kind(undefined_ID)) :: & + outputID + + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_ISOTROPIC_label//' init -+>>>' + write(6,'(/,a)') ' Maiti and Eisenlohr, Scripta Materialia, 145:37-40, 2018' + write(6,'(/,a)') ' https://doi.org/10.1016/j.scriptamat.2017.09.047' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - - maxNinstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt) + + Ninstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance -! public variables - allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt) - allocate(plastic_isotropic_output(maxval(phase_Noutput), maxNinstance)) + allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(plastic_isotropic_output(maxval(phase_Noutput),Ninstance)) plastic_isotropic_output = '' - allocate(plastic_isotropic_Noutput(maxNinstance), source=0_pInt) - allocate(param(maxNinstance)) ! one container of parameters per instance - allocate(state(maxNinstance)) ! internal state aliases - allocate(dotState(maxNinstance)) + allocate(param(Ninstance)) + allocate(state(Ninstance)) + allocate(dotState(Ninstance)) - do phase = 1_pInt, size(phase_plasticityInstance) - if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then - instance = phase_plasticityInstance(phase) - prm => param(instance) ! shorthand pointer to parameter object of my constitutive law - prm%tau0 = config_phase(phase)%getFloat('tau0') - prm%tausat = config_phase(phase)%getFloat('tausat') - prm%gdot0 = config_phase(phase)%getFloat('gdot0') - prm%n = config_phase(phase)%getFloat('n') - prm%h0 = config_phase(phase)%getFloat('h0') - prm%fTaylor = config_phase(phase)%getFloat('m') - prm%h0_slopeLnRate = config_phase(phase)%getFloat('h0_slopelnrate', defaultVal=0.0_pReal) - prm%tausat_SinhFitA = config_phase(phase)%getFloat('tausat_sinhfita',defaultVal=0.0_pReal) - prm%tausat_SinhFitB = config_phase(phase)%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal) - prm%tausat_SinhFitC = config_phase(phase)%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal) - prm%tausat_SinhFitD = config_phase(phase)%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal) - prm%a = config_phase(phase)%getFloat('a') - prm%aTolFlowStress = config_phase(phase)%getFloat('atol_flowstress',defaultVal=1.0_pReal) - prm%aTolShear = config_phase(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) - - prm%dilatation = config_phase(phase)%keyExists('/dilatation/') + do p = 1_pInt, size(phase_plasticity) + if (phase_plasticity(p) /= PLASTICITY_ISOTROPIC_ID) cycle + associate(prm => param(phase_plasticityInstance(p)), & + dot => dotState(phase_plasticityInstance(p)), & + stt => state(phase_plasticityInstance(p)), & + config => config_phase(p)) -#if defined(__GFORTRAN__) - outputs = ['GfortranBug86277'] - outputs = config_phase(phase)%getStrings('(output)',defaultVal=outputs) - if (outputs(1) == 'GfortranBug86277') outputs = [character(len=65536)::] -#else - outputs = config_phase(phase)%getStrings('(output)',defaultVal=[character(len=65536)::]) +#ifdef DEBUG + if (p==material_phase(debug_g,debug_i,debug_e)) then + prm%of_debug = phasememberAt(debug_g,debug_i,debug_e) + endif #endif - allocate(prm%outputID(0)) - do i=1_pInt, size(outputs) - select case(outputs(i)) - case ('flowstress') - plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt - plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i) - plasticState(phase)%sizePostResults = plasticState(phase)%sizePostResults + 1_pInt - plastic_isotropic_sizePostResult(i,instance) = 1_pInt - prm%outputID = [prm%outputID,flowstress_ID] - case ('strainrate') - plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt - plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i) - plasticState(phase)%sizePostResults = & - plasticState(phase)%sizePostResults + 1_pInt - plastic_isotropic_sizePostResult(i,instance) = 1_pInt - prm%outputID = [prm%outputID,strainrate_ID] - end select - enddo + + prm%tau0 = config%getFloat('tau0') + prm%tausat = config%getFloat('tausat') + prm%gdot0 = config%getFloat('gdot0') + prm%n = config%getFloat('n') + prm%h0 = config%getFloat('h0') + prm%fTaylor = config%getFloat('m') + prm%h0_slopeLnRate = config%getFloat('h0_slopelnrate', defaultVal=0.0_pReal) + prm%tausat_SinhFitA = config%getFloat('tausat_sinhfita',defaultVal=0.0_pReal) + prm%tausat_SinhFitB = config%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal) + prm%tausat_SinhFitC = config%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal) + prm%tausat_SinhFitD = config%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal) + prm%a = config%getFloat('a') + prm%aTolFlowStress = config%getFloat('atol_flowstress',defaultVal=1.0_pReal) + prm%aTolShear = config%getFloat('atol_shear', defaultVal=1.0e-6_pReal) + + prm%dilatation = config%keyExists('/dilatation/') !-------------------------------------------------------------------------------------------------- ! sanity checks - extmsg = '' - if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"'aTolShear' " - if (prm%tau0 < 0.0_pReal) extmsg = trim(extmsg)//"'tau0' " - if (prm%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//"'gdot0' " - if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//"'n' " - if (prm%tausat <= prm%tau0) extmsg = trim(extmsg)//"'tausat' " - if (prm%a <= 0.0_pReal) extmsg = trim(extmsg)//"'a' " - if (prm%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//"'m' " - if (prm%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//"'atol_flowstress' " - if (extmsg /= '') call IO_error(211_pInt,ip=instance,& - ext_msg=trim(extmsg)//'('//PLASTICITY_ISOTROPIC_label//')') + extmsg = '' + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//' aTolShear' + if (prm%tau0 < 0.0_pReal) extmsg = trim(extmsg)//' tau0' + if (prm%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0' + if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' n' + if (prm%tausat <= prm%tau0) extmsg = trim(extmsg)//' tausat' + if (prm%a <= 0.0_pReal) extmsg = trim(extmsg)//' a' + if (prm%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//' m' + if (prm%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//' atol_flowstress' + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//' atol_shear' + +!-------------------------------------------------------------------------------------------------- +! exit if any parameter is out of range + if (extmsg /= '') & + call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//PLASTICITY_ISOTROPIC_label//')') + +!-------------------------------------------------------------------------------------------------- +! output pararameters + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + + case ('flowstress') + outputID = flowstress_ID + case ('strainrate') + outputID = strainrate_ID + + end select + + if (outputID /= undefined_ID) then + plastic_isotropic_output(i,phase_plasticityInstance(p)) = outputs(i) + plastic_isotropic_sizePostResult(i,phase_plasticityInstance(p)) = 1_pInt + prm%outputID = [prm%outputID, outputID] + endif + + enddo !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == phase) ! number of own material points (including point components ipc) + NipcMyPhase = count(material_phase == p) + sizeDotState = size(['flowstress ','accumulated_shear']) + sizeState = sizeDotState - sizeDotState = size(["flowstress ","accumulated_shear"]) - sizeDeltaState = 0_pInt ! no sudden jumps in state - sizeState = sizeDotState + sizeDeltaState - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%nSlip = 1 - allocate(plasticState(phase)%aTolState ( sizeState)) - allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%state ( sizeState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase),source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NipcMyPhase),source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase),source=0.0_pReal) + call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, & + 1_pInt,0_pInt,0_pInt) + plasticState(p)%sizePostResults = sum(plastic_isotropic_sizePostResult(:,phase_plasticityInstance(p))) !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState + stt%flowstress => plasticState(p)%state (1,:) + stt%flowstress = prm%tau0 + dot%flowstress => plasticState(p)%dotState(1,:) + plasticState(p)%aTolState(1) = prm%aTolFlowstress - state(instance)%flowstress => plasticState(phase)%state (1,1:NipcMyPhase) - dotState(instance)%flowstress => plasticState(phase)%dotState (1,1:NipcMyPhase) - plasticState(phase)%state0(1,1:NipcMyPhase) = prm%tau0 - plasticState(phase)%aTolState(1) = prm%aTolFlowstress + stt%accumulatedShear => plasticState(p)%state (2,:) + dot%accumulatedShear => plasticState(p)%dotState(2,:) + plasticState(p)%aTolState(2) = prm%aTolShear + ! global alias + plasticState(p)%slipRate => plasticState(p)%dotState(2:2,:) + plasticState(p)%accumulatedSlip => plasticState(p)%state (2:2,:) - state(instance)%accumulatedShear => plasticState(phase)%state (2,1:NipcMyPhase) - dotState(instance)%accumulatedShear => plasticState(phase)%dotState (2,1:NipcMyPhase) - plasticState(phase)%state0 (2,1:NipcMyPhase) = 0.0_pReal - plasticState(phase)%aTolState(2) = prm%aTolShear - ! global alias - plasticState(phase)%slipRate => plasticState(phase)%dotState(2:2,1:NipcMyPhase) - plasticState(phase)%accumulatedSlip => plasticState(phase)%state (2:2,1:NipcMyPhase) + plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally + + end associate -endif enddo end subroutine plastic_isotropic_init @@ -251,309 +255,237 @@ end subroutine plastic_isotropic_init !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) +subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) +#ifdef DEBUG use debug, only: & debug_level, & - debug_constitutive, & - debug_levelBasic, & + debug_constitutive,& debug_levelExtensive, & - debug_levelSelective, & - debug_e, & - debug_i, & - debug_g + debug_levelSelective +#endif use math, only: & - math_mul6x6, & - math_Mandel6to33, & - math_Plain3333to99, & math_deviatoric33, & math_mul33xx33 - use material, only: & - phasememberAt, & - material_phase, & - phase_plasticityInstance implicit none - real(pReal), dimension(3,3), intent(out) :: & + real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient - real(pReal), dimension(9,9), intent(out) :: & - dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp !< derivative of Lp with respect to the Mandel stress - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + instance, & + of - type(tParameters), pointer :: prm - real(pReal), dimension(3,3) :: & - Tstar_dev_33 !< deviatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor - real(pReal), dimension(3,3,3,3) :: & - dLp_dTstar_3333 !< derivative of Lp with respect to Tstar as 4th order tensor + Mp_dev !< deviatoric part of the Mandel stress real(pReal) :: & gamma_dot, & !< strainrate - norm_Tstar_dev, & !< euclidean norm of Tstar_dev - squarenorm_Tstar_dev !< square of the euclidean norm of Tstar_dev + norm_Mp_dev, & !< norm of the deviatoric part of the Mandel stress + squarenorm_Mp_dev !< square of the norm of the deviatoric part of the Mandel stress integer(pInt) :: & - instance, of, & k, l, m, n - of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - prm => param(instance) - - Tstar_dev_33 = math_deviatoric33(math_Mandel6to33(Tstar_v)) ! deviatoric part of 2nd Piola-Kirchhoff stress - squarenorm_Tstar_dev = math_mul33xx33(Tstar_dev_33,Tstar_dev_33) - norm_Tstar_dev = sqrt(squarenorm_Tstar_dev) + associate(prm => param(instance), stt => state(instance)) - if (norm_Tstar_dev <= 0.0_pReal) then ! Tstar == 0 --> both Lp and dLp_dTstar are zero - Lp = 0.0_pReal - dLp_dTstar99 = 0.0_pReal - else - gamma_dot = prm%gdot0 & - * ( sqrt(1.5_pReal) * norm_Tstar_dev / prm%fTaylor / state(instance)%flowstress(of) ) & - **prm%n + Mp_dev = math_deviatoric33(Mp) + squarenorm_Mp_dev = math_mul33xx33(Mp_dev,Mp_dev) + norm_Mp_dev = sqrt(squarenorm_Mp_dev) - Lp = Tstar_dev_33/norm_Tstar_dev * gamma_dot/prm%fTaylor + if (norm_Mp_dev > 0.0_pReal) then + gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Mp_dev/(prm%fTaylor*stt%flowstress(of))) **prm%n + Lp = Mp_dev/norm_Mp_dev * gamma_dot/prm%fTaylor +#ifdef DEBUG if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & - .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then - write(6,'(a,i8,1x,i2,1x,i3)') '<< CONST isotropic >> at el ip g ',el,ip,ipc + .and. (of == prm%of_debug .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CONST isotropic >> Tstar (dev) / MPa', & - transpose(Tstar_dev_33(1:3,1:3))*1.0e-6_pReal - write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Tstar_dev*1.0e-6_pReal + transpose(Mp_dev)*1.0e-6_pReal + write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Mp_dev*1.0e-6_pReal write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> gdot', gamma_dot end if -!-------------------------------------------------------------------------------------------------- -! Calculation of the tangent of Lp +#endif forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dTstar_3333(k,l,m,n) = (prm%n-1.0_pReal) * & - Tstar_dev_33(k,l)*Tstar_dev_33(m,n) / squarenorm_Tstar_dev + dLp_dMp(k,l,m,n) = (prm%n-1.0_pReal) * Mp_dev(k,l)*Mp_dev(m,n) / squarenorm_Mp_dev forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt) & - dLp_dTstar_3333(k,l,k,l) = dLp_dTstar_3333(k,l,k,l) + 1.0_pReal + dLp_dMp(k,l,k,l) = dLp_dMp(k,l,k,l) + 1.0_pReal forall (k=1_pInt:3_pInt,m=1_pInt:3_pInt) & - dLp_dTstar_3333(k,k,m,m) = dLp_dTstar_3333(k,k,m,m) - 1.0_pReal/3.0_pReal - dLp_dTstar99 = math_Plain3333to99(gamma_dot / prm%fTaylor * & - dLp_dTstar_3333 / norm_Tstar_dev) + dLp_dMp(k,k,m,m) = dLp_dMp(k,k,m,m) - 1.0_pReal/3.0_pReal + dLp_dMp = gamma_dot / prm%fTaylor * dLp_dMp / norm_Mp_dev + else + Lp = 0.0_pReal + dLp_dMp = 0.0_pReal end if + + end associate + end subroutine plastic_isotropic_LpAndItsTangent + !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent +! ToDo: Rename Tstar to Mi? !-------------------------------------------------------------------------------------------------- -subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar_3333,Tstar_v,ipc,ip,el) +subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of) use math, only: & - math_mul6x6, & - math_Mandel6to33, & - math_Plain3333to99, & math_spherical33, & math_mul33xx33 - use material, only: & - phasememberAt, & - material_phase, & - phase_plasticityInstance implicit none real(pReal), dimension(3,3), intent(out) :: & - Li !< plastic velocity gradient + Li !< inleastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & - dLi_dTstar_3333 !< derivative of Li with respect to Tstar as 4th order tensor - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + dLi_dTstar !< derivative of Li with respect to the Mandel stress + + real(pReal), dimension(3,3), intent(in) :: & + Tstar !< Mandel stress ToDo: Mi? + integer(pInt), intent(in) :: & + instance, & + of - type(tParameters), pointer :: prm - real(pReal), dimension(3,3) :: & - Tstar_sph_33 !< sphiatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor + Tstar_sph !< sphiatoric part of the Mandel stress real(pReal) :: & gamma_dot, & !< strainrate norm_Tstar_sph, & !< euclidean norm of Tstar_sph squarenorm_Tstar_sph !< square of the euclidean norm of Tstar_sph integer(pInt) :: & - instance, of, & k, l, m, n - of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - prm => param(instance) - - Tstar_sph_33 = math_spherical33(math_Mandel6to33(Tstar_v)) ! spherical part of 2nd Piola-Kirchhoff stress - squarenorm_Tstar_sph = math_mul33xx33(Tstar_sph_33,Tstar_sph_33) - norm_Tstar_sph = sqrt(squarenorm_Tstar_sph) + associate(prm => param(instance), stt => state(instance)) - if (prm%dilatation .and. norm_Tstar_sph > 0.0_pReal) then ! Tstar == 0 or J2 plascitiy --> both Li and dLi_dTstar are zero - gamma_dot = prm%gdot0 & - * (sqrt(1.5_pReal) * norm_Tstar_sph / prm%fTaylor / state(instance)%flowstress(of) ) & - **prm%n + Tstar_sph = math_spherical33(Tstar) + squarenorm_Tstar_sph = math_mul33xx33(Tstar_sph,Tstar_sph) + norm_Tstar_sph = sqrt(squarenorm_Tstar_sph) - Li = Tstar_sph_33/norm_Tstar_sph * gamma_dot/prm%fTaylor + if (prm%dilatation .and. norm_Tstar_sph > 0.0_pReal) then ! no stress or J2 plastitiy --> Li and its derivative are zero + gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Tstar_sph /(prm%fTaylor*stt%flowstress(of))) **prm%n - !-------------------------------------------------------------------------------------------------- - ! Calculation of the tangent of Li + Li = Tstar_sph/norm_Tstar_sph * gamma_dot/prm%fTaylor forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLi_dTstar_3333(k,l,m,n) = (prm%n-1.0_pReal) * & - Tstar_sph_33(k,l)*Tstar_sph_33(m,n) / squarenorm_Tstar_sph + dLi_dTstar(k,l,m,n) = (prm%n-1.0_pReal) * Tstar_sph(k,l)*Tstar_sph(m,n) / squarenorm_Tstar_sph forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt) & - dLi_dTstar_3333(k,l,k,l) = dLi_dTstar_3333(k,l,k,l) + 1.0_pReal + dLi_dTstar(k,l,k,l) = dLi_dTstar(k,l,k,l) + 1.0_pReal - dLi_dTstar_3333 = gamma_dot / prm%fTaylor * & - dLi_dTstar_3333 / norm_Tstar_sph + dLi_dTstar = gamma_dot / prm%fTaylor * dLi_dTstar / norm_Tstar_sph else - Li = 0.0_pReal - dLi_dTstar_3333 = 0.0_pReal + Li = 0.0_pReal + dLi_dTstar = 0.0_pReal endif + + end associate + end subroutine plastic_isotropic_LiAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -subroutine plastic_isotropic_dotState(Tstar_v,ipc,ip,el) +subroutine plastic_isotropic_dotState(Mp,instance,of) use prec, only: & dEq0 use math, only: & - math_mul6x6 - use material, only: & - phasememberAt, & - material_phase, & - phase_plasticityInstance - + math_mul33xx33, & + math_deviatoric33 + implicit none - real(pReal), dimension(6), intent(in):: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - type(tParameters), pointer :: prm - real(pReal), dimension(6) :: & - Tstar_dev_v !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer(pInt), intent(in) :: & + instance, & + of + real(pReal) :: & gamma_dot, & !< strainrate hardening, & !< hardening coefficient saturation, & !< saturation flowstress - norm_Tstar_v !< euclidean norm of Tstar_dev - integer(pInt) :: & - instance, & !< instance of my instance (unique number of my constitutive model) - of !< shortcut notation for offset position in state array + norm_Mp !< norm of the (deviatoric) Mandel stress + + associate(prm => param(instance), stt => state(instance), dot => dotState(instance)) - of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - prm => param(instance) - -!-------------------------------------------------------------------------------------------------- -! norm of (deviatoric) 2nd Piola-Kirchhoff stress if (prm%dilatation) then - norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v)) + norm_Mp = sqrt(math_mul33xx33(Mp,Mp)) else - Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal - Tstar_dev_v(4:6) = Tstar_v(4:6) - norm_Tstar_v = sqrt(math_mul6x6(Tstar_dev_v,Tstar_dev_v)) - end if -!-------------------------------------------------------------------------------------------------- -! strain rate - gamma_dot = prm%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v & - / &!----------------------------------------------------------------------------------- - (prm%fTaylor*state(instance)%flowstress(of) ))**prm%n - -!-------------------------------------------------------------------------------------------------- -! hardening coefficient + norm_Mp = sqrt(math_mul33xx33(math_deviatoric33(Mp),math_deviatoric33(Mp))) + endif + + gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Mp /(prm%fTaylor*stt%flowstress(of))) **prm%n + if (abs(gamma_dot) > 1e-12_pReal) then if (dEq0(prm%tausat_SinhFitA)) then saturation = prm%tausat else saturation = prm%tausat & - + asinh( (gamma_dot / prm%tausat_SinhFitA& - )**(1.0_pReal / prm%tausat_SinhFitD)& + + asinh( (gamma_dot / prm%tausat_SinhFitA)**(1.0_pReal / prm%tausat_SinhFitD) & )**(1.0_pReal / prm%tausat_SinhFitC) & - / ( prm%tausat_SinhFitB & - * (gamma_dot / prm%gdot0)**(1.0_pReal / prm%n) & - ) + / prm%tausat_SinhFitB * (gamma_dot / prm%gdot0)**(1.0_pReal / prm%n) endif hardening = ( prm%h0 + prm%h0_slopeLnRate * log(gamma_dot) ) & - * abs( 1.0_pReal - state(instance)%flowstress(of)/saturation )**prm%a & - * sign(1.0_pReal, 1.0_pReal - state(instance)%flowstress(of)/saturation) + * abs( 1.0_pReal - stt%flowstress(of)/saturation )**prm%a & + * sign(1.0_pReal, 1.0_pReal - stt%flowstress(of)/saturation) else hardening = 0.0_pReal endif - dotState(instance)%flowstress (of) = hardening * gamma_dot - dotState(instance)%accumulatedShear(of) = gamma_dot + dot%flowstress (of) = hardening * gamma_dot + dot%accumulatedShear(of) = gamma_dot + + end associate end subroutine plastic_isotropic_dotState + !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_isotropic_postResults(Tstar_v,ipc,ip,el) +function plastic_isotropic_postResults(Mp,instance,of) result(postResults) use math, only: & - math_mul6x6 - use material, only: & - plasticState, & - material_phase, & - phasememberAt, & - phase_plasticityInstance + math_mul33xx33, & + math_deviatoric33 implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer(pInt), intent(in) :: & + instance, & + of - type(tParameters), pointer :: prm - - real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & - plastic_isotropic_postResults + real(pReal), dimension(sum(plastic_isotropic_sizePostResult(:,instance))) :: & + postResults - real(pReal), dimension(6) :: & - Tstar_dev_v !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation real(pReal) :: & - norm_Tstar_v ! euclidean norm of Tstar_dev + norm_Mp !< norm of the Mandel stress integer(pInt) :: & - instance, & !< instance of my instance (unique number of my constitutive model) - of, & !< shortcut notation for offset position in state array - c, & - o + o,c + + associate(prm => param(instance), stt => state(instance)) - of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - prm => param(instance) - -!-------------------------------------------------------------------------------------------------- -! norm of (deviatoric) 2nd Piola-Kirchhoff stress if (prm%dilatation) then - norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v)) + norm_Mp = sqrt(math_mul33xx33(Mp,Mp)) else - Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal - Tstar_dev_v(4:6) = Tstar_v(4:6) - norm_Tstar_v = sqrt(math_mul6x6(Tstar_dev_v,Tstar_dev_v)) - end if - - c = 0_pInt - plastic_isotropic_postResults = 0.0_pReal + norm_Mp = sqrt(math_mul33xx33(math_deviatoric33(Mp),math_deviatoric33(Mp))) + endif - outputsLoop: do o = 1_pInt,plastic_isotropic_Noutput(instance) + c = 0_pInt + + outputsLoop: do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) + case (flowstress_ID) - plastic_isotropic_postResults(c+1_pInt) = state(instance)%flowstress(of) + postResults(c+1_pInt) = stt%flowstress(of) c = c + 1_pInt case (strainrate_ID) - plastic_isotropic_postResults(c+1_pInt) = & - prm%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v & - / &!---------------------------------------------------------------------------------- - (prm%fTaylor * state(instance)%flowstress(of)) ) ** prm%n + postResults(c+1_pInt) = prm%gdot0 & + * (sqrt(1.5_pReal) * norm_Mp /(prm%fTaylor * stt%flowstress(of)))**prm%n c = c + 1_pInt + end select enddo outputsLoop + end associate + end function plastic_isotropic_postResults diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 5089cd5ca..fe7fa5ef1 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -1,76 +1,63 @@ !-------------------------------------------------------------------------------------------------- !> @author Philip Eisenlohr, Michigan State University !> @author Zhuowen Zhao, Michigan State University -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Introducing Voce-type kinematic hardening rule into crystal plasticity -!! formulation using a power law fitting +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Phenomenological crystal plasticity using a power law formulation for the shear rates +!! and a Voce-type kinematic hardening rule !-------------------------------------------------------------------------------------------------- module plastic_kinehardening use prec, only: & - pReal,& + pReal, & pInt - + implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_kinehardening_sizePostResults !< cumulative size of post results - integer(pInt), dimension(:,:), allocatable, target, public :: & plastic_kinehardening_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & plastic_kinehardening_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - plastic_kinehardening_Noutput !< number of outputs per instance - - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_kinehardening_totalNslip !< no. of slip system used in simulation - - - integer(pInt), dimension(:,:), allocatable, private :: & - plastic_kinehardening_Nslip !< active number of slip systems per family (input parameter, per family) - enum, bind(c) - enumerator :: undefined_ID, & - crss_ID, & !< critical resolved stress - crss_back_ID, & !< critical resolved back stress - sense_ID, & !< sense of acting shear stress (-1 or +1) - chi0_ID, & !< backstress at last switch of stress sense (positive?) - gamma0_ID, & !< accumulated shear at last switch of stress sense (at current switch?) - accshear_ID, & - sumGamma_ID, & - shearrate_ID, & - resolvedstress_ID - + enumerator :: & + undefined_ID, & + crss_ID, & !< critical resolved stress + crss_back_ID, & !< critical resolved back stress + sense_ID, & !< sense of acting shear stress (-1 or +1) + chi0_ID, & !< backstress at last switch of stress sense (positive?) + gamma0_ID, & !< accumulated shear at last switch of stress sense (at current switch?) + accshear_ID, & + shearrate_ID, & + resolvedstress_ID end enum - - - type, private :: tParameters !< container type for internal constitutive parameters - integer(kind(undefined_ID)), dimension(:), allocatable, private :: & - outputID !< ID of each post result output - + + type, private :: tParameters real(pReal) :: & - gdot0, & !< reference shear strain rate for slip (input parameter) - n_slip, & !< stress exponent for slip (input parameter) + gdot0, & !< reference shear strain rate for slip + n, & !< stress exponent for slip aTolResistance, & aTolShear - - - real(pReal), dimension(:), allocatable, private :: & - crss0, & !< initial critical shear stress for slip (input parameter, per family) + real(pReal), allocatable, dimension(:) :: & + crss0, & !< initial critical shear stress for slip theta0, & !< initial hardening rate of forward stress for each slip - theta1, & !< asymptotic hardening rate of forward stress for each slip > - theta0_b, & !< initial hardening rate of back stress for each slip > - theta1_b, & !< asymptotic hardening rate of back stress for each slip > + theta1, & !< asymptotic hardening rate of forward stress for each slip + theta0_b, & !< initial hardening rate of back stress for each slip + theta1_b, & !< asymptotic hardening rate of back stress for each slip tau1, & tau1_b, & - interaction_slipslip, & !< latent hardening matrix nonSchmidCoeff - - real(pReal), dimension(:,:), allocatable, private :: & - hardeningMatrix_SlipSlip + real(pReal), allocatable, dimension(:,:) :: & + interaction_slipslip !< slip resistance from slip activity + real(pReal), allocatable, dimension(:,:,:) :: & + Schmid, & + nonSchmid_pos, & + nonSchmid_neg + integer(pInt) :: & + totalNslip, & !< total number of active slip system + of_debug = 0_pInt + integer(pInt), allocatable, dimension(:) :: & + Nslip !< number of active slip systems for each family + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID !< ID of each post result output end type type, private :: tKinehardeningState @@ -81,21 +68,15 @@ module plastic_kinehardening chi0, & !< backstress at last switch of stress sense gamma0, & !< accumulated shear at last switch of stress sense accshear !< accumulated (absolute) shear - - real(pReal), pointer, dimension(:) :: & !< scalars along NipcMyInstance - sumGamma !< accumulated shear across all systems end type - type(tParameters), dimension(:), allocatable, private :: & - param !< containers of constitutive parameters (len Ninstance) - + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) type(tKinehardeningState), allocatable, dimension(:), private :: & dotState, & deltaState, & - state, & - state0 + state - public :: & plastic_kinehardening_init, & plastic_kinehardening_LpAndItsTangent, & @@ -103,866 +84,554 @@ module plastic_kinehardening plastic_kinehardening_deltaState, & plastic_kinehardening_postResults private :: & - plastic_kinehardening_shearRates - + kinetics contains - !-------------------------------------------------------------------------------------------------- !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine plastic_kinehardening_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) +subroutine plastic_kinehardening_init +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use prec, only: & - dEq0 + dEq0, & + pStringLen use debug, only: & +#ifdef DEBUG + debug_e, & + debug_i, & + debug_g, & + debug_levelExtensive, & +#endif debug_level, & debug_constitutive,& debug_levelBasic use math, only: & - math_Mandel3333to66, & - math_Voigt66to3333, & math_expand use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use material, only: & - PLASTICITY_kinehardening_label, & - PLASTICITY_kinehardening_ID, & +#ifdef DEBUG + phasememberAt, & +#endif phase_plasticity, & phase_plasticityInstance, & phase_Noutput, & + material_allocatePlasticState, & + PLASTICITY_kinehardening_label, & + PLASTICITY_kinehardening_ID, & material_phase, & plasticState use config, only: & - MATERIAL_partPhase + MATERIAL_partPhase, & + config_phase use lattice - use numerics,only: & - numerics_integrator implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(kind(undefined_ID)) :: & - output_ID integer(pInt) :: & - o, j, k, f, & - phase, & - instance, & - maxNinstance, & + Ninstance, & + p, i, o, & NipcMyPhase, & - Nchunks_SlipSlip = 0_pInt, Nchunks_SlipFamilies = 0_pInt, & - Nchunks_nonSchmid = 0_pInt, & - offset_slip, index_myFamily, index_otherFamily, & - startIndex, endIndex, & - mySize, nSlip, nSlipFamilies, & - sizeDotState, & - sizeState, & - sizeDeltaState + sizeState, sizeDeltaState, sizeDotState, & + startIndex, endIndex - real(pReal), dimension(:), allocatable :: tempPerSlip - - character(len=65536) :: & - tag = '', & - line = '', & - extmsg = '' + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] + real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_KINEHARDENING_label//' init -+>>>' + integer(kind(undefined_ID)) :: & + outputID + + character(len=pStringLen) :: & + structure = '',& + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs + + write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_KINEHARDENING_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - maxNinstance = int(count(phase_plasticity == PLASTICITY_KINEHARDENING_ID),pInt) - if (maxNinstance == 0_pInt) return - + Ninstance = int(count(phase_plasticity == PLASTICITY_KINEHARDENING_ID),pInt) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a,1x,i5,/)') '# instances:',maxNinstance - - allocate(plastic_kinehardening_sizePostResults(maxNinstance), source=0_pInt) - allocate(plastic_kinehardening_sizePostResult(maxval(phase_Noutput),maxNinstance), & - source=0_pInt) - allocate(plastic_kinehardening_output(maxval(phase_Noutput),maxNinstance)) - plastic_kinehardening_output = '' - allocate(plastic_kinehardening_Noutput(maxNinstance), source=0_pInt) - allocate(plastic_kinehardening_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) - allocate(plastic_kinehardening_totalNslip(maxNinstance), source=0_pInt) - allocate(param(maxNinstance)) ! one container of parameters per instance - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit + allocate(plastic_kinehardening_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) + allocate(plastic_kinehardening_output(maxval(phase_Noutput),Ninstance)) + plastic_kinehardening_output = '' + + allocate(param(Ninstance)) + allocate(state(Ninstance)) + allocate(dotState(Ninstance)) + allocate(deltaState(Ninstance)) + + do p = 1_pInt, size(phase_plasticityInstance) + if (phase_plasticity(p) /= PLASTICITY_KINEHARDENING_ID) cycle + associate(prm => param(phase_plasticityInstance(p)), & + dot => dotState(phase_plasticityInstance(p)), & + dlt => deltaState(phase_plasticityInstance(p)), & + stt => state(phase_plasticityInstance(p)),& + config => config_phase(p)) + +#ifdef DEBUG + if (p==material_phase(debug_g,debug_i,debug_e)) then + prm%of_debug = phasememberAt(debug_g,debug_i,debug_e) endif - if (IO_getTag(line,'[',']') /= '') then ! next phase - phase = phase + 1_pInt ! advance phase section counter - if (phase_plasticity(phase) == PLASTICITY_KINEHARDENING_ID) then - instance = phase_plasticityInstance(phase) ! count instances of my constitutive law - Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase - Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) - Nchunks_nonSchmid = lattice_NnonSchmid(phase) - allocate(param(instance)%crss0 (Nchunks_SlipFamilies), source=0.0_pReal) - allocate(param(instance)%tau1 (Nchunks_SlipFamilies), source=0.0_pReal) - allocate(param(instance)%tau1_b (Nchunks_SlipFamilies), source=0.0_pReal) - allocate(param(instance)%theta0 (Nchunks_SlipFamilies), source=0.0_pReal) - allocate(param(instance)%theta1 (Nchunks_SlipFamilies), source=0.0_pReal) - allocate(param(instance)%theta0_b(Nchunks_SlipFamilies), source=0.0_pReal) - allocate(param(instance)%theta1_b(Nchunks_SlipFamilies), source=0.0_pReal) - allocate(param(instance)%interaction_slipslip(Nchunks_SlipSlip), source=0.0_pReal) - allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid), source=0.0_pReal) - if(allocated(tempPerSlip)) deallocate(tempPerSlip) - allocate(tempPerSlip(Nchunks_SlipFamilies)) - allocate(param(instance)%outputID(0)) +#endif + + structure = config%getString('lattice_structure') + +!-------------------------------------------------------------------------------------------------- +! optional parameters that need to be defined + prm%aTolResistance = config%getFloat('atol_resistance',defaultVal=1.0_pReal) + prm%aTolShear = config%getFloat('atol_shear', defaultVal=1.0e-6_pReal) + + ! sanity checks + if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//' aTolresistance' + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//' aTolShear' + +!-------------------------------------------------------------------------------------------------- +! slip related parameters + prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) + prm%totalNslip = sum(prm%Nslip) + slipActive: if (prm%totalNslip > 0_pInt) then + prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + if(structure=='bcc') then + prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray) + prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) + prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) + else + prm%nonSchmid_pos = prm%Schmid + prm%nonSchmid_neg = prm%Schmid endif - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_KINEHARDENING_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - output_ID = undefined_ID - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('resistance') - output_ID = crss_ID + prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & + config%getFloats('interaction_slipslip'), & + structure(1:3)) - case ('backstress') - output_ID = crss_back_ID + prm%crss0 = config%getFloats('crss0', requiredShape=shape(prm%Nslip)) + prm%tau1 = config%getFloats('tau1', requiredShape=shape(prm%Nslip)) + prm%tau1_b = config%getFloats('tau1_b', requiredShape=shape(prm%Nslip)) + prm%theta0 = config%getFloats('theta0', requiredShape=shape(prm%Nslip)) + prm%theta1 = config%getFloats('theta1', requiredShape=shape(prm%Nslip)) + prm%theta0_b = config%getFloats('theta0_b', requiredShape=shape(prm%Nslip)) + prm%theta1_b = config%getFloats('theta1_b', requiredShape=shape(prm%Nslip)) - case ('sense') - output_ID = sense_ID + prm%gdot0 = config%getFloat('gdot0') + prm%n = config%getFloat('n_slip') - case ('chi0') - output_ID = chi0_ID - - case ('gamma0') - output_ID = gamma0_ID - - case ('accumulatedshear') - output_ID = accshear_ID - - case ('totalshear') - output_ID = sumGamma_ID - - case ('shearrate') - output_ID = shearrate_ID - - case ('resolvedstress') - output_ID = resolvedstress_ID - - end select - - if (output_ID /= undefined_ID) then - plastic_kinehardening_Noutput(instance) = plastic_kinehardening_Noutput(instance) + 1_pInt - plastic_kinehardening_output(plastic_kinehardening_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - param(instance)%outputID = [param(instance)%outputID, output_ID] - endif - -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of slip families - case ('nslip') - if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_KINEHARDENING_label//')') - if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_KINEHARDENING_label//')') - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) - do j = 1_pInt, Nchunks_SlipFamilies - plastic_kinehardening_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - - case ('crss0','tau1','tau1_b','theta0','theta1','theta0_b','theta1_b') - tempPerSlip = 0.0_pReal - do j = 1_pInt, Nchunks_SlipFamilies - if (plastic_kinehardening_Nslip(j,instance) > 0_pInt) & - tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - select case(tag) - case ('crss0') - param(instance)%crss0(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('tau1') - param(instance)%tau1(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('tau1_b') - param(instance)%tau1_b(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('theta0') - param(instance)%theta0(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('theta1') - param(instance)%theta1(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('theta0_b') - param(instance)%theta0_b(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('theta1_b') - param(instance)%theta1_b(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) - end select - -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of interactions - case ('interaction_slipslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_KINEHARDENING_label//')') - do j = 1_pInt, Nchunks_SlipSlip - param(instance)%interaction_slipslip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('nonschmidcoeff') - if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_KINEHARDENING_label//')') - do j = 1_pInt,Nchunks_nonSchmid - param(instance)%nonSchmidCoeff(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo -!-------------------------------------------------------------------------------------------------- - case ('gdot0') - param(instance)%gdot0 = IO_floatValue(line,chunkPos,2_pInt) - - case ('n_slip') - param(instance)%n_slip = IO_floatValue(line,chunkPos,2_pInt) - - case ('atol_resistance') - param(instance)%aTolResistance = IO_floatValue(line,chunkPos,2_pInt) - - case ('atol_shear') - param(instance)%aTolShear = IO_floatValue(line,chunkPos,2_pInt) - - case default - - end select - endif; endif - enddo parsingFile - -!-------------------------------------------------------------------------------------------------- -! allocation of variables whose size depends on the total number of active slip systems - allocate(state(maxNinstance)) - allocate(state0(maxNinstance)) - allocate(dotState(maxNinstance)) - allocate(deltaState(maxNinstance)) + ! expand: family => system + prm%crss0 = math_expand(prm%crss0, prm%Nslip) + prm%tau1 = math_expand(prm%tau1, prm%Nslip) + prm%tau1_b = math_expand(prm%tau1_b, prm%Nslip) + prm%theta0 = math_expand(prm%theta0, prm%Nslip) + prm%theta1 = math_expand(prm%theta1, prm%Nslip) + prm%theta0_b = math_expand(prm%theta0_b,prm%Nslip) + prm%theta1_b = math_expand(prm%theta1_b,prm%Nslip) - initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop through all phases in material.config - myPhase2: if (phase_plasticity(phase) == PLASTICITY_KINEHARDENING_ID) then ! only consider my phase - NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase - instance = phase_plasticityInstance(phase) ! which instance of my phase - plastic_kinehardening_Nslip(1:lattice_maxNslipFamily,instance) = & - min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active slip systems per family to min of available and requested - plastic_kinehardening_Nslip(1:lattice_maxNslipFamily,instance)) - plastic_kinehardening_totalNslip(instance) = sum(plastic_kinehardening_Nslip(:,instance)) ! how many slip systems altogether - nSlipFamilies = count(plastic_kinehardening_Nslip(:,instance) > 0_pInt) - nSlip = plastic_kinehardening_totalNslip(instance) ! total number of active slip systems - !-------------------------------------------------------------------------------------------------- ! sanity checks - - if (any(plastic_kinehardening_Nslip (1:nSlipFamilies,instance) > 0_pInt & - .and. param(instance)%crss0 (1:nSlipFamilies) < 0.0_pReal)) extmsg = trim(extmsg)//' crss0' - if (any(plastic_kinehardening_Nslip (1:nSlipFamilies,instance) > 0_pInt & - .and. param(instance)%tau1 (1:nSlipFamilies) <= 0.0_pReal)) extmsg = trim(extmsg)//' tau1' - if (any(plastic_kinehardening_Nslip (1:nSlipFamilies,instance) > 0_pInt & - .and. param(instance)%tau1_b(1:nSlipFamilies) < 0.0_pReal)) extmsg = trim(extmsg)//' tau1_b' - if (param(instance)%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0' - if (param(instance)%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//' n_slip' - if (param(instance)%aTolResistance <= 0.0_pReal) param(instance)%aTolResistance = 1.0_pReal ! default absolute tolerance 1 Pa - if (param(instance)%aTolShear <= 0.0_pReal) param(instance)%aTolShear = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (extmsg /= '') then - extmsg = trim(extmsg)//' ('//PLASTICITY_KINEHARDENING_label//')' ! prepare error message identifier - call IO_error(211_pInt,ip=instance,ext_msg=extmsg) - endif - + if ( prm%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0' + if ( prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' n_slip' + if (any(prm%crss0 <= 0.0_pReal)) extmsg = trim(extmsg)//' crss0' + if (any(prm%tau1 <= 0.0_pReal)) extmsg = trim(extmsg)//' tau1' + if (any(prm%tau1_b <= 0.0_pReal)) extmsg = trim(extmsg)//' tau1_b' + + !ToDo: Any sensible checks for theta? + + endif slipActive !-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - - outputsLoop: do o = 1_pInt,plastic_kinehardening_Noutput(instance) - select case(param(instance)%outputID(o)) - case(crss_ID, & !< critical resolved stress - crss_back_ID, & !< critical resolved back stress - sense_ID, & !< sense of acting shear stress (-1 or +1) - chi0_ID, & !< backstress at last switch of stress sense - gamma0_ID, & !< accumulated shear at last switch of stress sense - accshear_ID, & - shearrate_ID, & - resolvedstress_ID) - mySize = nSlip - case(sumGamma_ID) - mySize = 1_pInt - case default - end select +! exit if any parameter is out of range + if (extmsg /= '') & + call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//PLASTICITY_KINEHARDENING_label//')') + +!-------------------------------------------------------------------------------------------------- +! output pararameters + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + + case ('resistance') + outputID = merge(crss_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('accumulatedshear') + outputID = merge(accshear_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('shearrate') + outputID = merge(shearrate_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('resolvedstress') + outputID = merge(resolvedstress_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('backstress') + outputID = merge(crss_back_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('sense') + outputID = merge(sense_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('chi0') + outputID = merge(chi0_ID,undefined_ID,prm%totalNslip>0_pInt) + case ('gamma0') + outputID = merge(gamma0_ID,undefined_ID,prm%totalNslip>0_pInt) + + end select + + if (outputID /= undefined_ID) then + plastic_kinehardening_output(i,phase_plasticityInstance(p)) = outputs(i) + plastic_kinehardening_sizePostResult(i,phase_plasticityInstance(p)) = prm%totalNslip + prm%outputID = [prm%outputID , outputID] + endif + + enddo - outputFound: if (mySize > 0_pInt) then - plastic_kinehardening_sizePostResult(o,instance) = mySize - plastic_kinehardening_sizePostResults(instance) = plastic_kinehardening_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop !-------------------------------------------------------------------------------------------------- ! allocate state arrays - sizeDotState = nSlip & !< crss - + nSlip & !< crss_back - + nSlip & !< accumulated (absolute) shear - + 1_pInt !< sum(gamma) - - sizeDeltaState = nSlip & !< sense of acting shear stress (-1 or +1) - + nSlip & !< backstress at last switch of stress sense - + nSlip !< accumulated shear at last switch of stress sense + NipcMyPhase = count(material_phase == p) + sizeDotState = size(['crss ','crss_back', 'accshear ']) * prm%totalNslip + sizeDeltaState = size(['sense ', 'chi0 ', 'gamma0' ]) * prm%totalNslip + sizeState = sizeDotState + sizeDeltaState - sizeState = sizeDotState + sizeDeltaState - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%offsetDeltaState = sizeDotState - plasticState(phase)%sizePostResults = plastic_kinehardening_sizePostResults(instance) - plasticState(phase)%nSlip = nSlip - - allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%aTolState (sizeDotState), source=0.0_pReal) - allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase), source=0.0_pReal) ! allocate space for deltaState - if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) + call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,sizeDeltaState, & + prm%totalNslip,0_pInt,0_pInt) + plasticState(p)%sizePostResults = sum(plastic_kinehardening_sizePostResult(:,phase_plasticityInstance(p))) + plasticState(p)%offsetDeltaState = sizeDotState - offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt - plasticState(phase)%slipRate => & - plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) +!-------------------------------------------------------------------------------------------------- +! locally defined state aliases and initialization of state0 and aTolState + startIndex = 1_pInt + endIndex = prm%totalNslip + stt%crss => plasticState(p)%state (startIndex:endIndex,:) + stt%crss = spread(prm%crss0, 2, NipcMyPhase) + dot%crss => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance - allocate(param(instance)%hardeningMatrix_SlipSlip(nSlip,nSlip), source=0.0_pReal) - do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X - index_myFamily = sum(plastic_kinehardening_Nslip(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_kinehardening_Nslip(f,instance) ! loop over (active) systems in my family (slip) - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_kinehardening_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_kinehardening_Nslip(o,instance) ! loop over (active) systems in other family (slip) - param(instance)%hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & - param(instance)%interaction_SlipSlip(lattice_interactionSlipSlip( & - sum(lattice_NslipSystem(1:f-1,phase))+j, & - sum(lattice_NslipSystem(1:o-1,phase))+k, & - phase)) - enddo; enddo - enddo; enddo - -!---------------------------------------------------------------------------------------------- -!locally define dotState alias + startIndex = endIndex + 1_pInt + endIndex = endIndex + prm%totalNslip + stt%crss_back => plasticState(p)%state (startIndex:endIndex,:) + dot%crss_back => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance - endindex = 0_pInt - o = endIndex ! offset of dotstate index relative to state index - - startIndex = endIndex + 1_pInt - endIndex = endIndex + nSlip - state (instance)%crss => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) - state0 (instance)%crss => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) - dotState(instance)%crss => plasticState(phase)%dotState (startIndex-o:endIndex-o,1:NipcMyPhase) + startIndex = endIndex + 1_pInt + endIndex = endIndex + prm%totalNslip + stt%accshear => plasticState(p)%state (startIndex:endIndex,:) + dot%accshear => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear + ! global alias + plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%accumulatedSlip => plasticState(p)%state(startIndex:endIndex,:) - state0(instance)%crss = spread(math_expand(param(instance)%crss0,& - plastic_kinehardening_Nslip(:,instance)), & - 2, NipcMyPhase) - plasticState(phase)%aTolState(startIndex-o:endIndex-o) = param(instance)%aTolResistance - -! ............................................. - startIndex = endIndex + 1_pInt - endIndex = endIndex + nSlip - state (instance)%crss_back => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) - state0 (instance)%crss_back => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) - dotState(instance)%crss_back => plasticState(phase)%dotState (startIndex-o:endIndex-o,1:NipcMyPhase) - - state0(instance)%crss_back = 0.0_pReal - plasticState(phase)%aTolState(startIndex-o:endIndex-o) = param(instance)%aTolResistance - -! ............................................. - startIndex = endIndex + 1_pInt - endIndex = endIndex + nSlip - state (instance)%accshear => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) - state0 (instance)%accshear => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) - dotState(instance)%accshear => plasticState(phase)%dotState (startIndex-o:endIndex-o,1:NipcMyPhase) + o = plasticState(p)%offsetDeltaState + startIndex = endIndex + 1_pInt + endIndex = endIndex + prm%totalNslip + stt%sense => plasticState(p)%state (startIndex :endIndex ,:) + dlt%sense => plasticState(p)%deltaState(startIndex-o:endIndex-o,:) - state0(instance)%accshear = 0.0_pReal - plasticState(phase)%aTolState(startIndex-o:endIndex-o) = param(instance)%aTolShear - -! ............................................. - startIndex = endIndex + 1_pInt - endIndex = endIndex + 1_pInt - state (instance)%sumGamma => plasticState(phase)%state (startIndex ,1:NipcMyPhase) - state0 (instance)%sumGamma => plasticState(phase)%state0 (startIndex ,1:NipcMyPhase) - dotState(instance)%sumGamma => plasticState(phase)%dotState (startIndex-o ,1:NipcMyPhase) + startIndex = endIndex + 1_pInt + endIndex = endIndex + prm%totalNslip + stt%chi0 => plasticState(p)%state (startIndex :endIndex ,:) + dlt%chi0 => plasticState(p)%deltaState(startIndex-o:endIndex-o,:) - state0(instance)%sumGamma = 0.0_pReal - plasticState(phase)%aTolState(startIndex-o:endIndex-o) = param(instance)%aTolShear - -!---------------------------------------------------------------------------------------------- -!locally define deltaState alias - o = endIndex - -! ............................................. - startIndex = endIndex + 1_pInt - endIndex = endIndex + nSlip - state (instance)%sense => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) - state0 (instance)%sense => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) - deltaState(instance)%sense => plasticState(phase)%deltaState(startIndex-o:endIndex-o,1:NipcMyPhase) - - state0(instance)%sense = 0.0_pReal - -! ............................................. - startIndex = endIndex + 1_pInt - endIndex = endIndex + nSlip - state (instance)%chi0 => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) - state0 (instance)%chi0 => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) - deltaState(instance)%chi0 => plasticState(phase)%deltaState(startIndex-o:endIndex-o,1:NipcMyPhase) - - state0(instance)%chi0 = 0.0_pReal - -! ............................................. - startIndex = endIndex + 1_pInt - endIndex = endIndex + nSlip - state (instance)%gamma0 => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) - state0 (instance)%gamma0 => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) - deltaState(instance)%gamma0 => plasticState(phase)%deltaState(startIndex-o:endIndex-o,1:NipcMyPhase) + startIndex = endIndex + 1_pInt + endIndex = endIndex + prm%totalNslip + stt%gamma0 => plasticState(p)%state (startIndex :endIndex ,:) + dlt%gamma0 => plasticState(p)%deltaState(startIndex-o:endIndex-o,:) - state0(instance)%gamma0 = 0.0_pReal - - endif myPhase2 - enddo initializeInstances + plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally + + end associate + + enddo end subroutine plastic_kinehardening_init -!-------------------------------------------------------------------------------------------------- -!> @brief calculation of shear rates (\dot \gamma) -!-------------------------------------------------------------------------------------------------- -subroutine plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & - Tstar_v,ph,instance,of) - - use lattice, only: & - lattice_NslipSystem, & - lattice_Sslip_v, & - lattice_maxNslipFamily, & - lattice_NnonSchmid - - implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - integer(pInt), intent(in) :: & - ph, & !< phase ID - instance, & !< instance of that phase - of !< index of phaseMember - real(pReal), dimension(plastic_kinehardening_totalNslip(instance)), intent(out) :: & - gdot_pos, & !< shear rates from positive line segments - gdot_neg, & !< shear rates from negative line segments - tau_pos, & !< shear stress on positive line segments - tau_neg !< shear stress on negative line segments - - integer(pInt) :: & - index_myFamily, & - f,i,j,k - - - j = 0_pInt - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,plastic_kinehardening_Nslip(f,instance) - j = j + 1_pInt - tau_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - tau_neg(j) = tau_pos(j) - nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) - tau_pos(j) = tau_pos(j) + param(instance)%nonSchmidCoeff(k)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+0,index_myFamily+i,ph)) - tau_neg(j) = tau_neg(j) + param(instance)%nonSchmidCoeff(k)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - enddo nonSchmidSystems - enddo slipSystems - enddo slipFamilies - - gdot_pos = 0.5_pReal * param(instance)%gdot0 * & - (abs(tau_pos-state(instance)%crss_back(:,of))/ & - state(instance)%crss(:,of))**param(instance)%n_slip & - *sign(1.0_pReal,tau_pos-state(instance)%crss_back(:,of)) - gdot_neg = 0.5_pReal * param(instance)%gdot0 * & - (abs(tau_neg-state(instance)%crss_back(:,of))/ & - state(instance)%crss(:,of))**param(instance)%n_slip & - *sign(1.0_pReal,tau_neg-state(instance)%crss_back(:,of)) - - -end subroutine plastic_kinehardening_shearRates - !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- -subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dTstar99, & - Tstar_v,ipc,ip,el) - use prec, only: & - dNeq0 - use debug, only: & - debug_level, & - debug_constitutive, & - debug_levelExtensive, & - debug_levelSelective, & - debug_e, & - debug_i, & - debug_g - use math, only: & - math_Plain3333to99, & - math_Mandel6to33, & - math_transpose33 - use lattice, only: & - lattice_Sslip, & !< schmid matrix - lattice_maxNslipFamily, & - lattice_NslipSystem, & - lattice_NnonSchmid - use material, only: & - phaseAt, phasememberAt, & - phase_plasticityInstance +pure subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) implicit none - real(pReal), dimension(3,3), intent(out) :: & + real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient - real(pReal), dimension(9,9), intent(out) :: & - dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress + real(pReal), dimension(3,3,3,3), intent(out) :: & + dLp_dMp !< derivative of Lp with respect to the Mandel stress + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - - integer(pInt) :: & instance, & - index_myFamily, & - f,i,j,k,l,m,n, & - of, & - ph - - real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(phaseAt(ipc,ip,el)))) :: & - gdot_pos,gdot_neg, & - tau_pos,tau_neg - real(pReal) :: & - dgdot_dtau_pos,dgdot_dtau_neg - real(pReal), dimension(3,3,3,3) :: & - dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor - real(pReal), dimension(3,3,2) :: & - nonSchmid_tensor + of - ph = phaseAt(ipc,ip,el) !< figures phase for each material point - of = phasememberAt(ipc,ip,el) !< index of the positions of each constituent of material point, phasememberAt is a function in material that helps figure them out - instance = phase_plasticityInstance(ph) - - Lp = 0.0_pReal - dLp_dTstar3333 = 0.0_pReal - dLp_dTstar99 = 0.0_pReal - - call plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & - Tstar_v,ph,instance,of) - - - j = 0_pInt ! reading and marking the starting index for each slip family - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,plastic_kinehardening_Nslip(f,instance) - j = j + 1_pInt - - ! build nonSchmid tensor - nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) - do k = 1,lattice_NnonSchmid(ph) - nonSchmid_tensor(1:3,1:3,1) = & - nonSchmid_tensor(1:3,1:3,1) + param(instance)%nonSchmidCoeff(k) * & - lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = & - nonSchmid_tensor(1:3,1:3,2) + param(instance)%nonSchmidCoeff(k) * & - lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) - enddo - - Lp = Lp + (gdot_pos(j)+gdot_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! sum of all gdot*SchmidTensor gives Lp - - ! Calculation of the tangent of Lp ! sensitivity of Lp - if (dNeq0(gdot_pos(j))) then - dgdot_dtau_pos = gdot_pos(j)*param(instance)%n_slip/(tau_pos(j)-state(instance)%crss_back(j,of)) - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dTstar3333(k,l,m,n) = & - dLp_dTstar3333(k,l,m,n) + dgdot_dtau_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & - nonSchmid_tensor(m,n,1) - endif - - if (dNeq0(gdot_neg(j))) then - dgdot_dtau_neg = gdot_neg(j)*param(instance)%n_slip/(tau_neg(j)-state(instance)%crss_back(j,of)) - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dTstar3333(k,l,m,n) = & - dLp_dTstar3333(k,l,m,n) + dgdot_dtau_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & - nonSchmid_tensor(m,n,2) - endif - enddo slipSystems - enddo slipFamilies - - dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) - -end subroutine plastic_kinehardening_LpAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates (instantaneous) incremental change of microstructure -!-------------------------------------------------------------------------------------------------- -subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) - use prec, only: & - dNeq, & - dEq0 - use debug, only: & - debug_level, & - debug_constitutive, & - debug_levelExtensive, & - debug_levelSelective, & - debug_e, & - debug_i, & - debug_g - use material, only: & - phaseAt, & - phasememberAt, & - phase_plasticityInstance - - implicit none - real(pReal), dimension(6), intent(in):: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(phaseAt(ipc,ip,el)))) :: & - gdot_pos,gdot_neg, & - tau_pos,tau_neg, & - sense integer(pInt) :: & - ph, & - instance, & !< instance of my instance (unique number of my constitutive model) - of, & - j !< shortcut notation for offset position in state array + i,k,l,m,n + real(pReal), dimension(param(instance)%totalNslip) :: & + gdot_pos,gdot_neg, & + dgdot_dtau_pos,dgdot_dtau_neg - ph = phaseAt(ipc,ip,el) - of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember - instance = phase_plasticityInstance(ph) + Lp = 0.0_pReal + dLp_dMp = 0.0_pReal - call plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & - Tstar_v,ph,instance,of) - sense = merge(state(instance)%sense(:,of), & ! keep existing... - sign(1.0_pReal,gdot_pos+gdot_neg), & ! ...or have a defined - dEq0(gdot_pos+gdot_neg,1e-10_pReal)) ! current sense of shear direction + associate(prm => param(instance)) -#ifdef DEBUG - if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & - .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then - write(6,'(a)') '======= kinehardening delta state =======' - endif -#endif + call kinetics(Mp,instance,of,gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg) -!-------------------------------------------------------------------------------------------------- -! switch in sense of shear? - do j = 1,plastic_kinehardening_totalNslip(instance) -#ifdef DEBUG - if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & - .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then - write(6,'(i2,1x,f7.4,1x,f7.4)') j,sense(j),state(instance)%sense(j,of) - endif -#endif - if (dNeq(sense(j),state(instance)%sense(j,of),0.1_pReal)) then - deltaState(instance)%sense (j,of) = sense(j) - state(instance)%sense(j,of) ! switch sense - deltaState(instance)%chi0 (j,of) = abs(state(instance)%crss_back(j,of)) - state(instance)%chi0(j,of) ! remember current backstress magnitude - deltaState(instance)%gamma0(j,of) = state(instance)%accshear(j,of) - state(instance)%gamma0(j,of) ! remember current accumulated shear - else - deltaState(instance)%sense (j,of) = 0.0_pReal ! no change - deltaState(instance)%chi0 (j,of) = 0.0_pReal - deltaState(instance)%gamma0(j,of) = 0.0_pReal - endif + do i = 1_pInt, prm%totalNslip + Lp = Lp + (gdot_pos(i)+gdot_neg(i))*prm%Schmid(1:3,1:3,i) + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + + dgdot_dtau_pos(i) * prm%Schmid(k,l,i) * prm%nonSchmid_pos(m,n,i) & + + dgdot_dtau_neg(i) * prm%Schmid(k,l,i) * prm%nonSchmid_neg(m,n,i) enddo -end subroutine plastic_kinehardening_deltaState + end associate +end subroutine plastic_kinehardening_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el) - use lattice, only: & - lattice_maxNslipFamily - use material, only: & - material_phase, & - phaseAt, phasememberAt, & - phase_plasticityInstance +subroutine plastic_kinehardening_dotState(Mp,instance,of) implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation, vector form - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element !< microstructure state + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer(pInt), intent(in) :: & + instance, & + of integer(pInt) :: & - instance,ph, & - f,i,j, & - nSlip, & - of - - real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_pos,gdot_neg, & - tau_pos,tau_neg - - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - nSlip = plastic_kinehardening_totalNslip(instance) - - dotState(instance)%sumGamma(of) = 0.0_pReal + i + real(pReal) :: & + sumGamma + real(pReal), dimension(param(instance)%totalNslip) :: & + gdot_pos,gdot_neg - call plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & - Tstar_v,ph,instance,of) - - j = 0_pInt - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily - slipSystems: do i = 1_pInt,plastic_kinehardening_Nslip(f,instance) - j = j+1_pInt - dotState(instance)%crss(j,of) = & ! evolution of slip resistance j - dot_product(param(instance)%hardeningMatrix_SlipSlip(j,1:nSlip),abs(gdot_pos+gdot_neg)) * & - ( param(instance)%theta1(f) + & - (param(instance)%theta0(f) - param(instance)%theta1(f) & - + param(instance)%theta0(f)*param(instance)%theta1(f)*state(instance)%sumGamma(of)/param(instance)%tau1(f)) & - *exp(-state(instance)%sumGamma(of)*param(instance)%theta0(f)/param(instance)%tau1(f)) & ! V term depending on the harding law + + associate(prm => param(instance), stt => state(instance), dot => dotState(instance)) + + call kinetics(Mp,instance,of,gdot_pos,gdot_neg) + dot%accshear(:,of) = abs(gdot_pos+gdot_neg) + sumGamma = sum(stt%accshear(:,of)) + + do i = 1_pInt, prm%totalNslip + dot%crss(i,of) = dot_product(prm%interaction_SlipSlip(i,:),dot%accshear(:,of)) & + * ( prm%theta1(i) & + + (prm%theta0(i) - prm%theta1(i) + prm%theta0(i)*prm%theta1(i)*sumGamma/prm%tau1(i)) & + * exp(-sumGamma*prm%theta0(i)/prm%tau1(i)) & + ) + enddo + dot%crss_back(:,of) = stt%sense(:,of)*dot%accshear(:,of) * & + ( prm%theta1_b + & + (prm%theta0_b - prm%theta1_b & + + prm%theta0_b*prm%theta1_b/(prm%tau1_b+stt%chi0(:,of))*(stt%accshear(:,of)-stt%gamma0(:,of))& + ) *exp(-(stt%accshear(:,of)-stt%gamma0(:,of)) *prm%theta0_b/(prm%tau1_b+stt%chi0(:,of))) & ) - dotState(instance)%crss_back(j,of) = & ! evolution of back stress resistance j - state(instance)%sense(j,of)*abs(gdot_pos(j)+gdot_neg(j)) * & - ( param(instance)%theta1_b(f) + & - (param(instance)%theta0_b(f) - param(instance)%theta1_b(f) & - + param(instance)%theta0_b(f)*param(instance)%theta1_b(f)/(param(instance)%tau1_b(f)+state(instance)%chi0(j,of)) & - *(state(instance)%accshear(j,of)-state(instance)%gamma0(j,of))) & - *exp(-(state(instance)%accshear(j,of)-state(instance)%gamma0(j,of)) & - *param(instance)%theta0_b(f)/(param(instance)%tau1_b(f)+state(instance)%chi0(j,of))) & - ) ! V term depending on the harding law for back stress - - dotState(instance)%accshear(j,of) = abs(gdot_pos(j)+gdot_neg(j)) - dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + dotState(instance)%accshear(j,of) - enddo slipSystems - enddo slipFamilies + + end associate end subroutine plastic_kinehardening_dotState + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates (instantaneous) incremental change of microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_kinehardening_deltaState(Mp,instance,of) + use prec, only: & + dNeq, & + dEq0 +#ifdef DEBUG + use debug, only: & + debug_level, & + debug_constitutive,& + debug_levelExtensive, & + debug_levelSelective +#endif + + implicit none + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer(pInt), intent(in) :: & + instance, & + of + + real(pReal), dimension(param(instance)%totalNslip) :: & + gdot_pos,gdot_neg, & + sense + + associate(prm => param(instance), stt => state(instance), dlt => deltaState(instance)) + + call kinetics(Mp,instance,of,gdot_pos,gdot_neg) + sense = merge(state(instance)%sense(:,of), & ! keep existing... + sign(1.0_pReal,gdot_pos+gdot_neg), & ! ...or have a defined + dEq0(gdot_pos+gdot_neg,1e-10_pReal)) ! current sense of shear direction + +#ifdef DEBUG + if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & + .and. (of == prm%of_debug & + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then + write(6,'(a)') '======= kinehardening delta state =======' + write(6,*) sense,state(instance)%sense(:,of) + endif +#endif + +!-------------------------------------------------------------------------------------------------- +! switch in sense of shear? + where(dNeq(sense,stt%sense(:,of),0.1_pReal)) + dlt%sense (:,of) = sense - stt%sense(:,of) ! switch sense + dlt%chi0 (:,of) = abs(stt%crss_back(:,of)) - stt%chi0(:,of) ! remember current backstress magnitude + dlt%gamma0(:,of) = stt%accshear(:,of) - stt%gamma0(:,of) ! remember current accumulated shear + else where + dlt%sense (:,of) = 0.0_pReal + dlt%chi0 (:,of) = 0.0_pReal + dlt%gamma0(:,of) = 0.0_pReal + end where + + end associate + +end subroutine plastic_kinehardening_deltaState + + !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -function plastic_kinehardening_postResults(Tstar_v,ipc,ip,el) - use material, only: & - material_phase, & - phaseAt, phasememberAt, & - phase_plasticityInstance - use lattice, only: & - lattice_Sslip_v, & - lattice_maxNslipFamily, & - lattice_NslipSystem +function plastic_kinehardening_postResults(Mp,instance,of) result(postResults) + use math, only: & + math_mul33xx33 implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element !< microstructure state + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer(pInt), intent(in) :: & + instance, & + of - real(pReal), dimension(plastic_kinehardening_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - plastic_kinehardening_postResults + real(pReal), dimension(sum(plastic_kinehardening_sizePostResult(:,instance))) :: & + postResults integer(pInt) :: & - instance,ph, of, & - nSlip,& - o,f,i,c,j,& - index_myFamily - - real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_pos,gdot_neg, & - tau_pos,tau_neg + o,c,i + real(pReal), dimension(param(instance)%totalNslip) :: & + gdot_pos,gdot_neg - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - - nSlip = plastic_kinehardening_totalNslip(instance) - - plastic_kinehardening_postResults = 0.0_pReal c = 0_pInt - call plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & - Tstar_v,ph,instance,of) + associate(prm => param(instance), stt => state(instance)) + + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) - outputsLoop: do o = 1_pInt,plastic_kinehardening_Noutput(instance) - select case(param(instance)%outputID(o)) case (crss_ID) - plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%crss(:,of) - c = c + nSlip - + postResults(c+1_pInt:c+prm%totalNslip) = stt%crss(:,of) case(crss_back_ID) - plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%crss_back(:,of) - c = c + nSlip - + postResults(c+1_pInt:c+prm%totalNslip) = stt%crss_back(:,of) case (sense_ID) - plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%sense(:,of) - c = c + nSlip - + postResults(c+1_pInt:c+prm%totalNslip) = stt%sense(:,of) case (chi0_ID) - plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%chi0(:,of) - c = c + nSlip - + postResults(c+1_pInt:c+prm%totalNslip) = stt%chi0(:,of) case (gamma0_ID) - plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%gamma0(:,of) - c = c + nSlip - + postResults(c+1_pInt:c+prm%totalNslip) = stt%gamma0(:,of) case (accshear_ID) - plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%accshear(:,of) - c = c + nSlip - - case (sumGamma_ID) - plastic_kinehardening_postResults(c+1_pInt) = state(instance)%sumGamma(of) - c = c + 1_pInt - + postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear(:,of) case (shearrate_ID) - plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = gdot_pos+gdot_neg - c = c + nSlip - + call kinetics(Mp,instance,of,gdot_pos,gdot_neg) + postResults(c+1_pInt:c+prm%totalNslip) = gdot_pos+gdot_neg case (resolvedstress_ID) - j = 0_pInt - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,plastic_kinehardening_Nslip(f,instance) - j = j + 1_pInt - plastic_kinehardening_postResults(c+j) = & - dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - enddo slipSystems - enddo slipFamilies - c = c + nSlip - + do i = 1_pInt, prm%totalNslip + postResults(c+i) = math_mul33xx33(Mp,prm%Schmid(1:3,1:3,i)) + enddo + end select + + c = c + prm%totalNslip + enddo outputsLoop + end associate + end function plastic_kinehardening_postResults + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates shear rates on slip systems and derivatives with respect to resolved stress +!> @details: Shear rates are calculated only optionally. +! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to +! have the optional arguments at the end +!-------------------------------------------------------------------------------------------------- +pure subroutine kinetics(Mp,instance,of, & + gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg) + use prec, only: & + dNeq0 + use math, only: & + math_mul33xx33 + + implicit none + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer(pInt), intent(in) :: & + instance, & + of + + real(pReal), intent(out), dimension(param(instance)%totalNslip) :: & + gdot_pos, & + gdot_neg + real(pReal), intent(out), optional, dimension(param(instance)%totalNslip) :: & + dgdot_dtau_pos, & + dgdot_dtau_neg + + real(pReal), dimension(param(instance)%totalNslip) :: & + tau_pos, & + tau_neg + integer(pInt) :: i + logical :: nonSchmidActive + + associate(prm => param(instance), stt => state(instance)) + + nonSchmidActive = size(prm%nonSchmidCoeff) > 0_pInt + + do i = 1_pInt, prm%totalNslip + tau_pos(i) = math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i)) - stt%crss_back(i,of) + tau_neg(i) = merge(math_mul33xx33(Mp,prm%nonSchmid_neg(1:3,1:3,i)) - stt%crss_back(i,of), & + 0.0_pReal, nonSchmidActive) + enddo + + where(dNeq0(tau_pos)) + gdot_pos = prm%gdot0 * merge(0.5_pReal,1.0_pReal, nonSchmidActive) & ! 1/2 if non-Schmid active + * sign(abs(tau_pos/stt%crss(:,of))**prm%n, tau_pos) + else where + gdot_pos = 0.0_pReal + end where + + where(dNeq0(tau_neg)) + gdot_neg = prm%gdot0 * 0.5_pReal & ! only used if non-Schmid active, always 1/2 + * sign(abs(tau_neg/stt%crss(:,of))**prm%n, tau_neg) + else where + gdot_neg = 0.0_pReal + end where + + if (present(dgdot_dtau_pos)) then + where(dNeq0(gdot_pos)) + dgdot_dtau_pos = gdot_pos*prm%n/tau_pos + else where + dgdot_dtau_pos = 0.0_pReal + end where + endif + if (present(dgdot_dtau_neg)) then + where(dNeq0(gdot_neg)) + dgdot_dtau_neg = gdot_neg*prm%n/tau_neg + else where + dgdot_dtau_neg = 0.0_pReal + end where + endif + end associate + +end subroutine kinetics + end module plastic_kinehardening diff --git a/src/plastic_none.f90 b/src/plastic_none.f90 index 5470c4a43..0b3df43ef 100644 --- a/src/plastic_none.f90 +++ b/src/plastic_none.f90 @@ -1,7 +1,8 @@ !-------------------------------------------------------------------------------------------------- !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for purely elastic material +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Dummy plasticity for purely elastic material !-------------------------------------------------------------------------------------------------- module plastic_none @@ -13,7 +14,6 @@ module plastic_none contains - !-------------------------------------------------------------------------------------------------- !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks @@ -32,52 +32,39 @@ subroutine plastic_none_init debug_levelBasic use IO, only: & IO_timeStamp - use numerics, only: & - numerics_integrator use material, only: & phase_plasticity, & + material_allocatePlasticState, & PLASTICITY_NONE_label, & + PLASTICITY_NONE_ID, & material_phase, & - plasticState, & - PLASTICITY_none_ID + plasticState implicit none - integer(pInt) :: & - maxNinstance, & - phase, & - NofMyPhase - - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONE_label//' init -+>>>' + Ninstance, & + p, & + NipcMyPhase + + write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_NONE_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - - maxNinstance = int(count(phase_plasticity == PLASTICITY_none_ID),pInt) + + Ninstance = int(count(phase_plasticity == PLASTICITY_NONE_ID),pInt) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - initializeInstances: do phase = 1_pInt, size(phase_plasticity) - if (phase_plasticity(phase) == PLASTICITY_none_ID) then - NofMyPhase=count(material_phase==phase) + do p = 1_pInt, size(phase_plasticity) + if (phase_plasticity(p) /= PLASTICITY_NONE_ID) cycle - allocate(plasticState(phase)%aTolState (0_pInt)) - allocate(plasticState(phase)%state0 (0_pInt,NofMyPhase)) - allocate(plasticState(phase)%partionedState0 (0_pInt,NofMyPhase)) - allocate(plasticState(phase)%subState0 (0_pInt,NofMyPhase)) - allocate(plasticState(phase)%state (0_pInt,NofMyPhase)) +!-------------------------------------------------------------------------------------------------- +! allocate state arrays + NipcMyPhase = count(material_phase == p) + call material_allocatePlasticState(p,NipcMyPhase,0_pInt,0_pInt,0_pInt, & + 0_pInt,0_pInt,0_pInt) + plasticState(p)%sizePostResults = 0_pInt - allocate(plasticState(phase)%dotState (0_pInt,NofMyPhase)) - allocate(plasticState(phase)%deltaState (0_pInt,NofMyPhase)) - if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (0_pInt,NofMyPhase)) - allocate(plasticState(phase)%previousDotState2(0_pInt,NofMyPhase)) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (0_pInt,NofMyPhase)) - if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,0_pInt,NofMyPhase)) - endif - enddo initializeInstances + enddo end subroutine plastic_none_init diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 053fe958b..c745d6f06 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -2,12 +2,11 @@ !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for phenomenological crystal plasticity formulation using a powerlaw -!! fitting +!> @brief phenomenological crystal plasticity formulation using a powerlaw fitting !-------------------------------------------------------------------------------------------------- module plastic_phenopowerlaw use prec, only: & - pReal,& + pReal, & pInt implicit none @@ -75,17 +74,16 @@ module plastic_phenopowerlaw outputID !< ID of each post result output end type !< container type for internal constitutive parameters - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) - type, private :: tPhenopowerlawState real(pReal), pointer, dimension(:,:) :: & xi_slip, & xi_twin, & gamma_slip, & - gamma_twin, & - whole + gamma_twin end type + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) type(tPhenopowerlawState), allocatable, dimension(:), private :: & dotState, & state @@ -94,7 +92,11 @@ module plastic_phenopowerlaw plastic_phenopowerlaw_init, & plastic_phenopowerlaw_LpAndItsTangent, & plastic_phenopowerlaw_dotState, & - plastic_phenopowerlaw_postResults + plastic_phenopowerlaw_postResults, & + plastic_phenopowerlaw_results + private :: & + kinetics_slip, & + kinetics_twin contains @@ -110,8 +112,7 @@ subroutine plastic_phenopowerlaw_init compiler_options #endif use prec, only: & - pStringLen, & - dEq0 + pStringLen use debug, only: & debug_level, & debug_constitutive,& @@ -119,7 +120,6 @@ subroutine plastic_phenopowerlaw_init use math, only: & math_expand use IO, only: & - IO_warning, & IO_error, & IO_timeStamp use material, only: & @@ -149,7 +149,7 @@ subroutine plastic_phenopowerlaw_init character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] integer(kind(undefined_ID)) :: & - outputID !< ID of each post result output + outputID character(len=pStringLen) :: & structure = '',& @@ -157,7 +157,7 @@ subroutine plastic_phenopowerlaw_init character(len=65536), dimension(:), allocatable :: & outputs - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' + write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -173,40 +173,41 @@ subroutine plastic_phenopowerlaw_init allocate(state(Ninstance)) allocate(dotState(Ninstance)) - do p = 1_pInt, size(phase_plasticityInstance) + do p = 1_pInt, size(phase_plasticity) if (phase_plasticity(p) /= PLASTICITY_PHENOPOWERLAW_ID) cycle associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & - stt => state(phase_plasticityInstance(p))) + stt => state(phase_plasticityInstance(p)), & + config => config_phase(p)) - structure = config_phase(p)%getString('lattice_structure') + structure = config%getString('lattice_structure') !-------------------------------------------------------------------------------------------------- ! optional parameters that need to be defined - prm%twinB = config_phase(p)%getFloat('twin_b',defaultVal=1.0_pReal) - prm%twinC = config_phase(p)%getFloat('twin_c',defaultVal=0.0_pReal) - prm%twinD = config_phase(p)%getFloat('twin_d',defaultVal=0.0_pReal) - prm%twinE = config_phase(p)%getFloat('twin_e',defaultVal=0.0_pReal) + prm%twinB = config%getFloat('twin_b',defaultVal=1.0_pReal) + prm%twinC = config%getFloat('twin_c',defaultVal=0.0_pReal) + prm%twinD = config%getFloat('twin_d',defaultVal=0.0_pReal) + prm%twinE = config%getFloat('twin_e',defaultVal=0.0_pReal) + + prm%aTolResistance = config%getFloat('atol_resistance',defaultVal=1.0_pReal) + prm%aTolShear = config%getFloat('atol_shear', defaultVal=1.0e-6_pReal) + prm%aTolTwinfrac = config%getFloat('atol_twinfrac', defaultVal=1.0e-6_pReal) - prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal) - prm%aTolShear = config_phase(p)%getFloat('atol_shear', defaultVal=1.0e-6_pReal) - prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac', defaultVal=1.0e-6_pReal) - ! sanity checks - if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//'aTolresistance ' - if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//'aTolShear ' - if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//'atoltwinfrac ' + if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//' aTolresistance' + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//' aTolShear' + if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//' atoltwinfrac' !-------------------------------------------------------------------------------------------------- ! slip related parameters - prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) + prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& - config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + config%getFloat('c/a',defaultVal=0.0_pReal)) if(structure=='bcc') then - prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',& - defaultVal = emptyRealArray) + prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray) prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) else @@ -214,18 +215,18 @@ subroutine plastic_phenopowerlaw_init prm%nonSchmid_neg = prm%Schmid_slip endif prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & - config_phase(p)%getFloats('interaction_slipslip'), & + config%getFloats('interaction_slipslip'), & structure(1:3)) - prm%xi_slip_0 = config_phase(p)%getFloats('tau0_slip', requiredShape=shape(prm%Nslip)) - prm%xi_slip_sat = config_phase(p)%getFloats('tausat_slip', requiredShape=shape(prm%Nslip)) - prm%H_int = config_phase(p)%getFloats('h_int', requiredShape=shape(prm%Nslip), & - defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) - - prm%gdot0_slip = config_phase(p)%getFloat('gdot0_slip') - prm%n_slip = config_phase(p)%getFloat('n_slip') - prm%a_slip = config_phase(p)%getFloat('a_slip') - prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip') + prm%xi_slip_0 = config%getFloats('tau0_slip', requiredSize=size(prm%Nslip)) + prm%xi_slip_sat = config%getFloats('tausat_slip', requiredSize=size(prm%Nslip)) + prm%H_int = config%getFloats('h_int', requiredSize=size(prm%Nslip), & + defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) + + prm%gdot0_slip = config%getFloat('gdot0_slip') + prm%n_slip = config%getFloat('n_slip') + prm%a_slip = config%getFloat('a_slip') + prm%h0_SlipSlip = config%getFloat('h0_slipslip') ! expand: family => system prm%xi_slip_0 = math_expand(prm%xi_slip_0, prm%Nslip) @@ -233,11 +234,11 @@ subroutine plastic_phenopowerlaw_init prm%H_int = math_expand(prm%H_int, prm%Nslip) ! sanity checks - if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//'gdot0_slip ' - if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//'a_slip ' ! ToDo: negative values ok? - if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//'n_slip ' ! ToDo: negative values ok? - if (any(prm%xi_slip_0 <= 0.0_pReal)) extmsg = trim(extmsg)//'xi_slip_0 ' - if (any(prm%xi_slip_sat < prm%xi_slip_0)) extmsg = trim(extmsg)//'xi_slip_sat ' + if ( prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0_slip' + if ( prm%a_slip <= 0.0_pReal) extmsg = trim(extmsg)//' a_slip' + if ( prm%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//' n_slip' + if (any(prm%xi_slip_0 <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_slip_0' + if (any(prm%xi_slip_sat < prm%xi_slip_0)) extmsg = trim(extmsg)//' xi_slip_sat' else slipActive allocate(prm%interaction_SlipSlip(0,0)) allocate(prm%xi_slip_0(0)) @@ -245,30 +246,30 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! twin related parameters - prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) + prm%Ntwin = config%getInts('ntwin', defaultVal=emptyIntArray) prm%totalNtwin = sum(prm%Ntwin) twinActive: if (prm%totalNtwin > 0_pInt) then prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,structure(1:3),& - config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + config%getFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_TwinTwin = lattice_interaction_TwinTwin(prm%Ntwin,& - config_phase(p)%getFloats('interaction_twintwin'), & + config%getFloats('interaction_twintwin'), & structure(1:3)) prm%gamma_twin_char = lattice_characteristicShear_twin(prm%Ntwin,structure(1:3),& - config_phase(p)%getFloat('c/a')) + config%getFloat('c/a')) - prm%xi_twin_0 = config_phase(p)%getFloats('tau0_twin',requiredShape=shape(prm%Ntwin)) + prm%xi_twin_0 = config%getFloats('tau0_twin',requiredSize=size(prm%Ntwin)) - prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin') - prm%n_twin = config_phase(p)%getFloat('n_twin') - prm%spr = config_phase(p)%getFloat('s_pr') - prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin') + prm%gdot0_twin = config%getFloat('gdot0_twin') + prm%n_twin = config%getFloat('n_twin') + prm%spr = config%getFloat('s_pr') + prm%h0_TwinTwin = config%getFloat('h0_twintwin') ! expand: family => system prm%xi_twin_0 = math_expand(prm%xi_twin_0, prm%Ntwin) ! sanity checks - if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//'gdot0_twin ' - if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//'n_twin ' ! ToDo: negative values ok? + if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0_twin' + if (prm%n_twin <= 0.0_pReal) extmsg = trim(extmsg)//' n_twin' else twinActive allocate(prm%interaction_TwinTwin(0,0)) allocate(prm%xi_twin_0(0)) @@ -279,10 +280,10 @@ subroutine plastic_phenopowerlaw_init ! slip-twin related parameters slipAndTwinActive: if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then prm%interaction_SlipTwin = lattice_interaction_SlipTwin(prm%Nslip,prm%Ntwin,& - config_phase(p)%getFloats('interaction_sliptwin'), & + config%getFloats('interaction_sliptwin'), & structure(1:3)) prm%interaction_TwinSlip = lattice_interaction_TwinSlip(prm%Ntwin,prm%Nslip,& - config_phase(p)%getFloats('interaction_twinslip'), & + config%getFloats('interaction_twinslip'), & structure(1:3)) else slipAndTwinActive allocate(prm%interaction_SlipTwin(prm%totalNslip,prm%TotalNtwin)) ! at least one dimension is 0 @@ -297,59 +298,59 @@ subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! output pararameters - outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i=1_pInt, size(outputs) outputID = undefined_ID select case(outputs(i)) - case ('resistance_slip') - outputID = merge(resistance_slip_ID,undefined_ID,prm%totalNslip>0_pInt) - outputSize = prm%totalNslip - case ('accumulatedshear_slip') - outputID = merge(accumulatedshear_slip_ID,undefined_ID,prm%totalNslip>0_pInt) - outputSize = prm%totalNslip - case ('shearrate_slip') - outputID = merge(shearrate_slip_ID,undefined_ID,prm%totalNslip>0_pInt) - outputSize = prm%totalNslip - case ('resolvedstress_slip') - outputID = merge(resolvedstress_slip_ID,undefined_ID,prm%totalNslip>0_pInt) - outputSize = prm%totalNslip - case ('resistance_twin') - outputID = merge(resistance_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) - outputSize = prm%totalNtwin - case ('accumulatedshear_twin') - outputID = merge(accumulatedshear_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) - outputSize = prm%totalNtwin - case ('shearrate_twin') - outputID = merge(shearrate_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) - outputSize = prm%totalNtwin - case ('resolvedstress_twin') - outputID = merge(resolvedstress_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) - outputSize = prm%totalNtwin + case ('resistance_slip') + outputID = merge(resistance_slip_ID,undefined_ID,prm%totalNslip>0_pInt) + outputSize = prm%totalNslip + case ('accumulatedshear_slip') + outputID = merge(accumulatedshear_slip_ID,undefined_ID,prm%totalNslip>0_pInt) + outputSize = prm%totalNslip + case ('shearrate_slip') + outputID = merge(shearrate_slip_ID,undefined_ID,prm%totalNslip>0_pInt) + outputSize = prm%totalNslip + case ('resolvedstress_slip') + outputID = merge(resolvedstress_slip_ID,undefined_ID,prm%totalNslip>0_pInt) + outputSize = prm%totalNslip - end select + case ('resistance_twin') + outputID = merge(resistance_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) + outputSize = prm%totalNtwin + case ('accumulatedshear_twin') + outputID = merge(accumulatedshear_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) + outputSize = prm%totalNtwin + case ('shearrate_twin') + outputID = merge(shearrate_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) + outputSize = prm%totalNtwin + case ('resolvedstress_twin') + outputID = merge(resolvedstress_twin_ID,undefined_ID,prm%totalNtwin>0_pInt) + outputSize = prm%totalNtwin - if (outputID /= undefined_ID) then - plastic_phenopowerlaw_output(i,phase_plasticityInstance(p)) = outputs(i) - plastic_phenopowerlaw_sizePostResult(i,phase_plasticityInstance(p)) = outputSize - prm%outputID = [prm%outputID , outputID] - endif + end select - end do + if (outputID /= undefined_ID) then + plastic_phenopowerlaw_output(i,phase_plasticityInstance(p)) = outputs(i) + plastic_phenopowerlaw_sizePostResult(i,phase_plasticityInstance(p)) = outputSize + prm%outputID = [prm%outputID, outputID] + endif + + enddo !-------------------------------------------------------------------------------------------------- ! allocate state arrays - NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase - sizeState = size(['tau_slip ','gamma_slip']) * prm%TotalNslip & - + size(['tau_twin ','gamma_twin']) * prm%TotalNtwin - sizeDotState = sizeState + NipcMyPhase = count(material_phase == p) + sizeDotState = size(['tau_slip ','gamma_slip']) * prm%totalNslip & + + size(['tau_twin ','gamma_twin']) * prm%totalNtwin + sizeState = sizeDotState call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, & prm%totalNslip,prm%totalNtwin,0_pInt) plasticState(p)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,phase_plasticityInstance(p))) - !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState startIndex = 1_pInt @@ -381,10 +382,10 @@ subroutine plastic_phenopowerlaw_init dot%gamma_twin => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear - plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally - dot%whole => plasticState(p)%dotState + plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally end associate + enddo end subroutine plastic_phenopowerlaw_init @@ -392,13 +393,13 @@ end subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent -!> @details asumme that deformation by dislocation glide affects twinned and untwinned volume -! equally (Taylor assumption). Twinning happens only in untwinned volume ( +!> @details asummes that deformation by dislocation glide affects twinned and untwinned volume +! equally (Taylor assumption). Twinning happens only in untwinned volume !-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) +pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) implicit none - real(pReal), dimension(3,3), intent(out) :: & + real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & dLp_dMp !< derivative of Lp with respect to the Mandel stress @@ -412,17 +413,17 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) integer(pInt) :: & i,k,l,m,n real(pReal), dimension(param(instance)%totalNslip) :: & - dgdot_dtauslip_pos,dgdot_dtauslip_neg, & - gdot_slip_pos,gdot_slip_neg + gdot_slip_pos,gdot_slip_neg, & + dgdot_dtauslip_pos,dgdot_dtauslip_neg real(pReal), dimension(param(instance)%totalNtwin) :: & gdot_twin,dgdot_dtautwin - + Lp = 0.0_pReal dLp_dMp = 0.0_pReal - - associate(prm => param(instance), stt => state(instance)) - - call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg) + + associate(prm => param(instance)) + + call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg) slipSystems: do i = 1_pInt, prm%totalNslip Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & @@ -431,14 +432,14 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + dgdot_dtauslip_neg(i) * prm%Schmid_slip(k,l,i) * prm%nonSchmid_neg(m,n,i) enddo slipSystems - call kinetics_twin(prm,stt,of,Mp,gdot_twin,dgdot_dtautwin) + call kinetics_twin(Mp,instance,of,gdot_twin,dgdot_dtautwin) twinSystems: do i = 1_pInt, prm%totalNtwin Lp = Lp + gdot_twin(i)*prm%Schmid_twin(1:3,1:3,i) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + dgdot_dtautwin(i)*prm%Schmid_twin(k,l,i)*prm%Schmid_twin(m,n,i) enddo twinSystems - + end associate end subroutine plastic_phenopowerlaw_LpAndItsTangent @@ -452,7 +453,7 @@ subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) implicit none real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress - integer(pInt), intent(in) :: & + integer(pInt), intent(in) :: & instance, & of @@ -466,9 +467,8 @@ subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) left_SlipSlip,right_SlipSlip, & gdot_slip_pos,gdot_slip_neg - associate(prm => param(instance), stt => state(instance), dot => dotState(instance)) + associate(prm => param(instance), stt => state(instance), dot => dotState(instance)) - dot%whole(:,of) = 0.0_pReal sumGamma = sum(stt%gamma_slip(:,of)) sumF = sum(stt%gamma_twin(:,of)/prm%gamma_twin_char) @@ -487,9 +487,9 @@ subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) !-------------------------------------------------------------------------------------------------- ! shear rates - call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg) + call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg) dot%gamma_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg) - call kinetics_twin(prm,stt,of,Mp,dot%gamma_twin(:,of)) + call kinetics_twin(Mp,instance,of,dot%gamma_twin(:,of)) !-------------------------------------------------------------------------------------------------- ! hardening @@ -510,40 +510,137 @@ end subroutine plastic_phenopowerlaw_dotState !-------------------------------------------------------------------------------------------------- -!> @brief calculates shear rates on slip systems and derivatives with respect to resolved stress -!> @details Shear rates are calculated only optionally. -! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to -! have the optional arguments at the end +!> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg, & - dgdot_dtau_slip_pos,dgdot_dtau_slip_neg) - use prec, only: & - dNeq0 +function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults) use math, only: & math_mul33xx33 implicit none - type(tParameters), intent(in) :: & - prm - type(tPhenopowerlawState), intent(in) :: & - stt - integer(pInt), intent(in) :: & + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer(pInt), intent(in) :: & + instance, & of - real(pReal), dimension(prm%totalNslip), intent(out) :: & + + real(pReal), dimension(sum(plastic_phenopowerlaw_sizePostResult(:,instance))) :: & + postResults + + integer(pInt) :: & + o,c,i + real(pReal), dimension(param(instance)%totalNslip) :: & + gdot_slip_pos,gdot_slip_neg + + c = 0_pInt + + associate(prm => param(instance), stt => state(instance)) + + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) + + case (resistance_slip_ID) + postResults(c+1_pInt:c+prm%totalNslip) = stt%xi_slip(1:prm%totalNslip,of) + c = c + prm%totalNslip + case (accumulatedshear_slip_ID) + postResults(c+1_pInt:c+prm%totalNslip) = stt%gamma_slip(1:prm%totalNslip,of) + c = c + prm%totalNslip + case (shearrate_slip_ID) + call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg) + postResults(c+1_pInt:c+prm%totalNslip) = gdot_slip_pos+gdot_slip_neg + c = c + prm%totalNslip + case (resolvedstress_slip_ID) + do i = 1_pInt, prm%totalNslip + postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) + enddo + c = c + prm%totalNslip + + case (resistance_twin_ID) + postResults(c+1_pInt:c+prm%totalNtwin) = stt%xi_twin(1:prm%totalNtwin,of) + c = c + prm%totalNtwin + case (accumulatedshear_twin_ID) + postResults(c+1_pInt:c+prm%totalNtwin) = stt%gamma_twin(1:prm%totalNtwin,of) + c = c + prm%totalNtwin + case (shearrate_twin_ID) + call kinetics_twin(Mp,instance,of,postResults(c+1_pInt:c+prm%totalNtwin)) + c = c + prm%totalNtwin + case (resolvedstress_twin_ID) + do i = 1_pInt, prm%totalNtwin + postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i)) + enddo + c = c + prm%totalNtwin + + end select + enddo outputsLoop + + end associate + +end function plastic_phenopowerlaw_postResults + + +!-------------------------------------------------------------------------------------------------- +!> @brief writes results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine plastic_phenopowerlaw_results(instance,group) +#if defined(PETSc) || defined(DAMASKHDF5) + use results + + implicit none + integer(pInt), intent(in) :: instance + character(len=*) :: group + integer(pInt) :: o + + associate(prm => param(instance), stt => state(instance)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) + case (resistance_slip_ID) + call results_writeVectorDataset(group,stt%xi_slip,'xi_slip','Pa') + case (accumulatedshear_slip_ID) + call results_writeVectorDataset(group,stt%gamma_slip,'gamma_slip','-') + end select + enddo outputsLoop + end associate +#else + integer(pInt), intent(in) :: instance + character(len=*) :: group +#endif +end subroutine plastic_phenopowerlaw_results + + +!-------------------------------------------------------------------------------------------------- +!> @brief Shear rates on slip systems and their derivatives with respect to resolved stress +!> @details Derivatives are calculated only optionally. +! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to +! have the optional arguments at the end +!-------------------------------------------------------------------------------------------------- +pure subroutine kinetics_slip(Mp,instance,of, & + gdot_slip_pos,gdot_slip_neg,dgdot_dtau_slip_pos,dgdot_dtau_slip_neg) + use prec, only: & + dNeq0 + use math, only: & + math_mul33xx33 + + implicit none + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer(pInt), intent(in) :: & + instance, & + of + + real(pReal), intent(out), dimension(param(instance)%totalNslip) :: & gdot_slip_pos, & gdot_slip_neg - real(pReal), dimension(prm%totalNslip), optional, intent(out) :: & + real(pReal), intent(out), optional, dimension(param(instance)%totalNslip) :: & dgdot_dtau_slip_pos, & dgdot_dtau_slip_neg - real(pReal), dimension(3,3), intent(in) :: & - Mp - real(pReal), dimension(prm%totalNslip) :: & + real(pReal), dimension(param(instance)%totalNslip) :: & tau_slip_pos, & tau_slip_neg integer(pInt) :: i logical :: nonSchmidActive + associate(prm => param(instance), stt => state(instance)) + nonSchmidActive = size(prm%nonSchmidCoeff) > 0_pInt do i = 1_pInt, prm%totalNslip @@ -560,7 +657,7 @@ pure subroutine kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg, & end where where(dNeq0(tau_slip_neg)) - gdot_slip_neg = 0.5_pReal*prm%gdot0_slip & + gdot_slip_neg = prm%gdot0_slip * 0.5_pReal & ! only used if non-Schmid active, always 1/2 * sign(abs(tau_slip_neg/stt%xi_slip(:,of))**prm%n_slip, tau_slip_neg) else where gdot_slip_neg = 0.0_pReal @@ -580,49 +677,51 @@ pure subroutine kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg, & dgdot_dtau_slip_neg = 0.0_pReal end where endif + end associate end subroutine kinetics_slip !-------------------------------------------------------------------------------------------------- -!> @brief calculates shear rates on twin systems and derivatives with respect to resolved stress. +!> @brief Shear rates on twin systems and their derivatives with respect to resolved stress. ! twinning is assumed to take place only in untwinned volume. !> @details Derivates are calculated only optionally. -! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to +! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to ! have the optional arguments at the end. !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_twin(prm,stt,of,Mp,gdot_twin,dgdot_dtau_twin) +pure subroutine kinetics_twin(Mp,instance,of,& + gdot_twin,dgdot_dtau_twin) use prec, only: & dNeq0 use math, only: & math_mul33xx33 implicit none - type(tParameters), intent(in) :: & - prm - type(tPhenopowerlawState), intent(in) :: & - stt - integer(pInt), intent(in) :: & + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer(pInt), intent(in) :: & + instance, & of - real(pReal), dimension(3,3), intent(in) :: & - Mp - real(pReal), dimension(prm%totalNtwin), intent(out) :: & + + real(pReal), dimension(param(instance)%totalNtwin), intent(out) :: & gdot_twin - real(pReal), dimension(prm%totalNtwin), optional, intent(out) :: & + real(pReal), dimension(param(instance)%totalNtwin), intent(out), optional :: & dgdot_dtau_twin - real(pReal), dimension(prm%totalNtwin) :: & + real(pReal), dimension(param(instance)%totalNtwin) :: & tau_twin integer(pInt) :: i + associate(prm => param(instance), stt => state(instance)) + do i = 1_pInt, prm%totalNtwin tau_twin(i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i)) enddo - + where(tau_twin > 0.0_pReal) gdot_twin = (1.0_pReal-sum(stt%gamma_twin(:,of)/prm%gamma_twin_char)) & ! only twin in untwinned volume fraction * prm%gdot0_twin*(abs(tau_twin)/stt%xi_twin(:,of))**prm%n_twin - else where + else where gdot_twin = 0.0_pReal end where @@ -634,75 +733,8 @@ pure subroutine kinetics_twin(prm,stt,of,Mp,gdot_twin,dgdot_dtau_twin) end where endif -end subroutine kinetics_twin - - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of constitutive results -!-------------------------------------------------------------------------------------------------- -function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults) - use math, only: & - math_mul33xx33 - - implicit none - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - integer(pInt), intent(in) :: & - instance, & - of - - real(pReal), dimension(sum(plastic_phenopowerlaw_sizePostResult(:,instance))) :: & - postResults - - integer(pInt) :: & - o,c,i - real(pReal), dimension(param(instance)%totalNslip) :: & - gdot_slip_pos,gdot_slip_neg - - postResults = 0.0_pReal - c = 0_pInt - - associate( prm => param(instance), stt => state(instance)) - - outputsLoop: do o = 1_pInt,size(prm%outputID) - select case(prm%outputID(o)) - - case (resistance_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = stt%xi_slip(1:prm%totalNslip,of) - c = c + prm%totalNslip - case (accumulatedshear_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = stt%gamma_slip(1:prm%totalNslip,of) - c = c + prm%totalNslip - case (shearrate_slip_ID) - call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg) - postResults(c+1_pInt:c+prm%totalNslip) = gdot_slip_pos+gdot_slip_neg - c = c + prm%totalNslip - case (resolvedstress_slip_ID) - do i = 1_pInt, prm%totalNslip - postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) - enddo - c = c + prm%totalNslip - - case (resistance_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = stt%xi_twin(1:prm%totalNtwin,of) - c = c + prm%totalNtwin - case (accumulatedshear_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = stt%gamma_twin(1:prm%totalNtwin,of) - c = c + prm%totalNtwin - case (shearrate_twin_ID) - call kinetics_twin(prm,stt,of,Mp,postResults(c+1_pInt:c+prm%totalNtwin)) - c = c + prm%totalNtwin - case (resolvedstress_twin_ID) - do i = 1_pInt, prm%totalNtwin - postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i)) - enddo - c = c + prm%totalNtwin - - end select - enddo outputsLoop - end associate -end function plastic_phenopowerlaw_postResults +end subroutine kinetics_twin end module plastic_phenopowerlaw diff --git a/src/porosity_none.f90 b/src/porosity_none.f90 deleted file mode 100644 index d8175cd9e..000000000 --- a/src/porosity_none.f90 +++ /dev/null @@ -1,60 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for constant porosity -!-------------------------------------------------------------------------------------------------- -module porosity_none - - implicit none - private - - public :: & - porosity_none_init - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields, reads information from material configuration file -!-------------------------------------------------------------------------------------------------- -subroutine porosity_none_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use prec, only: & - pReal, & - pInt - use IO, only: & - IO_timeStamp - use material - use config - - implicit none - integer(pInt) :: & - homog, & - NofMyHomog - - write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_none_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - initializeInstances: do homog = 1_pInt, material_Nhomogenization - - myhomog: if (porosity_type(homog) == POROSITY_none_ID) then - NofMyHomog = count(material_homog == homog) - porosityState(homog)%sizeState = 0_pInt - porosityState(homog)%sizePostResults = 0_pInt - allocate(porosityState(homog)%state0 (0_pInt,NofMyHomog), source=0.0_pReal) - allocate(porosityState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal) - allocate(porosityState(homog)%state (0_pInt,NofMyHomog), source=0.0_pReal) - - deallocate(porosity(homog)%p) - allocate (porosity(homog)%p(1), source=porosity_initialPhi(homog)) - - endif myhomog - enddo initializeInstances - - -end subroutine porosity_none_init - -end module porosity_none diff --git a/src/porosity_phasefield.f90 b/src/porosity_phasefield.f90 deleted file mode 100644 index 1975ba64c..000000000 --- a/src/porosity_phasefield.f90 +++ /dev/null @@ -1,448 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for phase field modelling of pore nucleation and growth -!> @details phase field model for pore nucleation and growth based on vacancy clustering -!-------------------------------------------------------------------------------------------------- -module porosity_phasefield - use prec, only: & - pReal, & - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - porosity_phasefield_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - porosity_phasefield_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - porosity_phasefield_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - porosity_phasefield_Noutput !< number of outputs per instance of this porosity - - enum, bind(c) - enumerator :: undefined_ID, & - porosity_ID - end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - porosity_phasefield_outputID !< ID of each post result output - - - public :: & - porosity_phasefield_init, & - porosity_phasefield_getFormationEnergy, & - porosity_phasefield_getSurfaceEnergy, & - porosity_phasefield_getSourceAndItsTangent, & - porosity_phasefield_getDiffusion33, & - porosity_phasefield_getMobility, & - porosity_phasefield_putPorosity, & - porosity_phasefield_postResults - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine porosity_phasefield_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF - use material, only: & - porosity_type, & - porosity_typeInstance, & - homogenization_Noutput, & - POROSITY_phasefield_label, & - POROSITY_phasefield_ID, & - material_homog, & - mappingHomogenization, & - porosityState, & - porosityMapping, & - porosity, & - porosity_initialPhi - use config, only: & - material_partHomogenization, & - material_partPhase - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o - integer(pInt) :: sizeState - integer(pInt) :: NofMyHomog - character(len=65536) :: & - tag = '', & - line = '' - - write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_phasefield_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(porosity_type == POROSITY_phasefield_ID),pInt) - if (maxNinstance == 0_pInt) return - - allocate(porosity_phasefield_sizePostResults(maxNinstance), source=0_pInt) - allocate(porosity_phasefield_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) - allocate(porosity_phasefield_output (maxval(homogenization_Noutput),maxNinstance)) - porosity_phasefield_output = '' - allocate(porosity_phasefield_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) - allocate(porosity_phasefield_Noutput (maxNinstance), source=0_pInt) - - rewind(fileUnit) - section = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to - line = IO_read(fileUnit) - enddo - - parsingHomog: do while (trim(line) /= IO_EOF) ! read through sections of homog part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next homog section - section = section + 1_pInt ! advance homog section counter - cycle ! skip to next line - endif - - if (section > 0_pInt ) then; if (porosity_type(section) == POROSITY_phasefield_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = porosity_typeInstance(section) ! which instance of my porosity is present homog - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('porosity') - porosity_phasefield_Noutput(instance) = porosity_phasefield_Noutput(instance) + 1_pInt - porosity_phasefield_outputID(porosity_phasefield_Noutput(instance),instance) = porosity_ID - porosity_phasefield_output(porosity_phasefield_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - end select - endif; endif - enddo parsingHomog - - initializeInstances: do section = 1_pInt, size(porosity_type) - if (porosity_type(section) == POROSITY_phasefield_ID) then - NofMyHomog=count(material_homog==section) - instance = porosity_typeInstance(section) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,porosity_phasefield_Noutput(instance) - select case(porosity_phasefield_outputID(o,instance)) - case(porosity_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - porosity_phasefield_sizePostResult(o,instance) = mySize - porosity_phasefield_sizePostResults(instance) = porosity_phasefield_sizePostResults(instance) + mySize - endif - enddo outputsLoop - -! allocate state arrays - sizeState = 0_pInt - porosityState(section)%sizeState = sizeState - porosityState(section)%sizePostResults = porosity_phasefield_sizePostResults(instance) - allocate(porosityState(section)%state0 (sizeState,NofMyHomog)) - allocate(porosityState(section)%subState0(sizeState,NofMyHomog)) - allocate(porosityState(section)%state (sizeState,NofMyHomog)) - - nullify(porosityMapping(section)%p) - porosityMapping(section)%p => mappingHomogenization(1,:,:) - deallocate(porosity(section)%p) - allocate(porosity(section)%p(NofMyHomog), source=porosity_initialPhi(section)) - - endif - - enddo initializeInstances -end subroutine porosity_phasefield_init - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized vacancy formation energy -!-------------------------------------------------------------------------------------------------- -function porosity_phasefield_getFormationEnergy(ip,el) - use lattice, only: & - lattice_vacancyFormationEnergy, & - lattice_vacancyVol - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal) :: & - porosity_phasefield_getFormationEnergy - integer(pInt) :: & - grain - - porosity_phasefield_getFormationEnergy = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - porosity_phasefield_getFormationEnergy = porosity_phasefield_getFormationEnergy + & - lattice_vacancyFormationEnergy(material_phase(grain,ip,el))/ & - lattice_vacancyVol(material_phase(grain,ip,el)) - enddo - - porosity_phasefield_getFormationEnergy = & - porosity_phasefield_getFormationEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal) - -end function porosity_phasefield_getFormationEnergy - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized pore surface energy (normalized by characteristic length) -!-------------------------------------------------------------------------------------------------- -function porosity_phasefield_getSurfaceEnergy(ip,el) - use lattice, only: & - lattice_vacancySurfaceEnergy - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal) :: & - porosity_phasefield_getSurfaceEnergy - integer(pInt) :: & - grain - - porosity_phasefield_getSurfaceEnergy = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - porosity_phasefield_getSurfaceEnergy = porosity_phasefield_getSurfaceEnergy + & - lattice_vacancySurfaceEnergy(material_phase(grain,ip,el)) - enddo - - porosity_phasefield_getSurfaceEnergy = & - porosity_phasefield_getSurfaceEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal) - -end function porosity_phasefield_getSurfaceEnergy - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates homogenized local driving force for pore nucleation and growth -!-------------------------------------------------------------------------------------------------- -subroutine porosity_phasefield_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) - use math, only : & - math_mul33x33, & - math_mul66x6, & - math_Mandel33to6, & - math_transpose33, & - math_I3 - use material, only: & - homogenization_Ngrains, & - material_homog, & - material_phase, & - phase_NstiffnessDegradations, & - phase_stiffnessDegradation, & - vacancyConc, & - vacancyfluxMapping, & - damage, & - damageMapping, & - STIFFNESS_DEGRADATION_damage_ID - use crystallite, only: & - crystallite_Fe - use constitutive, only: & - constitutive_homogenizedC - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - phi - integer(pInt) :: & - phase, & - grain, & - homog, & - mech - real(pReal) :: & - phiDot, dPhiDot_dPhi, Cv, W_e, strain(6), C(6,6) - - homog = material_homog(ip,el) - Cv = vacancyConc(homog)%p(vacancyfluxMapping(homog)%p(ip,el)) - - W_e = 0.0_pReal - do grain = 1, homogenization_Ngrains(homog) - phase = material_phase(grain,ip,el) - strain = math_Mandel33to6(math_mul33x33(math_transpose33(crystallite_Fe(1:3,1:3,grain,ip,el)), & - crystallite_Fe(1:3,1:3,grain,ip,el)) - math_I3)/2.0_pReal - C = constitutive_homogenizedC(grain,ip,el) - do mech = 1_pInt, phase_NstiffnessDegradations(phase) - select case(phase_stiffnessDegradation(mech,phase)) - case (STIFFNESS_DEGRADATION_damage_ID) - C = damage(homog)%p(damageMapping(homog)%p(ip,el))* & - damage(homog)%p(damageMapping(homog)%p(ip,el))* & - C - - end select - enddo - W_e = W_e + sum(abs(strain*math_mul66x6(C,strain))) - enddo - W_e = W_e/real(homogenization_Ngrains(homog),pReal) - - phiDot = 2.0_pReal*(1.0_pReal - phi)*(1.0_pReal - Cv)*(1.0_pReal - Cv) - & - 2.0_pReal*phi*(W_e + Cv*porosity_phasefield_getFormationEnergy(ip,el))/ & - porosity_phasefield_getSurfaceEnergy (ip,el) - dPhiDot_dPhi = - 2.0_pReal*(1.0_pReal - Cv)*(1.0_pReal - Cv) & - - 2.0_pReal*(W_e + Cv*porosity_phasefield_getFormationEnergy(ip,el))/ & - porosity_phasefield_getSurfaceEnergy (ip,el) - -end subroutine porosity_phasefield_getSourceAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized nonlocal diffusion tensor in reference configuration -!-------------------------------------------------------------------------------------------------- -function porosity_phasefield_getDiffusion33(ip,el) - use lattice, only: & - lattice_PorosityDiffusion33 - use material, only: & - homogenization_Ngrains, & - material_phase, & - mappingHomogenization - use crystallite, only: & - crystallite_push33ToRef - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - porosity_phasefield_getDiffusion33 - integer(pInt) :: & - homog, & - grain - - homog = mappingHomogenization(2,ip,el) - porosity_phasefield_getDiffusion33 = 0.0_pReal - do grain = 1, homogenization_Ngrains(homog) - porosity_phasefield_getDiffusion33 = porosity_phasefield_getDiffusion33 + & - crystallite_push33ToRef(grain,ip,el,lattice_PorosityDiffusion33(1:3,1:3,material_phase(grain,ip,el))) - enddo - - porosity_phasefield_getDiffusion33 = & - porosity_phasefield_getDiffusion33/real(homogenization_Ngrains(homog),pReal) - -end function porosity_phasefield_getDiffusion33 - -!-------------------------------------------------------------------------------------------------- -!> @brief Returns homogenized phase field mobility -!-------------------------------------------------------------------------------------------------- -real(pReal) function porosity_phasefield_getMobility(ip,el) - use mesh, only: & - mesh_element - use lattice, only: & - lattice_PorosityMobility - use material, only: & - material_phase, & - homogenization_Ngrains - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - integer(pInt) :: & - ipc - - porosity_phasefield_getMobility = 0.0_pReal - - do ipc = 1, homogenization_Ngrains(mesh_element(3,el)) - porosity_phasefield_getMobility = porosity_phasefield_getMobility & - + lattice_PorosityMobility(material_phase(ipc,ip,el)) - enddo - - porosity_phasefield_getMobility = & - porosity_phasefield_getMobility/real(homogenization_Ngrains(mesh_element(3,el)),pReal) - -end function porosity_phasefield_getMobility - -!-------------------------------------------------------------------------------------------------- -!> @brief updates porosity with solution from phasefield PDE -!-------------------------------------------------------------------------------------------------- -subroutine porosity_phasefield_putPorosity(phi,ip,el) - use material, only: & - material_homog, & - porosityMapping, & - porosity - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - phi - integer(pInt) :: & - homog, & - offset - - homog = material_homog(ip,el) - offset = porosityMapping(homog)%p(ip,el) - porosity(homog)%p(offset) = phi - -end subroutine porosity_phasefield_putPorosity - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of porosity results -!-------------------------------------------------------------------------------------------------- -function porosity_phasefield_postResults(ip,el) - use material, only: & - mappingHomogenization, & - porosity_typeInstance, & - porosity - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(porosity_phasefield_sizePostResults(porosity_typeInstance(mappingHomogenization(2,ip,el)))) :: & - porosity_phasefield_postResults - - integer(pInt) :: & - instance, homog, offset, o, c - - homog = mappingHomogenization(2,ip,el) - offset = mappingHomogenization(1,ip,el) - instance = porosity_typeInstance(homog) - - c = 0_pInt - porosity_phasefield_postResults = 0.0_pReal - - do o = 1_pInt,porosity_phasefield_Noutput(instance) - select case(porosity_phasefield_outputID(o,instance)) - - case (porosity_ID) - porosity_phasefield_postResults(c+1_pInt) = porosity(homog)%p(offset) - c = c + 1 - end select - enddo -end function porosity_phasefield_postResults - -end module porosity_phasefield diff --git a/src/quit.f90 b/src/quit.f90 index 4219830a5..ad61943e4 100644 --- a/src/quit.f90 +++ b/src/quit.f90 @@ -23,6 +23,8 @@ subroutine quit(stop_id) integer(pInt) :: error = 0_pInt PetscErrorCode :: ierr = 0 + call h5open_f(hdferr) + if (hdferr /= 0) write(6,'(a,i5)') ' Error in h5open_f',hdferr ! prevents error if not opened yet call h5close_f(hdferr) if (hdferr /= 0) write(6,'(a,i5)') ' Error in h5close_f',hdferr diff --git a/src/results.f90 b/src/results.f90 new file mode 100644 index 000000000..d38178993 --- /dev/null +++ b/src/results.f90 @@ -0,0 +1,974 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Vitesh Shah, Max-Planck-Institut für Eisenforschung GmbH +!> @author Yi-Chin Yang, Max-Planck-Institut für Eisenforschung GmbH +!> @author Jennifer Nastola, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!-------------------------------------------------------------------------------------------------- +module results + use prec + use IO + use HDF5 + use HDF5_utilities +#ifdef PETSc + use PETSC +#endif + + implicit none + private + integer(HID_T), public, protected :: tempCoordinates, tempResults + integer(HID_T), private :: resultsFile, currentIncID, plist_id + + + public :: & + results_init, & + results_openJobFile, & + results_closeJobFile, & + results_addIncrement, & + results_addGroup, & + results_openGroup, & + results_writeVectorDataset, & + results_setLink, & + results_removeLink +contains + +subroutine results_init + use, intrinsic :: & + iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use DAMASK_interface, only: & + getSolverJobName + implicit none + + write(6,'(/,a)') ' <<<+- results init -+>>>' +#include "compilation_info.f90" + + call HDF5_closeFile(HDF5_openFile(trim(getSolverJobName())//'.hdf5','w',.true.)) + +end subroutine results_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief opens the results file to append data +!-------------------------------------------------------------------------------------------------- +subroutine results_openJobFile() + use DAMASK_interface, only: & + getSolverJobName + + implicit none + character(len=pStringLen) :: commandLine + + resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','a',.true.) + call HDF5_addAttribute(resultsFile,'DADF5',0.1_pReal) + call HDF5_addAttribute(resultsFile,'DAMASK',DAMASKVERSION) + call get_command(commandLine) + call HDF5_addAttribute(resultsFile,'call',trim(commandLine)) + +end subroutine results_openJobFile + + +!-------------------------------------------------------------------------------------------------- +!> @brief closes the results file +!-------------------------------------------------------------------------------------------------- +subroutine results_closeJobFile() + implicit none + + call HDF5_closeFile(resultsFile) + +end subroutine results_closeJobFile + + +!-------------------------------------------------------------------------------------------------- +!> @brief closes the results file +!-------------------------------------------------------------------------------------------------- +subroutine results_addIncrement(inc,time) + + implicit none + integer(pInt), intent(in) :: inc + real(pReal), intent(in) :: time + character(len=pStringLen) :: incChar + + write(incChar,*) inc + call HDF5_closeGroup(results_addGroup(trim('inc'//trim(adjustl(incChar))))) + call results_setLink(trim('inc'//trim(adjustl(incChar))),'current') + call HDF5_addAttribute(resultsFile,'time/s',time,trim('inc'//trim(adjustl(incChar)))) + +end subroutine results_addIncrement + +!-------------------------------------------------------------------------------------------------- +!> @brief open a group from the results file +!-------------------------------------------------------------------------------------------------- +integer(HID_T) function results_openGroup(groupName) + + implicit none + character(len=*), intent(in) :: groupName + + results_openGroup = HDF5_openGroup(resultsFile,groupName) + +end function results_openGroup + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a new group to the results file +!-------------------------------------------------------------------------------------------------- +integer(HID_T) function results_addGroup(groupName) + + implicit none + character(len=*), intent(in) :: groupName + + results_addGroup = HDF5_addGroup(resultsFile,groupName) + +end function results_addGroup + + +!-------------------------------------------------------------------------------------------------- +!> @brief set link to object in results file +!-------------------------------------------------------------------------------------------------- +subroutine results_setLink(path,link) + use hdf5_utilities, only: & + HDF5_setLink + + implicit none + character(len=*), intent(in) :: path, link + + call HDF5_setLink(resultsFile,path,link) + +end subroutine results_setLink + + +!-------------------------------------------------------------------------------------------------- +!> @brief remove link to an object +!-------------------------------------------------------------------------------------------------- +subroutine results_removeLink(link) + use hdf5 + + implicit none + character(len=*), intent(in) :: link + integer :: hdferr + + call h5ldelete_f(resultsFile,link, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'results_removeLink: h5ldelete_soft_f ('//trim(link)//')') + +end subroutine results_removeLink + + +!-------------------------------------------------------------------------------------------------- +!> @brief stores a vector dataset in a group +!-------------------------------------------------------------------------------------------------- +subroutine results_writeVectorDataset(group,dataset,label,SIunit) + + implicit none + character(len=*), intent(in) :: SIunit,label,group + real(pReal), intent(inout), dimension(:,:) :: dataset + integer(HID_T) :: groupHandle + + groupHandle = results_openGroup(group) + call HDF5_write(groupHandle,dataset,label) + if (HDF5_objectExists(groupHandle,label)) & + call HDF5_addAttribute(groupHandle,'Unit',SIunit,label) + call HDF5_closeGroup(groupHandle) + +end subroutine results_writeVectorDataset + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingPhase(mapping,mapping2,Nconstituents,material_phase,phase_name,dataspace_size,mpiOffset,mpiOffset_phase) + use hdf5 + + implicit none + integer(pInt), intent(in) :: Nconstituents, dataspace_size, mpiOffset + integer(pInt), intent(in), dimension(:) :: mapping, mapping2 + character(len=*), intent(in), dimension(:) :: phase_name + integer(pInt), intent(in), dimension(:) :: mpiOffset_phase + integer(pInt), intent(in), dimension(:,:,:) :: material_phase + + character(len=len(phase_name(1))), dimension(:), allocatable :: namesNA + character(len=len(phase_name(1))) :: a + character(len=*), parameter :: n = "NULL" + + integer(pInt) :: hdferr, NmatPoints, i, j, k + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace + integer(HID_T) :: dt5_id ! Memory datatype identifier + integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size + + integer(HSIZE_T), dimension(2) :: counter + integer(HSSIZE_T), dimension(2) :: fileOffset + integer(pInt), dimension(:,:), allocatable :: arrOffset + + a = n + allocate(namesNA(0:size(phase_name)),source=[a,phase_name]) + NmatPoints = size(mapping,1)/Nconstituents + mapping_ID = results_openGroup("current/mapGeometry") + + allocate(arrOffset(Nconstituents,NmatPoints)) + do i=1_pInt, NmatPoints + do k=1_pInt, Nconstituents + do j=1_pInt, size(phase_name) + if(material_phase(k,1,i) == j) & + arrOffset(k,i) = mpiOffset_phase(j) + enddo + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(2, int([Nconstituents,dataspace_size],HSIZE_T), space_id, hdferr, & + int([Nconstituents,dataspace_size],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') + +!-------------------------------------------------------------------------------------------------- +! compound type + ! First calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) + typesize = len(phase_name(1)) + CALL h5tset_size_f(dt5_id, typesize, hdferr) + CALL h5tget_size_f(dt5_id, type_sizec, hdferr) + CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr) + type_size = type_sizec + type_sizei + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 0') + call h5tinsert_f(dtype_id, "Position", type_sizec, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 2') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, 'constitutive', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase') + +!-------------------------------------------------------------------------------------------------- +! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f instance_id') + call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f instance_id') + + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- +! Define and select hyperslabs + counter(1) = Nconstituents ! how big i am + counter(2) = NmatPoints + fileOffset(1) = 0 ! where i start to write my data + fileOffset(2) = mpiOffset + + call h5screate_simple_f(2, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write +#ifdef PETSc + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, name_id, reshape(namesNA(mapping),[Nconstituents,NmatPoints]), & + int([Nconstituents, dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f position_id') + + call h5dwrite_f(dset_id, position_id, reshape(mapping2-1_pInt,[Nconstituents,NmatPoints])+arrOffset, & + int([Nconstituents, dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- +! close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f position_id') + call h5tclose_f(name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f name_id ') + call h5tclose_f(dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f dt5_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sclose_f space_id') + call h5sclose_f(memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sclose_f memspace') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + +end subroutine HDF5_mappingPhase + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the backward mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_backwardMappingPhase(material_phase,phasememberat,phase_name,dataspace_size,mpiOffset,mpiOffset_phase) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:,:) :: material_phase, phasememberat + character(len=*), intent(in), dimension(:) :: phase_name + integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_phase + integer(pInt), intent(in) :: mpiOffset + + integer(pInt) :: hdferr, NmatPoints, Nconstituents, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace + integer(SIZE_T) :: type_size + + integer(pInt), dimension(:,:), allocatable :: arr + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + + character(len=64) :: phaseID + + Nconstituents = size(phasememberat,1) + NmatPoints = count(material_phase /=0_pInt)/Nconstituents + + allocate(arr(2,NmatPoints*Nconstituents)) + + do i=1_pInt, NmatPoints + do j=Nconstituents-1_pInt, 0_pInt, -1_pInt + arr(1,Nconstituents*i-j) = i-1_pInt + enddo + enddo + arr(2,:) = pack(material_phase,material_phase/=0_pInt) + + do i=1_pInt, size(phase_name) + write(phaseID, '(i0)') i + mapping_ID = results_openGroup('/current/constitutive/'//trim(phaseID)//'_'//phase_name(i)) + NmatPoints = count(material_phase == i) + +!-------------------------------------------------------------------------------------------------- + ! create dataspace + call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, & + int([dataspace_size(i)],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') + +!-------------------------------------------------------------------------------------------------- + ! compound type + call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f 0') + +!-------------------------------------------------------------------------------------------------- + ! create Dataset + call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase') + +!-------------------------------------------------------------------------------------------------- + ! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- + ! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset_phase(i) ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write +#ifdef PETSc + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- + ! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset, int([dataspace_size(i)],HSIZE_T),& + hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- + !close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f position_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sclose_f space_id') + call h5sclose_f(memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sclose_f memspace') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + enddo + +end subroutine HDF5_backwardMappingPhase + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat + character(len=*), intent(in), dimension(:) :: homogenization_name + integer(pInt), intent(in), dimension(:) :: mpiOffset_homog + integer(pInt), intent(in) :: dataspace_size, mpiOffset + + integer(pInt) :: hdferr, NmatPoints, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace + + integer(HID_T) :: dt5_id ! Memory datatype identifier + integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + integer(pInt), dimension(:), allocatable :: arrOffset + + NmatPoints = count(material_homog /=0_pInt) + mapping_ID = results_openGroup("current/mapGeometry") + + allocate(arrOffset(NmatPoints)) + do i=1_pInt, NmatPoints + do j=1_pInt, size(homogenization_name) + if(material_homog(1,i) == j) & + arrOffset(i) = mpiOffset_homog(j) + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, & + int([dataspace_size],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') + +!-------------------------------------------------------------------------------------------------- +! compound type + ! First calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) + typesize = len(homogenization_name(1)) + CALL h5tset_size_f(dt5_id, typesize, hdferr) + CALL h5tget_size_f(dt5_id, type_sizec, hdferr) + CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr) + type_size = type_sizec + type_sizei + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 0') + call h5tinsert_f(dtype_id, "Position", type_sizec, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 2') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, 'homogenization', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog') + +!-------------------------------------------------------------------------------------------------- +! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f instance_id') + call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f instance_id') + + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- +! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! Create property list for collective dataset write +#ifdef PETSc + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, name_id, homogenization_name(pack(material_homog,material_homog/=0_pInt)), & + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f position_id') + + call h5dwrite_f(dset_id, position_id, pack(homogmemberat-1_pInt,homogmemberat/=0_pInt) + arrOffset, & + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces +call h5tclose_f(dtype_id, hdferr) +if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f dtype_id') +call h5tclose_f(position_id, hdferr) +if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f position_id') +call h5tclose_f(name_id, hdferr) +if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f name_id ') +call h5tclose_f(dt5_id, hdferr) +if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f dt5_id') +call h5dclose_f(dset_id, hdferr) +if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dclose_f') +call h5sclose_f(space_id, hdferr) +if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sclose_f space_id') +call h5sclose_f(memspace, hdferr) +if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sclose_f memspace') +call h5pclose_f(plist_id, hdferr) +if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pclose_f') +call HDF5_closeGroup(mapping_ID) + +end subroutine HDF5_mappingHomog + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the backward mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_backwardMappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat + character(len=*), intent(in), dimension(:) :: homogenization_name + integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_homog + integer(pInt), intent(in) :: mpiOffset + + integer(pInt) :: hdferr, NmatPoints, i + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace + integer(SIZE_T) :: type_size + + integer(pInt), dimension(:,:), allocatable :: arr + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + + character(len=64) :: homogID + + NmatPoints = count(material_homog /=0_pInt) + allocate(arr(2,NmatPoints)) + + arr(1,:) = (/(i, i=0_pint,NmatPoints-1_pInt)/) + arr(2,:) = pack(material_homog,material_homog/=0_pInt) + + do i=1_pInt, size(homogenization_name) + write(homogID, '(i0)') i + mapping_ID = results_openGroup('/current/homogenization/'//trim(homogID)//'_'//homogenization_name(i)) + +!-------------------------------------------------------------------------------------------------- + ! create dataspace + call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, & + int([dataspace_size(i)],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') + +!-------------------------------------------------------------------------------------------------- + ! compound type + call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f 0') + +!-------------------------------------------------------------------------------------------------- + ! create Dataset + call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog') + +!-------------------------------------------------------------------------------------------------- + ! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- + ! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset_homog(i) ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write +#ifdef PETSc + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- + ! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset,int([dataspace_size(i)],HSIZE_T),& + hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- + !close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f position_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sclose_f space_id') + call h5sclose_f(memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sclose_f memspace') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + enddo + +end subroutine HDF5_backwardMappingHomog + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: crystalliteAt + integer(pInt), intent(in), dimension(:,:,:) :: crystmemberAt + character(len=*), intent(in), dimension(:) :: crystallite_name + integer(pInt), intent(in), dimension(:) :: mpiOffset_cryst + integer(pInt), intent(in) :: dataspace_size, mpiOffset + + integer :: hdferr + integer(pInt) :: NmatPoints, Nconstituents, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, plist_id, memspace + + integer(HID_T), dimension(:), allocatable :: position_id + + integer(HID_T) :: dt5_id ! Memory datatype identifier + integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + integer(pInt), dimension(:), allocatable :: arrOffset + + character(len=64) :: m + + Nconstituents = size(crystmemberAt,1) + NmatPoints = count(crystalliteAt /=0_pInt) + mapping_ID = results_openGroup("current/mapGeometry") + + allocate(position_id(Nconstituents)) + + allocate(arrOffset(NmatPoints)) + do i=1_pInt, NmatPoints + do j=1_pInt, size(crystallite_name) + if(crystalliteAt(1,i) == j) & + arrOffset(i) = Nconstituents*mpiOffset_cryst(j) + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, & + int([dataspace_size],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') + +!-------------------------------------------------------------------------------------------------- +! compound type + ! First calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) + typesize = len(crystallite_name(1)) + CALL h5tset_size_f(dt5_id, typesize, hdferr) + CALL h5tget_size_f(dt5_id, type_sizec, hdferr) + CALL h5tget_size_f(H5T_STD_I32LE, type_sizei, hdferr) + type_size = type_sizec + type_sizei*Nconstituents + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 0') + do i=1_pInt, Nconstituents + write(m, '(i0)') i + call h5tinsert_f(dtype_id, "Position "//trim(m), type_sizec+(i-1)*type_sizei, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 2 '//trim(m)) + enddo + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, 'crystallite', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite') + +!-------------------------------------------------------------------------------------------------- +! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f instance_id') + call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f instance_id') + + do i=1_pInt, Nconstituents + write(m, '(i0)') i + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id(i), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f position_id') + call h5tinsert_f(position_id(i), "Position "//trim(m), 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f position_id') + enddo + +!-------------------------------------------------------------------------------------------------- +! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write +#ifdef PETSc + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, name_id, crystallite_name(pack(crystalliteAt,crystalliteAt/=0_pInt)), & + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f position_id') + + do i=1_pInt, Nconstituents + call h5dwrite_f(dset_id, position_id(i), pack(crystmemberAt(i,:,:)-1_pInt,crystmemberAt(i,:,:)/=0_pInt)+arrOffset,& + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f instance_id') + enddo + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f dtype_id') + do i=1_pInt, Nconstituents + call h5tclose_f(position_id(i), hdferr) + enddo + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f position_id') + call h5tclose_f(name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f name_id') + call h5tclose_f(dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f dt5_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sclose_f space_id') + call h5sclose_f(memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sclose_f memspace') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + +end subroutine HDF5_mappingCrystallite + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the backward mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_backwardMappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: crystalliteAt + integer(pInt), intent(in), dimension(:,:,:) :: crystmemberAt + character(len=*), intent(in), dimension(:) :: crystallite_name + integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_cryst + integer(pInt), intent(in) :: mpiOffset + + integer :: hdferr + integer(pInt) :: NmatPoints, Nconstituents, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace + integer(SIZE_T) :: type_size + + integer(pInt), dimension(:,:), allocatable :: h_arr, arr + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + + character(len=64) :: crystallID + + Nconstituents = size(crystmemberAt,1) + NmatPoints = count(crystalliteAt /=0_pInt) + + allocate(h_arr(2,NmatPoints)) + allocate(arr(2,Nconstituents*NmatPoints)) + + h_arr(1,:) = (/(i, i=0_pInt,NmatPoints-1_pInt)/) + h_arr(2,:) = pack(crystalliteAt,crystalliteAt/=0_pInt) + + do i=1_pInt, NmatPoints + do j=Nconstituents-1_pInt, 0_pInt, -1_pInt + arr(1,Nconstituents*i-j) = h_arr(1,i) + arr(2,Nconstituents*i-j) = h_arr(2,i) + enddo + enddo + + do i=1_pInt, size(crystallite_name) + if (crystallite_name(i) == 'none') cycle + write(crystallID, '(i0)') i + mapping_ID = results_openGroup('/current/crystallite/'//trim(crystallID)//'_'//crystallite_name(i)) + NmatPoints = count(crystalliteAt == i) + +!-------------------------------------------------------------------------------------------------- + ! create dataspace + call h5screate_simple_f(1, int([Nconstituents*dataspace_size(i)],HSIZE_T), space_id, hdferr, & + int([Nconstituents*dataspace_size(i)],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') + +!-------------------------------------------------------------------------------------------------- + ! compound type + call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f 0') + +!-------------------------------------------------------------------------------------------------- + ! create Dataset + call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite') + +!-------------------------------------------------------------------------------------------------- + ! Create memory types + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- + ! Define and select hyperslabs + counter = Nconstituents*NmatPoints ! how big i am + fileOffset = Nconstituents*mpiOffset_cryst(i) ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write +#ifdef PETSc + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- + ! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i) + mpiOffset,& + int([Nconstituents*dataspace_size(i)],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- + !close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f position_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sclose_f space_id') + call h5sclose_f(memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sclose_f memspace') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + enddo + +end subroutine HDF5_backwardMappingCrystallite + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique cell to node mapping +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingCells(mapping) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:) :: mapping + + integer :: hdferr, Nnodes + integer(HID_T) :: mapping_id, dset_id, space_id + + Nnodes=size(mapping) + mapping_ID = results_openGroup("mapping") + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(1, int([Nnodes],HSIZE_T), space_id, hdferr, & + int([Nnodes],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5screate_simple_f') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, "Cell",H5T_NATIVE_INTEGER, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells') + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, mapping, int([Nnodes],HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5sclose_f') + call HDF5_closeGroup(mapping_ID) + +end subroutine HDF5_mappingCells + + +end module results diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 041761afe..5aa3648f3 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -246,10 +246,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) sourceState, & material_homog, & phase_NstiffnessDegradations, & - phase_stiffnessDegradation, & - porosity, & - porosityMapping, & - STIFFNESS_DEGRADATION_porosity_ID + phase_stiffnessDegradation use math, only : & math_mul33x33, & math_mul66x6, & @@ -279,15 +276,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) instance = source_damage_isoBrittle_instance(phase) !< instance of damage_isoBrittle source sourceOffset = source_damage_isoBrittle_offset(phase) - stiffness = C - do mech = 1_pInt, phase_NstiffnessDegradations(phase) - select case(phase_stiffnessDegradation(mech,phase)) - case (STIFFNESS_DEGRADATION_porosity_ID) - stiffness = porosity(material_homog(ip,el))%p(porosityMapping(material_homog(ip,el))%p(ip,el))* & - porosity(material_homog(ip,el))%p(porosityMapping(material_homog(ip,el))%p(ip,el))* & - stiffness - end select - enddo + stiffness = C strain = 0.5_pReal*math_Mandel33to6(math_mul33x33(math_transpose33(Fe),Fe)-math_I3) strainenergy = 2.0_pReal*sum(strain*math_mul66x6(stiffness,strain))/ & diff --git a/src/source_vacancy_irradiation.f90 b/src/source_vacancy_irradiation.f90 deleted file mode 100644 index 67b4cabcf..000000000 --- a/src/source_vacancy_irradiation.f90 +++ /dev/null @@ -1,248 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for vacancy generation due to irradiation -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module source_vacancy_irradiation - use prec, only: & - pReal, & - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - source_vacancy_irradiation_sizePostResults, & !< cumulative size of post results - source_vacancy_irradiation_offset, & !< which source is my current damage mechanism? - source_vacancy_irradiation_instance !< instance of damage source mechanism - - integer(pInt), dimension(:,:), allocatable, target, public :: & - source_vacancy_irradiation_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - source_vacancy_irradiation_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - source_vacancy_irradiation_Noutput !< number of outputs per instance of this damage - - real(pReal), dimension(:), allocatable, private :: & - source_vacancy_irradiation_cascadeProb, & - source_vacancy_irradiation_cascadeVolume - - public :: & - source_vacancy_irradiation_init, & - source_vacancy_irradiation_deltaState, & - source_vacancy_irradiation_getRateAndItsTangent - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine source_vacancy_irradiation_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF - use material, only: & - phase_source, & - phase_Nsources, & - phase_Noutput, & - SOURCE_vacancy_irradiation_label, & - SOURCE_vacancy_irradiation_ID, & - material_phase, & - sourceState - use config, only: & - material_Nphase, & - MATERIAL_partPhase - use numerics,only: & - numerics_integrator - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase - character(len=65536) :: & - tag = '', & - line = '' - - write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_irradiation_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(phase_source == SOURCE_vacancy_irradiation_ID),pInt) - if (maxNinstance == 0_pInt) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(source_vacancy_irradiation_offset(material_Nphase), source=0_pInt) - allocate(source_vacancy_irradiation_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - source_vacancy_irradiation_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_irradiation_ID) - do source = 1, phase_Nsources(phase) - if (phase_source(source,phase) == source_vacancy_irradiation_ID) & - source_vacancy_irradiation_offset(phase) = source - enddo - enddo - - allocate(source_vacancy_irradiation_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_vacancy_irradiation_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(source_vacancy_irradiation_output(maxval(phase_Noutput),maxNinstance)) - source_vacancy_irradiation_output = '' - allocate(source_vacancy_irradiation_Noutput(maxNinstance), source=0_pInt) - allocate(source_vacancy_irradiation_cascadeProb(maxNinstance), source=0.0_pReal) - allocate(source_vacancy_irradiation_cascadeVolume(maxNinstance), source=0.0_pReal) - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_irradiation_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = source_vacancy_irradiation_instance(phase) ! which instance of my vacancy is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('irradiation_cascadeprobability') - source_vacancy_irradiation_cascadeProb(instance) = IO_floatValue(line,chunkPos,2_pInt) - - case ('irradiation_cascadevolume') - source_vacancy_irradiation_cascadeVolume(instance) = IO_floatValue(line,chunkPos,2_pInt) - - end select - endif; endif - enddo parsingFile - - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_vacancy_irradiation_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_vacancy_irradiation_instance(phase) - sourceOffset = source_vacancy_irradiation_offset(phase) - - sizeDotState = 2_pInt - sizeDeltaState = 2_pInt - sizeState = 2_pInt - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState - sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_irradiation_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.1_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) - - endif - - enddo initializeInstances -end subroutine source_vacancy_irradiation_init - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates derived quantities from state -!-------------------------------------------------------------------------------------------------- -subroutine source_vacancy_irradiation_deltaState(ipc, ip, el) - use material, only: & - phaseAt, phasememberAt, & - sourceState - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - integer(pInt) :: & - phase, constituent, sourceOffset - real(pReal) :: & - randNo - - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) - sourceOffset = source_vacancy_irradiation_offset(phase) - - call random_number(randNo) - sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & - randNo - sourceState(phase)%p(sourceOffset)%state(1,constituent) - call random_number(randNo) - sourceState(phase)%p(sourceOffset)%deltaState(2,constituent) = & - randNo - sourceState(phase)%p(sourceOffset)%state(2,constituent) - -end subroutine source_vacancy_irradiation_deltaState - -!-------------------------------------------------------------------------------------------------- -!> @brief returns local vacancy generation rate -!-------------------------------------------------------------------------------------------------- -subroutine source_vacancy_irradiation_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el) - use material, only: & - phaseAt, phasememberAt, & - sourceState - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(out) :: & - CvDot, dCvDot_dCv - integer(pInt) :: & - instance, phase, constituent, sourceOffset - - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) - instance = source_vacancy_irradiation_instance(phase) - sourceOffset = source_vacancy_irradiation_offset(phase) - - CvDot = 0.0_pReal - dCvDot_dCv = 0.0_pReal - if (sourceState(phase)%p(sourceOffset)%state0(1,constituent) < source_vacancy_irradiation_cascadeProb(instance)) & - CvDot = sourceState(phase)%p(sourceOffset)%state0(2,constituent)*source_vacancy_irradiation_cascadeVolume(instance) - -end subroutine source_vacancy_irradiation_getRateAndItsTangent - -end module source_vacancy_irradiation diff --git a/src/source_vacancy_phenoplasticity.f90 b/src/source_vacancy_phenoplasticity.f90 deleted file mode 100644 index e20d8ec06..000000000 --- a/src/source_vacancy_phenoplasticity.f90 +++ /dev/null @@ -1,210 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for vacancy generation due to plasticity -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module source_vacancy_phenoplasticity - use prec, only: & - pReal, & - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - source_vacancy_phenoplasticity_sizePostResults, & !< cumulative size of post results - source_vacancy_phenoplasticity_offset, & !< which source is my current damage mechanism? - source_vacancy_phenoplasticity_instance !< instance of damage source mechanism - - integer(pInt), dimension(:,:), allocatable, target, public :: & - source_vacancy_phenoplasticity_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - source_vacancy_phenoplasticity_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - source_vacancy_phenoplasticity_Noutput !< number of outputs per instance of this damage - - real(pReal), dimension(:), allocatable, private :: & - source_vacancy_phenoplasticity_rateCoeff - - public :: & - source_vacancy_phenoplasticity_init, & - source_vacancy_phenoplasticity_getRateAndItsTangent - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine source_vacancy_phenoplasticity_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF - use material, only: & - phase_source, & - phase_Nsources, & - phase_Noutput, & - SOURCE_vacancy_phenoplasticity_label, & - SOURCE_vacancy_phenoplasticity_ID, & - material_phase, & - sourceState - use config, only: & - material_Nphase, & - MATERIAL_partPhase - use numerics,only: & - numerics_integrator - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase - character(len=65536) :: & - tag = '', & - line = '' - - write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_phenoplasticity_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(phase_source == SOURCE_vacancy_phenoplasticity_ID),pInt) - if (maxNinstance == 0_pInt) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(source_vacancy_phenoplasticity_offset(material_Nphase), source=0_pInt) - allocate(source_vacancy_phenoplasticity_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - source_vacancy_phenoplasticity_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_phenoplasticity_ID) - do source = 1, phase_Nsources(phase) - if (phase_source(source,phase) == source_vacancy_phenoplasticity_ID) & - source_vacancy_phenoplasticity_offset(phase) = source - enddo - enddo - - allocate(source_vacancy_phenoplasticity_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_vacancy_phenoplasticity_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(source_vacancy_phenoplasticity_output(maxval(phase_Noutput),maxNinstance)) - source_vacancy_phenoplasticity_output = '' - allocate(source_vacancy_phenoplasticity_Noutput(maxNinstance), source=0_pInt) - allocate(source_vacancy_phenoplasticity_rateCoeff(maxNinstance), source=0.0_pReal) - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_phenoplasticity_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = source_vacancy_phenoplasticity_instance(phase) ! which instance of my vacancy is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('phenoplasticity_ratecoeff') - source_vacancy_phenoplasticity_rateCoeff(instance) = IO_floatValue(line,chunkPos,2_pInt) - - end select - endif; endif - enddo parsingFile - - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_vacancy_phenoplasticity_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_vacancy_phenoplasticity_instance(phase) - sourceOffset = source_vacancy_phenoplasticity_offset(phase) - - sizeDotState = 0_pInt - sizeDeltaState = 0_pInt - sizeState = 0_pInt - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState - sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_phenoplasticity_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) - - endif - - enddo initializeInstances -end subroutine source_vacancy_phenoplasticity_init - -!-------------------------------------------------------------------------------------------------- -!> @brief returns local vacancy generation rate -!-------------------------------------------------------------------------------------------------- -subroutine source_vacancy_phenoplasticity_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el) - use material, only: & - phaseAt, phasememberAt, & - plasticState - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(out) :: & - CvDot, dCvDot_dCv - integer(pInt) :: & - instance, phase, constituent - - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) - instance = source_vacancy_phenoplasticity_instance(phase) - - CvDot = & - source_vacancy_phenoplasticity_rateCoeff(instance)* & - sum(plasticState(phase)%slipRate(:,constituent)) - dCvDot_dCv = 0.0_pReal - -end subroutine source_vacancy_phenoplasticity_getRateAndItsTangent - -end module source_vacancy_phenoplasticity diff --git a/src/source_vacancy_thermalfluc.f90 b/src/source_vacancy_thermalfluc.f90 deleted file mode 100644 index cea52aa75..000000000 --- a/src/source_vacancy_thermalfluc.f90 +++ /dev/null @@ -1,250 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for vacancy generation due to thermal fluctuations -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module source_vacancy_thermalfluc - use prec, only: & - pReal, & - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - source_vacancy_thermalfluc_sizePostResults, & !< cumulative size of post results - source_vacancy_thermalfluc_offset, & !< which source is my current damage mechanism? - source_vacancy_thermalfluc_instance !< instance of damage source mechanism - - integer(pInt), dimension(:,:), allocatable, target, public :: & - source_vacancy_thermalfluc_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - source_vacancy_thermalfluc_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - source_vacancy_thermalfluc_Noutput !< number of outputs per instance of this damage - - real(pReal), dimension(:), allocatable, private :: & - source_vacancy_thermalfluc_amplitude, & - source_vacancy_thermalfluc_normVacancyEnergy - - public :: & - source_vacancy_thermalfluc_init, & - source_vacancy_thermalfluc_deltaState, & - source_vacancy_thermalfluc_getRateAndItsTangent - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine source_vacancy_thermalfluc_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF - use lattice, only: & - lattice_vacancyFormationEnergy - use material, only: & - phase_source, & - phase_Nsources, & - phase_Noutput, & - SOURCE_vacancy_thermalfluc_label, & - SOURCE_vacancy_thermalfluc_ID, & - material_phase, & - sourceState - use config, only: & - material_Nphase, & - MATERIAL_partPhase - use numerics,only: & - numerics_integrator - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase - character(len=65536) :: & - tag = '', & - line = '' - - write(6,'(/,a)') ' <<<+- source_'//SOURCE_vacancy_thermalfluc_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(phase_source == SOURCE_vacancy_thermalfluc_ID),pInt) - if (maxNinstance == 0_pInt) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(source_vacancy_thermalfluc_offset(material_Nphase), source=0_pInt) - allocate(source_vacancy_thermalfluc_instance(material_Nphase), source=0_pInt) - do phase = 1, material_Nphase - source_vacancy_thermalfluc_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_thermalfluc_ID) - do source = 1, phase_Nsources(phase) - if (phase_source(source,phase) == source_vacancy_thermalfluc_ID) & - source_vacancy_thermalfluc_offset(phase) = source - enddo - enddo - - allocate(source_vacancy_thermalfluc_sizePostResults(maxNinstance), source=0_pInt) - allocate(source_vacancy_thermalfluc_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) - allocate(source_vacancy_thermalfluc_output(maxval(phase_Noutput),maxNinstance)) - source_vacancy_thermalfluc_output = '' - allocate(source_vacancy_thermalfluc_Noutput(maxNinstance), source=0_pInt) - allocate(source_vacancy_thermalfluc_amplitude(maxNinstance), source=0.0_pReal) - allocate(source_vacancy_thermalfluc_normVacancyEnergy(maxNinstance), source=0.0_pReal) - - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase section - phase = phase + 1_pInt ! advance phase section counter - cycle ! skip to next line - endif - - if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_thermalfluc_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = source_vacancy_thermalfluc_instance(phase) ! which instance of my vacancy is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('thermalfluctuation_amplitude') - source_vacancy_thermalfluc_amplitude(instance) = IO_floatValue(line,chunkPos,2_pInt) - - end select - endif; endif - enddo parsingFile - - initializeInstances: do phase = 1_pInt, material_Nphase - if (any(phase_source(:,phase) == SOURCE_vacancy_thermalfluc_ID)) then - NofMyPhase=count(material_phase==phase) - instance = source_vacancy_thermalfluc_instance(phase) - source_vacancy_thermalfluc_normVacancyEnergy(instance) = & - lattice_vacancyFormationEnergy(phase)/1.3806488e-23_pReal - sourceOffset = source_vacancy_thermalfluc_offset(phase) - - sizeDotState = 1_pInt - sizeDeltaState = 1_pInt - sizeState = 1_pInt - sourceState(phase)%p(sourceOffset)%sizeState = sizeState - sourceState(phase)%p(sourceOffset)%sizeDotState = sizeDotState - sourceState(phase)%p(sourceOffset)%sizeDeltaState = sizeDeltaState - sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_thermalfluc_sizePostResults(instance) - allocate(sourceState(phase)%p(sourceOffset)%aTolState (sizeState), source=0.1_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(sourceState(phase)%p(sourceOffset)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(sourceState(phase)%p(sourceOffset)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) - - endif - - enddo initializeInstances -end subroutine source_vacancy_thermalfluc_init - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates derived quantities from state -!-------------------------------------------------------------------------------------------------- -subroutine source_vacancy_thermalfluc_deltaState(ipc, ip, el) - use material, only: & - phaseAt, phasememberAt, & - sourceState - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - integer(pInt) :: & - phase, constituent, sourceOffset - real(pReal) :: & - randNo - - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) - sourceOffset = source_vacancy_thermalfluc_offset(phase) - - call random_number(randNo) - sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & - randNo - 0.5_pReal - sourceState(phase)%p(sourceOffset)%state(1,constituent) - -end subroutine source_vacancy_thermalfluc_deltaState - -!-------------------------------------------------------------------------------------------------- -!> @brief returns local vacancy generation rate -!-------------------------------------------------------------------------------------------------- -subroutine source_vacancy_thermalfluc_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el) - use material, only: & - phaseAt, phasememberAt, & - material_homog, & - temperature, & - thermalMapping, & - sourceState - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(out) :: & - CvDot, dCvDot_dCv - integer(pInt) :: & - instance, phase, constituent, sourceOffset - - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) - instance = source_vacancy_thermalfluc_instance(phase) - sourceOffset = source_vacancy_thermalfluc_offset(phase) - - CvDot = source_vacancy_thermalfluc_amplitude(instance)* & - sourceState(phase)%p(sourceOffset)%state0(2,constituent)* & - exp(-source_vacancy_thermalfluc_normVacancyEnergy(instance)/ & - temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el))) - dCvDot_dCv = 0.0_pReal - -end subroutine source_vacancy_thermalfluc_getRateAndItsTangent - -end module source_vacancy_thermalfluc diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index d6f353c91..003c9820d 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -80,6 +80,7 @@ subroutine basic_init #endif use IO, only: & IO_intOut, & + IO_error, & IO_read_realFile, & IO_timeStamp use debug, only: & @@ -173,7 +174,11 @@ subroutine basic_init call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot)) read (777,rec=1) F_aimDot; close (777) F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F + call MPI_Allreduce(MPI_IN_PLACE,F_aim,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim') F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc + call MPI_Allreduce(MPI_IN_PLACE,F_aim_lastInc,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim_lastInc') elseif (restartInc == 0_pInt) then restart F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index 04f51cb35..b1da2a3f0 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -78,7 +78,6 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields and fills them with data, potentially from restart info -!> @todo use sourced allocation, e.g. allocate(Fdot,source = F_lastInc) !-------------------------------------------------------------------------------------------------- subroutine Polarisation_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 @@ -88,6 +87,7 @@ subroutine Polarisation_init #endif use IO, only: & IO_intOut, & + IO_error, & IO_read_realFile, & IO_timeStamp use debug, only: & @@ -191,7 +191,11 @@ subroutine Polarisation_init call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot)) read (777,rec=1) F_aimDot; close (777) F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F + call MPI_Allreduce(MPI_IN_PLACE,F_aim,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim') F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc + call MPI_Allreduce(MPI_IN_PLACE,F_aim_lastInc,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim_lastInc') elseif (restartInc == 0_pInt) then restart F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) diff --git a/src/vacancyflux_cahnhilliard.f90 b/src/vacancyflux_cahnhilliard.f90 deleted file mode 100644 index ae5bd1cbc..000000000 --- a/src/vacancyflux_cahnhilliard.f90 +++ /dev/null @@ -1,602 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for conservative transport of vacancy concentration field -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module vacancyflux_cahnhilliard - use prec, only: & - pReal, & - pInt, & - group_float - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - vacancyflux_cahnhilliard_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - vacancyflux_cahnhilliard_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - vacancyflux_cahnhilliard_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - vacancyflux_cahnhilliard_Noutput !< number of outputs per instance of this damage - - real(pReal), dimension(:), allocatable, private :: & - vacancyflux_cahnhilliard_flucAmplitude - - type(group_float), dimension(:), allocatable, private :: & - vacancyflux_cahnhilliard_thermalFluc - - real(pReal), parameter, private :: & - kB = 1.3806488e-23_pReal !< Boltzmann constant in J/Kelvin - - enum, bind(c) - enumerator :: undefined_ID, & - vacancyConc_ID - end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - vacancyflux_cahnhilliard_outputID !< ID of each post result output - - - public :: & - vacancyflux_cahnhilliard_init, & - vacancyflux_cahnhilliard_getSourceAndItsTangent, & - vacancyflux_cahnhilliard_getMobility33, & - vacancyflux_cahnhilliard_getDiffusion33, & - vacancyflux_cahnhilliard_getChemPotAndItsTangent, & - vacancyflux_cahnhilliard_putVacancyConcAndItsRate, & - vacancyflux_cahnhilliard_postResults - private :: & - vacancyflux_cahnhilliard_getFormationEnergy, & - vacancyflux_cahnhilliard_getEntropicCoeff, & - vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_cahnhilliard_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF - use material, only: & - vacancyflux_type, & - vacancyflux_typeInstance, & - homogenization_Noutput, & - VACANCYFLUX_cahnhilliard_label, & - VACANCYFLUX_cahnhilliard_ID, & - material_homog, & - mappingHomogenization, & - vacancyfluxState, & - vacancyfluxMapping, & - vacancyConc, & - vacancyConcRate, & - vacancyflux_initialCv - use config, only: & - material_partPhase, & - material_partHomogenization - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o,offset - integer(pInt) :: sizeState - integer(pInt) :: NofMyHomog - character(len=65536) :: & - tag = '', & - line = '' - - write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_cahnhilliard_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_cahnhilliard_ID),pInt) - if (maxNinstance == 0_pInt) return - - allocate(vacancyflux_cahnhilliard_sizePostResults(maxNinstance), source=0_pInt) - allocate(vacancyflux_cahnhilliard_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) - allocate(vacancyflux_cahnhilliard_output (maxval(homogenization_Noutput),maxNinstance)) - vacancyflux_cahnhilliard_output = '' - allocate(vacancyflux_cahnhilliard_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) - allocate(vacancyflux_cahnhilliard_Noutput (maxNinstance), source=0_pInt) - - allocate(vacancyflux_cahnhilliard_flucAmplitude (maxNinstance)) - allocate(vacancyflux_cahnhilliard_thermalFluc (maxNinstance)) - - rewind(fileUnit) - section = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to - line = IO_read(fileUnit) - enddo - - parsingHomog: do while (trim(line) /= IO_EOF) ! read through sections of homog part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next homog section - section = section + 1_pInt ! advance homog section counter - cycle ! skip to next line - endif - - if (section > 0_pInt ) then; if (vacancyflux_type(section) == VACANCYFLUX_cahnhilliard_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = vacancyflux_typeInstance(section) ! which instance of my vacancyflux is present homog - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('vacancyconc') - vacancyflux_cahnhilliard_Noutput(instance) = vacancyflux_cahnhilliard_Noutput(instance) + 1_pInt - vacancyflux_cahnhilliard_outputID(vacancyflux_cahnhilliard_Noutput(instance),instance) = vacancyConc_ID - vacancyflux_cahnhilliard_output(vacancyflux_cahnhilliard_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - case ('vacancyflux_flucamplitude') - vacancyflux_cahnhilliard_flucAmplitude(instance) = IO_floatValue(line,chunkPos,2_pInt) - - end select - endif; endif - enddo parsingHomog - - initializeInstances: do section = 1_pInt, size(vacancyflux_type) - if (vacancyflux_type(section) == VACANCYFLUX_cahnhilliard_ID) then - NofMyHomog=count(material_homog==section) - instance = vacancyflux_typeInstance(section) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,vacancyflux_cahnhilliard_Noutput(instance) - select case(vacancyflux_cahnhilliard_outputID(o,instance)) - case(vacancyConc_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - vacancyflux_cahnhilliard_sizePostResult(o,instance) = mySize - vacancyflux_cahnhilliard_sizePostResults(instance) = vacancyflux_cahnhilliard_sizePostResults(instance) + mySize - endif - enddo outputsLoop - -! allocate state arrays - sizeState = 0_pInt - vacancyfluxState(section)%sizeState = sizeState - vacancyfluxState(section)%sizePostResults = vacancyflux_cahnhilliard_sizePostResults(instance) - allocate(vacancyfluxState(section)%state0 (sizeState,NofMyHomog)) - allocate(vacancyfluxState(section)%subState0(sizeState,NofMyHomog)) - allocate(vacancyfluxState(section)%state (sizeState,NofMyHomog)) - - allocate(vacancyflux_cahnhilliard_thermalFluc(instance)%p(NofMyHomog)) - do offset = 1_pInt, NofMyHomog - call random_number(vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset)) - vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset) = & - 1.0_pReal - & - vacancyflux_cahnhilliard_flucAmplitude(instance)* & - (vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset) - 0.5_pReal) - enddo - - nullify(vacancyfluxMapping(section)%p) - vacancyfluxMapping(section)%p => mappingHomogenization(1,:,:) - deallocate(vacancyConc (section)%p) - allocate (vacancyConc (section)%p(NofMyHomog), source=vacancyflux_initialCv(section)) - deallocate(vacancyConcRate(section)%p) - allocate (vacancyConcRate(section)%p(NofMyHomog), source=0.0_pReal) - - endif - - enddo initializeInstances - -end subroutine vacancyflux_cahnhilliard_init - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates homogenized vacancy driving forces -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_cahnhilliard_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el) - use material, only: & - homogenization_Ngrains, & - mappingHomogenization, & - phaseAt, & - phase_source, & - phase_Nsources, & - SOURCE_vacancy_phenoplasticity_ID, & - SOURCE_vacancy_irradiation_ID, & - SOURCE_vacancy_thermalfluc_ID - use source_vacancy_phenoplasticity, only: & - source_vacancy_phenoplasticity_getRateAndItsTangent - use source_vacancy_irradiation, only: & - source_vacancy_irradiation_getRateAndItsTangent - use source_vacancy_thermalfluc, only: & - source_vacancy_thermalfluc_getRateAndItsTangent - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Cv - integer(pInt) :: & - phase, & - grain, & - source - real(pReal) :: & - CvDot, dCvDot_dCv, localCvDot, dLocalCvDot_dCv - - CvDot = 0.0_pReal - dCvDot_dCv = 0.0_pReal - do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el)) - phase = phaseAt(grain,ip,el) - do source = 1_pInt, phase_Nsources(phase) - select case(phase_source(source,phase)) - case (SOURCE_vacancy_phenoplasticity_ID) - call source_vacancy_phenoplasticity_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el) - - case (SOURCE_vacancy_irradiation_ID) - call source_vacancy_irradiation_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el) - - case (SOURCE_vacancy_thermalfluc_ID) - call source_vacancy_thermalfluc_getRateAndItsTangent(localCvDot, dLocalCvDot_dCv, grain, ip, el) - - end select - CvDot = CvDot + localCvDot - dCvDot_dCv = dCvDot_dCv + dLocalCvDot_dCv - enddo - enddo - - CvDot = CvDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal) - dCvDot_dCv = dCvDot_dCv/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal) - -end subroutine vacancyflux_cahnhilliard_getSourceAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized vacancy mobility tensor in reference configuration -!-------------------------------------------------------------------------------------------------- -function vacancyflux_cahnhilliard_getMobility33(ip,el) - use lattice, only: & - lattice_vacancyfluxMobility33 - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element - use crystallite, only: & - crystallite_push33ToRef - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - vacancyflux_cahnhilliard_getMobility33 - integer(pInt) :: & - grain - - vacancyflux_cahnhilliard_getMobility33 = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - vacancyflux_cahnhilliard_getMobility33 = vacancyflux_cahnhilliard_getMobility33 + & - crystallite_push33ToRef(grain,ip,el,lattice_vacancyfluxMobility33(:,:,material_phase(grain,ip,el))) - enddo - - vacancyflux_cahnhilliard_getMobility33 = & - vacancyflux_cahnhilliard_getMobility33/real(homogenization_Ngrains(mesh_element(3,el)),pReal) - -end function vacancyflux_cahnhilliard_getMobility33 - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized vacancy diffusion tensor in reference configuration -!-------------------------------------------------------------------------------------------------- -function vacancyflux_cahnhilliard_getDiffusion33(ip,el) - use lattice, only: & - lattice_vacancyfluxDiffusion33 - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element - use crystallite, only: & - crystallite_push33ToRef - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - vacancyflux_cahnhilliard_getDiffusion33 - integer(pInt) :: & - grain - - vacancyflux_cahnhilliard_getDiffusion33 = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - vacancyflux_cahnhilliard_getDiffusion33 = vacancyflux_cahnhilliard_getDiffusion33 + & - crystallite_push33ToRef(grain,ip,el,lattice_vacancyfluxDiffusion33(:,:,material_phase(grain,ip,el))) - enddo - - vacancyflux_cahnhilliard_getDiffusion33 = & - vacancyflux_cahnhilliard_getDiffusion33/real(homogenization_Ngrains(mesh_element(3,el)),pReal) - -end function vacancyflux_cahnhilliard_getDiffusion33 - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized vacancy formation energy -!-------------------------------------------------------------------------------------------------- -real(pReal) function vacancyflux_cahnhilliard_getFormationEnergy(ip,el) - use lattice, only: & - lattice_vacancyFormationEnergy, & - lattice_vacancyVol, & - lattice_vacancySurfaceEnergy - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - integer(pInt) :: & - grain - - vacancyflux_cahnhilliard_getFormationEnergy = 0.0_pReal - do grain = 1, homogenization_Ngrains(mesh_element(3,el)) - vacancyflux_cahnhilliard_getFormationEnergy = vacancyflux_cahnhilliard_getFormationEnergy + & - lattice_vacancyFormationEnergy(material_phase(grain,ip,el))/ & - lattice_vacancyVol(material_phase(grain,ip,el))/ & - lattice_vacancySurfaceEnergy(material_phase(grain,ip,el)) - enddo - - vacancyflux_cahnhilliard_getFormationEnergy = & - vacancyflux_cahnhilliard_getFormationEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal) - -end function vacancyflux_cahnhilliard_getFormationEnergy - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized vacancy entropy coefficient -!-------------------------------------------------------------------------------------------------- -real(pReal) function vacancyflux_cahnhilliard_getEntropicCoeff(ip,el) - use lattice, only: & - lattice_vacancyVol, & - lattice_vacancySurfaceEnergy - use material, only: & - homogenization_Ngrains, & - material_homog, & - material_phase, & - temperature, & - thermalMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - integer(pInt) :: & - grain - - vacancyflux_cahnhilliard_getEntropicCoeff = 0.0_pReal - do grain = 1, homogenization_Ngrains(material_homog(ip,el)) - vacancyflux_cahnhilliard_getEntropicCoeff = vacancyflux_cahnhilliard_getEntropicCoeff + & - kB/ & - lattice_vacancyVol(material_phase(grain,ip,el))/ & - lattice_vacancySurfaceEnergy(material_phase(grain,ip,el)) - enddo - - vacancyflux_cahnhilliard_getEntropicCoeff = & - vacancyflux_cahnhilliard_getEntropicCoeff* & - temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el))/ & - real(homogenization_Ngrains(material_homog(ip,el)),pReal) - -end function vacancyflux_cahnhilliard_getEntropicCoeff - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized kinematic contribution to chemical potential -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCv, Cv, ip, el) - use lattice, only: & - lattice_vacancySurfaceEnergy - use material, only: & - homogenization_Ngrains, & - material_homog, & - phase_kinematics, & - phase_Nkinematics, & - material_phase, & - KINEMATICS_vacancy_strain_ID - use crystallite, only: & - crystallite_Tstar_v, & - crystallite_Fi0, & - crystallite_Fi - use kinematics_vacancy_strain, only: & - kinematics_vacancy_strain_ChemPotAndItsTangent - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Cv - real(pReal), intent(out) :: & - KPot, dKPot_dCv - real(pReal) :: & - my_KPot, my_dKPot_dCv - integer(pInt) :: & - grain, kinematics - - KPot = 0.0_pReal - dKPot_dCv = 0.0_pReal - do grain = 1_pInt,homogenization_Ngrains(material_homog(ip,el)) - do kinematics = 1_pInt, phase_Nkinematics(material_phase(grain,ip,el)) - select case (phase_kinematics(kinematics,material_phase(grain,ip,el))) - case (KINEMATICS_vacancy_strain_ID) - call kinematics_vacancy_strain_ChemPotAndItsTangent(my_KPot, my_dKPot_dCv, & - crystallite_Tstar_v(1:6,grain,ip,el), & - crystallite_Fi0(1:3,1:3,grain,ip,el), & - crystallite_Fi (1:3,1:3,grain,ip,el), & - grain,ip, el) - - case default - my_KPot = 0.0_pReal - my_dKPot_dCv = 0.0_pReal - - end select - KPot = KPot + my_KPot/lattice_vacancySurfaceEnergy(material_phase(grain,ip,el)) - dKPot_dCv = dKPot_dCv + my_dKPot_dCv/lattice_vacancySurfaceEnergy(material_phase(grain,ip,el)) - enddo - enddo - - KPot = KPot/real(homogenization_Ngrains(material_homog(ip,el)),pReal) - dKPot_dCv = dKPot_dCv/real(homogenization_Ngrains(material_homog(ip,el)),pReal) - -end subroutine vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized chemical potential and its tangent -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_cahnhilliard_getChemPotAndItsTangent(ChemPot,dChemPot_dCv,Cv,ip,el) - use numerics, only: & - vacancyBoundPenalty, & - vacancyPolyOrder - use material, only: & - mappingHomogenization, & - vacancyflux_typeInstance, & - porosity, & - porosityMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Cv - real(pReal), intent(out) :: & - ChemPot, & - dChemPot_dCv - real(pReal) :: & - VoidPhaseFrac, kBT, KPot, dKPot_dCv - integer(pInt) :: & - homog, o - - homog = mappingHomogenization(2,ip,el) - VoidPhaseFrac = porosity(homog)%p(porosityMapping(homog)%p(ip,el)) - kBT = vacancyflux_cahnhilliard_getEntropicCoeff(ip,el) - - ChemPot = vacancyflux_cahnhilliard_getFormationEnergy(ip,el) - dChemPot_dCv = 0.0_pReal - do o = 1_pInt, vacancyPolyOrder - ChemPot = ChemPot + kBT*((2.0_pReal*Cv - 1.0_pReal)**real(2_pInt*o-1_pInt,pReal))/ & - real(2_pInt*o-1_pInt,pReal) - dChemPot_dCv = dChemPot_dCv + 2.0_pReal*kBT*(2.0_pReal*Cv - 1.0_pReal)**real(2_pInt*o-2_pInt,pReal) - enddo - - ChemPot = VoidPhaseFrac*VoidPhaseFrac*ChemPot & - - 2.0_pReal*(1.0_pReal - Cv)*(1.0_pReal - VoidPhaseFrac)*(1.0_pReal - VoidPhaseFrac) - - dChemPot_dCv = VoidPhaseFrac*VoidPhaseFrac*dChemPot_dCv & - + 2.0_pReal*(1.0_pReal - VoidPhaseFrac)*(1.0_pReal - VoidPhaseFrac) - - call vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCv, Cv, ip, el) - ChemPot = ChemPot + KPot - dChemPot_dCv = dChemPot_dCv + dKPot_dCv - - if (Cv < 0.0_pReal) then - ChemPot = ChemPot - 3.0_pReal*vacancyBoundPenalty*Cv*Cv - dChemPot_dCv = dChemPot_dCv - 6.0_pReal*vacancyBoundPenalty*Cv - elseif (Cv > 1.0_pReal) then - ChemPot = ChemPot + 3.0_pReal*vacancyBoundPenalty*(1.0_pReal - Cv)*(1.0_pReal - Cv) - dChemPot_dCv = dChemPot_dCv - 6.0_pReal*vacancyBoundPenalty*(1.0_pReal - Cv) - endif - - ChemPot = ChemPot* & - vacancyflux_cahnhilliard_thermalFluc(vacancyflux_typeInstance(homog))%p(mappingHomogenization(1,ip,el)) - dChemPot_dCv = dChemPot_dCv* & - vacancyflux_cahnhilliard_thermalFluc(vacancyflux_typeInstance(homog))%p(mappingHomogenization(1,ip,el)) - -end subroutine vacancyflux_cahnhilliard_getChemPotAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief updated vacancy concentration and its rate with solution from transport PDE -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_cahnhilliard_putVacancyConcAndItsRate(Cv,Cvdot,ip,el) - use material, only: & - mappingHomogenization, & - vacancyConc, & - vacancyConcRate, & - vacancyfluxMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Cv, & - Cvdot - integer(pInt) :: & - homog, & - offset - - homog = mappingHomogenization(2,ip,el) - offset = vacancyfluxMapping(homog)%p(ip,el) - vacancyConc (homog)%p(offset) = Cv - vacancyConcRate(homog)%p(offset) = Cvdot - -end subroutine vacancyflux_cahnhilliard_putVacancyConcAndItsRate - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of vacancy transport results -!-------------------------------------------------------------------------------------------------- -function vacancyflux_cahnhilliard_postResults(ip,el) - use material, only: & - mappingHomogenization, & - vacancyflux_typeInstance, & - vacancyConc, & - vacancyfluxMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(vacancyflux_cahnhilliard_sizePostResults(vacancyflux_typeInstance(mappingHomogenization(2,ip,el)))) :: & - vacancyflux_cahnhilliard_postResults - - integer(pInt) :: & - instance, homog, offset, o, c - - homog = mappingHomogenization(2,ip,el) - offset = vacancyfluxMapping(homog)%p(ip,el) - instance = vacancyflux_typeInstance(homog) - - c = 0_pInt - vacancyflux_cahnhilliard_postResults = 0.0_pReal - - do o = 1_pInt,vacancyflux_cahnhilliard_Noutput(instance) - select case(vacancyflux_cahnhilliard_outputID(o,instance)) - - case (vacancyConc_ID) - vacancyflux_cahnhilliard_postResults(c+1_pInt) = vacancyConc(homog)%p(offset) - c = c + 1 - end select - enddo -end function vacancyflux_cahnhilliard_postResults - -end module vacancyflux_cahnhilliard diff --git a/src/vacancyflux_isochempot.f90 b/src/vacancyflux_isochempot.f90 deleted file mode 100644 index 761a0ba22..000000000 --- a/src/vacancyflux_isochempot.f90 +++ /dev/null @@ -1,328 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for locally evolving vacancy concentration -!> @details to be done -!-------------------------------------------------------------------------------------------------- -module vacancyflux_isochempot - use prec, only: & - pReal, & - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - vacancyflux_isochempot_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - vacancyflux_isochempot_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - vacancyflux_isochempot_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - vacancyflux_isochempot_Noutput !< number of outputs per instance of this damage - - enum, bind(c) - enumerator :: undefined_ID, & - vacancyconc_ID - end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - vacancyflux_isochempot_outputID !< ID of each post result output - - - public :: & - vacancyflux_isochempot_init, & - vacancyflux_isochempot_updateState, & - vacancyflux_isochempot_getSourceAndItsTangent, & - vacancyflux_isochempot_postResults - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_isochempot_init(fileUnit) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF - use material, only: & - vacancyflux_type, & - vacancyflux_typeInstance, & - homogenization_Noutput, & - VACANCYFLUX_isochempot_label, & - VACANCYFLUX_isochempot_ID, & - material_homog, & - mappingHomogenization, & - vacancyfluxState, & - vacancyfluxMapping, & - vacancyConc, & - vacancyConcRate, & - vacancyflux_initialCv - use config, only: & - material_partHomogenization - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o - integer(pInt) :: sizeState - integer(pInt) :: NofMyHomog - character(len=65536) :: & - tag = '', & - line = '' - - write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_isochempot_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_isochempot_ID),pInt) - if (maxNinstance == 0_pInt) return - - allocate(vacancyflux_isochempot_sizePostResults(maxNinstance), source=0_pInt) - allocate(vacancyflux_isochempot_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt) - allocate(vacancyflux_isochempot_output (maxval(homogenization_Noutput),maxNinstance)) - vacancyflux_isochempot_output = '' - allocate(vacancyflux_isochempot_outputID (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID) - allocate(vacancyflux_isochempot_Noutput (maxNinstance), source=0_pInt) - - rewind(fileUnit) - section = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of homog part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next homog section - section = section + 1_pInt ! advance homog section counter - cycle ! skip to next line - endif - - if (section > 0_pInt ) then; if (vacancyflux_type(section) == VACANCYFLUX_isochempot_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - - instance = vacancyflux_typeInstance(section) ! which instance of my vacancyflux is present homog - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('vacancyconc') - vacancyflux_isochempot_Noutput(instance) = vacancyflux_isochempot_Noutput(instance) + 1_pInt - vacancyflux_isochempot_outputID(vacancyflux_isochempot_Noutput(instance),instance) = vacancyconc_ID - vacancyflux_isochempot_output(vacancyflux_isochempot_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - - end select - endif; endif - enddo parsingFile - - initializeInstances: do section = 1_pInt, size(vacancyflux_type) - if (vacancyflux_type(section) == VACANCYFLUX_isochempot_ID) then - NofMyHomog=count(material_homog==section) - instance = vacancyflux_typeInstance(section) - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,vacancyflux_isochempot_Noutput(instance) - select case(vacancyflux_isochempot_outputID(o,instance)) - case(vacancyconc_ID) - mySize = 1_pInt - end select - - if (mySize > 0_pInt) then ! any meaningful output found - vacancyflux_isochempot_sizePostResult(o,instance) = mySize - vacancyflux_isochempot_sizePostResults(instance) = vacancyflux_isochempot_sizePostResults(instance) + mySize - endif - enddo outputsLoop - -! allocate state arrays - sizeState = 1_pInt - vacancyfluxState(section)%sizeState = sizeState - vacancyfluxState(section)%sizePostResults = vacancyflux_isochempot_sizePostResults(instance) - allocate(vacancyfluxState(section)%state0 (sizeState,NofMyHomog), source=vacancyflux_initialCv(section)) - allocate(vacancyfluxState(section)%subState0(sizeState,NofMyHomog), source=vacancyflux_initialCv(section)) - allocate(vacancyfluxState(section)%state (sizeState,NofMyHomog), source=vacancyflux_initialCv(section)) - - nullify(vacancyfluxMapping(section)%p) - vacancyfluxMapping(section)%p => mappingHomogenization(1,:,:) - deallocate(vacancyConc(section)%p) - vacancyConc(section)%p => vacancyfluxState(section)%state(1,:) - deallocate(vacancyConcRate(section)%p) - allocate(vacancyConcRate(section)%p(NofMyHomog), source=0.0_pReal) - - endif - - enddo initializeInstances -end subroutine vacancyflux_isochempot_init - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates change in vacancy concentration based on local vacancy generation model -!-------------------------------------------------------------------------------------------------- -function vacancyflux_isochempot_updateState(subdt, ip, el) - use numerics, only: & - err_vacancyflux_tolAbs, & - err_vacancyflux_tolRel - use material, only: & - mappingHomogenization, & - vacancyflux_typeInstance, & - vacancyfluxState, & - vacancyConc, & - vacancyConcRate, & - vacancyfluxMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - subdt - logical, dimension(2) :: & - vacancyflux_isochempot_updateState - integer(pInt) :: & - homog, & - offset, & - instance - real(pReal) :: & - Cv, Cvdot, dCvDot_dCv - - homog = mappingHomogenization(2,ip,el) - offset = mappingHomogenization(1,ip,el) - instance = vacancyflux_typeInstance(homog) - - Cv = vacancyfluxState(homog)%subState0(1,offset) - call vacancyflux_isochempot_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el) - Cv = Cv + subdt*Cvdot - - vacancyflux_isochempot_updateState = [ abs(Cv - vacancyfluxState(homog)%state(1,offset)) & - <= err_vacancyflux_tolAbs & - .or. abs(Cv - vacancyfluxState(homog)%state(1,offset)) & - <= err_vacancyflux_tolRel*abs(vacancyfluxState(homog)%state(1,offset)), & - .true.] - - vacancyConc (homog)%p(vacancyfluxMapping(homog)%p(ip,el)) = Cv - vacancyConcRate(homog)%p(vacancyfluxMapping(homog)%p(ip,el)) = & - (vacancyfluxState(homog)%state(1,offset) - vacancyfluxState(homog)%subState0(1,offset))/(subdt+tiny(0.0_pReal)) - -end function vacancyflux_isochempot_updateState - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates homogenized vacancy driving forces -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_isochempot_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el) - use material, only: & - homogenization_Ngrains, & - mappingHomogenization, & - phaseAt, & - phase_source, & - phase_Nsources, & - SOURCE_vacancy_phenoplasticity_ID, & - SOURCE_vacancy_irradiation_ID, & - SOURCE_vacancy_thermalfluc_ID - use source_vacancy_phenoplasticity, only: & - source_vacancy_phenoplasticity_getRateAndItsTangent - use source_vacancy_irradiation, only: & - source_vacancy_irradiation_getRateAndItsTangent - use source_vacancy_thermalfluc, only: & - source_vacancy_thermalfluc_getRateAndItsTangent - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - Cv - integer(pInt) :: & - phase, & - grain, & - source - real(pReal) :: & - CvDot, dCvDot_dCv, localCvDot, dLocalCvDot_dCv - - CvDot = 0.0_pReal - dCvDot_dCv = 0.0_pReal - do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el)) - phase = phaseAt(grain,ip,el) - do source = 1_pInt, phase_Nsources(phase) - select case(phase_source(source,phase)) - case (SOURCE_vacancy_phenoplasticity_ID) - call source_vacancy_phenoplasticity_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el) - - case (SOURCE_vacancy_irradiation_ID) - call source_vacancy_irradiation_getRateAndItsTangent (localCvDot, dLocalCvDot_dCv, grain, ip, el) - - case (SOURCE_vacancy_thermalfluc_ID) - call source_vacancy_thermalfluc_getRateAndItsTangent(localCvDot, dLocalCvDot_dCv, grain, ip, el) - - end select - CvDot = CvDot + localCvDot - dCvDot_dCv = dCvDot_dCv + dLocalCvDot_dCv - enddo - enddo - - CvDot = CvDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal) - dCvDot_dCv = dCvDot_dCv/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal) - -end subroutine vacancyflux_isochempot_getSourceAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of vacancy transport results -!-------------------------------------------------------------------------------------------------- -function vacancyflux_isochempot_postResults(ip,el) - use material, only: & - mappingHomogenization, & - vacancyflux_typeInstance, & - vacancyConc, & - vacancyfluxMapping - - implicit none - integer(pInt), intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(vacancyflux_isochempot_sizePostResults(vacancyflux_typeInstance(mappingHomogenization(2,ip,el)))) :: & - vacancyflux_isochempot_postResults - - integer(pInt) :: & - instance, homog, offset, o, c - - homog = mappingHomogenization(2,ip,el) - offset = vacancyfluxMapping(homog)%p(ip,el) - instance = vacancyflux_typeInstance(homog) - - c = 0_pInt - vacancyflux_isochempot_postResults = 0.0_pReal - - do o = 1_pInt,vacancyflux_isochempot_Noutput(instance) - select case(vacancyflux_isochempot_outputID(o,instance)) - - case (vacancyconc_ID) - vacancyflux_isochempot_postResults(c+1_pInt) = vacancyConc(homog)%p(offset) - c = c + 1 - end select - enddo -end function vacancyflux_isochempot_postResults - -end module vacancyflux_isochempot diff --git a/src/vacancyflux_isoconc.f90 b/src/vacancyflux_isoconc.f90 deleted file mode 100644 index 135509aa1..000000000 --- a/src/vacancyflux_isoconc.f90 +++ /dev/null @@ -1,62 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for constant vacancy concentration -!-------------------------------------------------------------------------------------------------- -module vacancyflux_isoconc - - implicit none - private - - public :: & - vacancyflux_isoconc_init - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields, reads information from material configuration file -!-------------------------------------------------------------------------------------------------- -subroutine vacancyflux_isoconc_init() -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use prec, only: & - pReal, & - pInt - use IO, only: & - IO_timeStamp - use material - use config - - implicit none - integer(pInt) :: & - homog, & - NofMyHomog - - write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_isoconc_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - initializeInstances: do homog = 1_pInt, material_Nhomogenization - - myhomog: if (vacancyflux_type(homog) == VACANCYFLUX_isoconc_ID) then - NofMyHomog = count(material_homog == homog) - vacancyfluxState(homog)%sizeState = 0_pInt - vacancyfluxState(homog)%sizePostResults = 0_pInt - allocate(vacancyfluxState(homog)%state0 (0_pInt,NofMyHomog)) - allocate(vacancyfluxState(homog)%subState0(0_pInt,NofMyHomog)) - allocate(vacancyfluxState(homog)%state (0_pInt,NofMyHomog)) - - deallocate(vacancyConc (homog)%p) - allocate (vacancyConc (homog)%p(1), source=vacancyflux_initialCv(homog)) - deallocate(vacancyConcRate(homog)%p) - allocate (vacancyConcRate(homog)%p(1), source=0.0_pReal) - - endif myhomog - enddo initializeInstances - - -end subroutine vacancyflux_isoconc_init - -end module vacancyflux_isoconc