Merge branch 'MoreImprovements' into PGI-support
This commit is contained in:
Martin Diehl
commit
a025edd09f
|
|
@ -117,9 +117,7 @@ elseif (DAMASK_SOLVER STREQUAL "fem" OR DAMASK_SOLVER STREQUAL "mesh")
|
|||
else ()
|
||||
message (FATAL_ERROR "Build target (DAMASK_SOLVER) is not defined")
|
||||
endif ()
|
||||
|
||||
# set linker commands (needs to be done after defining the project)
|
||||
set (CMAKE_LINKER "${PETSC_LINKER}")
|
||||
list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake)
|
||||
|
||||
if (CMAKE_BUILD_TYPE STREQUAL "")
|
||||
set (CMAKE_BUILD_TYPE "RELEASE")
|
||||
|
|
@ -168,9 +166,6 @@ add_definitions (-DDAMASKVERSION="${DAMASK_V}")
|
|||
# definition of other macros
|
||||
add_definitions (-DPETSc)
|
||||
|
||||
set (DAMASK_INCLUDE_FLAGS "${DAMASK_INCLUDE_FLAGS} ${PETSC_INCLUDES}")
|
||||
list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake)
|
||||
|
||||
if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel")
|
||||
include(Compiler-Intel)
|
||||
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
|
||||
|
|
@ -183,14 +178,14 @@ endif ()
|
|||
|
||||
|
||||
set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${BUILDCMD_PRE} ${OPENMP_FLAGS} ${STANDARD_CHECK} ${OPTIMIZATION_FLAGS} ${COMPILE_FLAGS} ${PRECISION_FLAGS}")
|
||||
set (CMAKE_Fortran_LINK_EXECUTABLE "${BUILDCMD_PRE} ${CMAKE_LINKER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}")
|
||||
set (CMAKE_Fortran_LINK_EXECUTABLE "${BUILDCMD_PRE} ${PETSC_LINKER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}")
|
||||
|
||||
if (CMAKE_BUILD_TYPE STREQUAL "DEBUG")
|
||||
set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${DEBUG_FLAGS}")
|
||||
set (CMAKE_Fortran_LINK_EXECUTABLE "${CMAKE_Fortran_LINK_EXECUTABLE} ${DEBUG_FLAGS}")
|
||||
endif ()
|
||||
|
||||
set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${DAMASK_INCLUDE_FLAGS} ${BUILDCMD_POST}")
|
||||
set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${PETSC_INCLUDES} ${BUILDCMD_POST}")
|
||||
set (CMAKE_Fortran_LINK_EXECUTABLE "${CMAKE_Fortran_LINK_EXECUTABLE} <OBJECTS> -o <TARGET> <LINK_LIBRARIES> ${PETSC_EXTERNAL_LIB} ${BUILDCMD_POST}")
|
||||
|
||||
message ("Fortran Compiler Flags:\n${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}}\n")
|
||||
|
|
|
|||
2
PRIVATE
2
PRIVATE
|
|
@ -1 +1 @@
|
|||
Subproject commit cda69f9a59fe64223439a2c725e1a78cf22b28aa
|
||||
Subproject commit 99b076706a186ec7deb051ae181c2d9697c799fc
|
||||
|
|
@ -9,14 +9,6 @@ cd DAMASK_ROOT
|
|||
patch -p1 < installation/patch/nameOfPatch
|
||||
```
|
||||
|
||||
## Available patches
|
||||
|
||||
* **disable_HDF5** disables all HDF5 output.
|
||||
HDF5 output is an experimental feature. Also, some routines not present in HDF5 1.8.x are removed to allow compilation of DAMASK with HDF5 < 1.10.x
|
||||
|
||||
* **disable_old_output** disables all non-HDF5 output.
|
||||
Saves some memory when using only HDF5 output
|
||||
|
||||
## Create patch
|
||||
commit your changes
|
||||
|
||||
|
|
|
|||
|
|
@ -182,8 +182,8 @@ for name in filenames:
|
|||
nodes = damask.grid_filters.node_coord(size,F)
|
||||
|
||||
if options.shape:
|
||||
centres = damask.grid_filters.cell_coord(size,F)
|
||||
shapeMismatch = shapeMismatch( size,table.get(options.defgrad).reshape(grid[2],grid[1],grid[0],3,3),nodes,centres)
|
||||
centers = damask.grid_filters.cell_coord(size,F)
|
||||
shapeMismatch = shapeMismatch( size,table.get(options.defgrad).reshape(grid[2],grid[1],grid[0],3,3),nodes,centers)
|
||||
table.add('shapeMismatch(({}))'.format(options.defgrad),
|
||||
shapeMismatch.reshape((-1,1)),
|
||||
scriptID+' '+' '.join(sys.argv[1:]))
|
||||
|
|
|
|||
|
|
@ -2,10 +2,9 @@
|
|||
|
||||
import os
|
||||
import sys
|
||||
from io import StringIO
|
||||
from optparse import OptionParser
|
||||
|
||||
import numpy as np
|
||||
|
||||
import damask
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
import os
|
||||
import sys
|
||||
from io import StringIO
|
||||
from optparse import OptionParser
|
||||
|
||||
import damask
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
import os
|
||||
import sys
|
||||
from io import StringIO
|
||||
from optparse import OptionParser
|
||||
|
||||
import numpy as np
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
import os
|
||||
import sys
|
||||
from io import StringIO
|
||||
from optparse import OptionParser
|
||||
|
||||
from scipy import ndimage
|
||||
|
|
|
|||
|
|
@ -2,10 +2,9 @@
|
|||
|
||||
import os
|
||||
import sys
|
||||
from io import StringIO
|
||||
from optparse import OptionParser
|
||||
|
||||
import numpy as np
|
||||
|
||||
import damask
|
||||
|
||||
scriptName = os.path.splitext(os.path.basename(__file__))[0]
|
||||
|
|
|
|||
|
|
@ -328,9 +328,9 @@ class Color():
|
|||
Msh = np.zeros(3,'d')
|
||||
Msh[0] = np.sqrt(np.dot(self.color,self.color))
|
||||
if (Msh[0] > 0.001):
|
||||
Msh[1] = np.acos(self.color[0]/Msh[0])
|
||||
Msh[1] = np.arccos(self.color[0]/Msh[0])
|
||||
if (self.color[1] != 0.0):
|
||||
Msh[2] = np.atan2(self.color[2],self.color[1])
|
||||
Msh[2] = np.arctan2(self.color[2],self.color[1])
|
||||
|
||||
converted = Color('MSH', Msh)
|
||||
self.model = converted.model
|
||||
|
|
|
|||
|
|
@ -880,7 +880,7 @@ class DADF5():
|
|||
else:
|
||||
|
||||
nodes = vtk.vtkPoints()
|
||||
with h5py.File(self.fname) as f:
|
||||
with h5py.File(self.fname,'r') as f:
|
||||
nodes.SetData(numpy_support.numpy_to_vtk(f['/geometry/x_n'][()],deep=True))
|
||||
|
||||
vtk_geom = vtk.vtkUnstructuredGrid()
|
||||
|
|
|
|||
|
|
@ -170,9 +170,18 @@ class Rotation:
|
|||
################################################################################################
|
||||
# convert to different orientation representations (numpy arrays)
|
||||
|
||||
def asQuaternion(self):
|
||||
"""Unit quaternion: (q, p_1, p_2, p_3)."""
|
||||
return self.quaternion.asArray()
|
||||
def asQuaternion(self,
|
||||
quaternion = False):
|
||||
"""
|
||||
Unit quaternion [q, p_1, p_2, p_3] unless quaternion == True: damask.quaternion object.
|
||||
|
||||
Parameters
|
||||
----------
|
||||
quaternion : bool, optional
|
||||
return quaternion as DAMASK object.
|
||||
|
||||
"""
|
||||
return self.quaternion if quaternion else self.quaternion.asArray()
|
||||
|
||||
def asEulers(self,
|
||||
degrees = False):
|
||||
|
|
@ -190,33 +199,36 @@ class Rotation:
|
|||
return eu
|
||||
|
||||
def asAxisAngle(self,
|
||||
degrees = False):
|
||||
degrees = False,
|
||||
pair = False):
|
||||
"""
|
||||
Axis angle pair: ([n_1, n_2, n_3], ω).
|
||||
Axis angle representation [n_1, n_2, n_3, ω] unless pair == True: ([n_1, n_2, n_3], ω).
|
||||
|
||||
Parameters
|
||||
----------
|
||||
degrees : bool, optional
|
||||
return rotation angle in degrees.
|
||||
pair : bool, optional
|
||||
return tuple of axis and angle.
|
||||
|
||||
"""
|
||||
ax = qu2ax(self.quaternion.asArray())
|
||||
if degrees: ax[3] = np.degrees(ax[3])
|
||||
return ax
|
||||
return (ax[:3],np.degrees(ax[3])) if pair else ax
|
||||
|
||||
def asMatrix(self):
|
||||
"""Rotation matrix."""
|
||||
return qu2om(self.quaternion.asArray())
|
||||
|
||||
def asRodrigues(self,
|
||||
vector=False):
|
||||
vector = False):
|
||||
"""
|
||||
Rodrigues-Frank vector: ([n_1, n_2, n_3], tan(ω/2)).
|
||||
Rodrigues-Frank vector representation [n_1, n_2, n_3, tan(ω/2)] unless vector == True: [n_1, n_2, n_3] * tan(ω/2).
|
||||
|
||||
Parameters
|
||||
----------
|
||||
vector : bool, optional
|
||||
return as array of length 3, i.e. scale the unit vector giving the rotation axis.
|
||||
return as actual Rodrigues--Frank vector, i.e. rotation axis scaled by tan(ω/2).
|
||||
|
||||
"""
|
||||
ro = qu2ro(self.quaternion.asArray())
|
||||
|
|
@ -252,8 +264,8 @@ class Rotation:
|
|||
acceptHomomorph = False,
|
||||
P = -1):
|
||||
|
||||
qu = quaternion if isinstance(quaternion, np.ndarray) and quaternion.dtype == np.dtype(float) \
|
||||
else np.array(quaternion,dtype=float)
|
||||
qu = quaternion if isinstance(quaternion, np.ndarray) and quaternion.dtype == np.dtype(float) \
|
||||
else np.array(quaternion,dtype=float)
|
||||
if P > 0: qu[1:4] *= -1 # convert from P=1 to P=-1
|
||||
if qu[0] < 0.0:
|
||||
if acceptHomomorph:
|
||||
|
|
@ -1193,9 +1205,9 @@ class Orientation:
|
|||
ref = orientations[0]
|
||||
for o in orientations:
|
||||
closest.append(o.equivalentOrientations(
|
||||
ref.disorientation(o,
|
||||
SST = False, # select (o[ther]'s) sym orientation
|
||||
symmetries = True)[2]).rotation) # with lowest misorientation
|
||||
ref.disorientation(o,
|
||||
SST = False, # select (o[ther]'s) sym orientation
|
||||
symmetries = True)[2]).rotation) # with lowest misorientation
|
||||
|
||||
return Orientation(Rotation.fromAverage(closest,weights),ref.lattice)
|
||||
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ class Table():
|
|||
Additional, human-readable information.
|
||||
|
||||
"""
|
||||
self.comments = ['table.py v {}'.format(version)] if not comments else [c for c in comments]
|
||||
self.comments = [] if comments is None else [c for c in comments]
|
||||
self.data = pd.DataFrame(data=data)
|
||||
self.shapes = shapes
|
||||
self.__label_condensed()
|
||||
|
|
@ -77,10 +77,9 @@ class Table():
|
|||
if keyword == 'header':
|
||||
header = int(header)
|
||||
else:
|
||||
raise Exception
|
||||
|
||||
comments = ['table.py:from_ASCII v {}'.format(version)]
|
||||
comments+= [f.readline()[:-1] for i in range(1,header)]
|
||||
raise TypeError
|
||||
|
||||
comments = [f.readline()[:-1] for i in range(1,header)]
|
||||
labels = f.readline().split()
|
||||
|
||||
shapes = {}
|
||||
|
|
@ -138,9 +137,12 @@ class Table():
|
|||
break
|
||||
|
||||
data = np.loadtxt(content)
|
||||
for c in range(data.shape[1]-10):
|
||||
shapes['n/a_{}'.format(c+1)] = (1,)
|
||||
|
||||
return Table(data,shapes,comments)
|
||||
|
||||
|
||||
@property
|
||||
def labels(self):
|
||||
return list(self.shapes.keys())
|
||||
|
|
@ -271,7 +273,9 @@ class Table():
|
|||
|
||||
def append(self,other):
|
||||
"""
|
||||
Append other table vertically (similar to numpy.vstack). Requires matching shapes and order.
|
||||
Append other table vertically (similar to numpy.vstack).
|
||||
|
||||
Requires matching labels/shapes and order.
|
||||
|
||||
Parameters
|
||||
----------
|
||||
|
|
@ -287,8 +291,9 @@ class Table():
|
|||
|
||||
def join(self,other):
|
||||
"""
|
||||
Append other table horizontally (similar to numpy.hstack). Requires matching number of rows
|
||||
and no common lables
|
||||
Append other table horizontally (similar to numpy.hstack).
|
||||
|
||||
Requires matching number of rows and no common labels.
|
||||
|
||||
Parameters
|
||||
----------
|
||||
|
|
|
|||
|
|
@ -113,7 +113,7 @@ class TestMechanics:
|
|||
|
||||
def test_strain_tensor_rotation_equivalence(self):
|
||||
"""Ensure that left and right strain differ only by a rotation."""
|
||||
F = np.random.random((self.n,3,3))
|
||||
F = np.broadcast_to(np.eye(3),[self.n,3,3]) + (np.random.random((self.n,3,3))*0.5 - 0.25)
|
||||
m = np.random.random()*5.0-2.5
|
||||
assert np.allclose(np.linalg.det(mechanics.strain_tensor(F,'U',m)),
|
||||
np.linalg.det(mechanics.strain_tensor(F,'V',m)))
|
||||
|
|
|
|||
|
|
@ -377,7 +377,7 @@ subroutine CPFEM_results(inc,time)
|
|||
call constitutive_results
|
||||
call crystallite_results
|
||||
call homogenization_results
|
||||
call results_removeLink('current') ! ToDo: put this into closeJobFile
|
||||
call results_finalizeIncrement
|
||||
call results_closeJobFile
|
||||
|
||||
end subroutine CPFEM_results
|
||||
|
|
|
|||
|
|
@ -201,7 +201,7 @@ subroutine CPFEM_results(inc,time)
|
|||
call crystallite_results
|
||||
call homogenization_results
|
||||
call discretization_results
|
||||
call results_removeLink('current') ! ToDo: put this into closeJobFile?
|
||||
call results_finalizeIncrement
|
||||
call results_closeJobFile
|
||||
|
||||
end subroutine CPFEM_results
|
||||
|
|
|
|||
|
|
@ -269,10 +269,10 @@ subroutine DAMASK_interface_init
|
|||
write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg)
|
||||
write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg)
|
||||
write(6,'(a,a)') ' Load case argument: ', trim(loadcaseArg)
|
||||
write(6,'(a,a)') ' Working directory: ', trim(getCWD())
|
||||
write(6,'(a,a)') ' Working directory: ', getCWD()
|
||||
write(6,'(a,a)') ' Geometry file: ', trim(geometryFile)
|
||||
write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile)
|
||||
write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName())
|
||||
write(6,'(a,a)') ' Solver job name: ', getSolverJobName()
|
||||
if (interface_restartInc > 0) &
|
||||
write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc
|
||||
|
||||
|
|
@ -308,7 +308,7 @@ subroutine setWorkingDirectory(workingDirectoryArg)
|
|||
workingDirectory = trim(rectifyPath(workingDirectory))
|
||||
error = setCWD(trim(workingDirectory))
|
||||
if(error) then
|
||||
write(6,'(/,a)') ' ERROR: Working directory "'//trim(workingDirectory)//'" does not exist'
|
||||
write(6,'(/,a)') ' ERROR: Invalid Working directory: '//trim(workingDirectory)
|
||||
call quit(1)
|
||||
endif
|
||||
|
||||
|
|
@ -318,8 +318,9 @@ end subroutine setWorkingDirectory
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief solver job name (no extension) as combination of geometry and load case name
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
character(len=1024) function getSolverJobName()
|
||||
function getSolverJobName()
|
||||
|
||||
character(len=:), allocatable :: getSolverJobName
|
||||
integer :: posExt,posSep
|
||||
|
||||
posExt = scan(geometryFile,'.',back=.true.)
|
||||
|
|
@ -330,7 +331,7 @@ character(len=1024) function getSolverJobName()
|
|||
posExt = scan(loadCaseFile,'.',back=.true.)
|
||||
posSep = scan(loadCaseFile,'/',back=.true.)
|
||||
|
||||
getSolverJobName = trim(getSolverJobName)//'_'//loadCaseFile(posSep+1:posExt-1)
|
||||
getSolverJobName = getSolverJobName//'_'//loadCaseFile(posSep+1:posExt-1)
|
||||
|
||||
end function getSolverJobName
|
||||
|
||||
|
|
@ -338,15 +339,16 @@ end function getSolverJobName
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief basename of geometry file with extension from command line arguments
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
character(len=1024) function getGeometryFile(geometryParameter)
|
||||
function getGeometryFile(geometryParameter)
|
||||
|
||||
character(len=1024), intent(in) :: geometryParameter
|
||||
logical :: file_exists
|
||||
external :: quit
|
||||
character(len=:), allocatable :: getGeometryFile
|
||||
character(len=*), intent(in) :: geometryParameter
|
||||
logical :: file_exists
|
||||
external :: quit
|
||||
|
||||
getGeometryFile = trim(geometryParameter)
|
||||
if (scan(getGeometryFile,'/') /= 1) getGeometryFile = trim(getCWD())//'/'//trim(getGeometryFile)
|
||||
getGeometryFile = makeRelativePath(trim(getCWD()), getGeometryFile)
|
||||
if (scan(getGeometryFile,'/') /= 1) getGeometryFile = getCWD()//'/'//trim(getGeometryFile)
|
||||
getGeometryFile = makeRelativePath(getCWD(), getGeometryFile)
|
||||
|
||||
inquire(file=trim(getGeometryFile), exist=file_exists)
|
||||
if (.not. file_exists) then
|
||||
|
|
@ -360,15 +362,16 @@ end function getGeometryFile
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief relative path of loadcase from command line arguments
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
character(len=1024) function getLoadCaseFile(loadCaseParameter)
|
||||
function getLoadCaseFile(loadCaseParameter)
|
||||
|
||||
character(len=1024), intent(in) :: loadCaseParameter
|
||||
logical :: file_exists
|
||||
external :: quit
|
||||
character(len=:), allocatable :: getLoadCaseFile
|
||||
character(len=*), intent(in) :: loadCaseParameter
|
||||
logical :: file_exists
|
||||
external :: quit
|
||||
|
||||
getLoadCaseFile = trim(loadCaseParameter)
|
||||
if (scan(getLoadCaseFile,'/') /= 1) getLoadCaseFile = trim(getCWD())//'/'//trim(getLoadCaseFile)
|
||||
getLoadCaseFile = makeRelativePath(trim(getCWD()), getLoadCaseFile)
|
||||
if (scan(getLoadCaseFile,'/') /= 1) getLoadCaseFile = getCWD()//'/'//trim(getLoadCaseFile)
|
||||
getLoadCaseFile = makeRelativePath(getCWD(), getLoadCaseFile)
|
||||
|
||||
inquire(file=trim(getLoadCaseFile), exist=file_exists)
|
||||
if (.not. file_exists) then
|
||||
|
|
|
|||
|
|
@ -46,10 +46,10 @@ subroutine FE_init
|
|||
call IO_open_inputFile(FILEUNIT)
|
||||
rewind(FILEUNIT)
|
||||
do
|
||||
read (FILEUNIT,'(a256)',END=100) line
|
||||
read (FILEUNIT,'(A)',END=100) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
if(IO_lc(IO_stringValue(line,chunkPos,1)) == 'solver') then
|
||||
read (FILEUNIT,'(a256)',END=100) line ! next line
|
||||
read (FILEUNIT,'(A)',END=100) line ! next line
|
||||
chunkPos = IO_stringPos(line)
|
||||
symmetricSolver = (IO_intValue(line,chunkPos,2) /= 1)
|
||||
endif
|
||||
|
|
|
|||
76
src/IO.f90
76
src/IO.f90
|
|
@ -23,7 +23,7 @@ module IO
|
|||
public :: &
|
||||
IO_init, &
|
||||
IO_read_ASCII, &
|
||||
IO_open_file, &
|
||||
IO_open_file, & ! deprecated, use IO_read_ASCII
|
||||
IO_open_jobFile_binary, &
|
||||
IO_isBlank, &
|
||||
IO_getTag, &
|
||||
|
|
@ -44,8 +44,7 @@ module IO
|
|||
IO_countDataLines
|
||||
#elif defined(Marc4DAMASK)
|
||||
IO_fixedNoEFloatValue, &
|
||||
IO_fixedIntValue, &
|
||||
IO_countNumericalDataLines
|
||||
IO_fixedIntValue
|
||||
#endif
|
||||
#endif
|
||||
|
||||
|
|
@ -245,7 +244,7 @@ subroutine IO_open_inputFile(fileUnit)
|
|||
|
||||
|
||||
do
|
||||
read(unit2,'(A256)',END=220) line
|
||||
read(unit2,'(A)',END=220) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
|
||||
if (IO_lc(IO_StringValue(line,chunkPos,1))=='*include') then
|
||||
|
|
@ -384,7 +383,7 @@ function IO_stringValue(string,chunkPos,myChunk,silent)
|
|||
logical :: warn
|
||||
|
||||
if (present(silent)) then
|
||||
warn = silent
|
||||
warn = .not. silent
|
||||
else
|
||||
warn = .false.
|
||||
endif
|
||||
|
|
@ -414,11 +413,10 @@ real(pReal) function IO_floatValue (string,chunkPos,myChunk)
|
|||
|
||||
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1) then
|
||||
call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string))
|
||||
else valuePresent
|
||||
IO_floatValue = &
|
||||
verifyFloatValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),&
|
||||
VALIDCHARACTERS,MYNAME)
|
||||
endif valuePresent
|
||||
else valuePresent
|
||||
IO_floatValue = verifyFloatValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),&
|
||||
VALIDCHARACTERS,MYNAME)
|
||||
endif valuePresent
|
||||
|
||||
end function IO_floatValue
|
||||
|
||||
|
|
@ -466,12 +464,12 @@ real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk)
|
|||
pos_exp = scan(string(ends(myChunk)+1:ends(myChunk+1)),'+-',back=.true.)
|
||||
hasExponent: if (pos_exp > 1) then
|
||||
base = verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk)+pos_exp-1))),&
|
||||
VALIDBASE,MYNAME//'(base): ')
|
||||
VALIDBASE,MYNAME//'(base): ')
|
||||
expon = verifyIntValue(trim(adjustl(string(ends(myChunk)+pos_exp:ends(myChunk+1)))),&
|
||||
VALIDEXP,MYNAME//'(exp): ')
|
||||
VALIDEXP,MYNAME//'(exp): ')
|
||||
else hasExponent
|
||||
base = verifyFloatValue(trim(adjustl(string(ends(myChunk)+1:ends(myChunk+1)))),&
|
||||
VALIDBASE,MYNAME//'(base): ')
|
||||
VALIDBASE,MYNAME//'(base): ')
|
||||
expon = 0
|
||||
endif hasExponent
|
||||
IO_fixedNoEFloatValue = base*10.0_pReal**real(expon,pReal)
|
||||
|
|
@ -530,8 +528,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
|
|||
character(len=*), optional, intent(in) :: ext_msg
|
||||
|
||||
external :: quit
|
||||
character(len=1024) :: msg
|
||||
character(len=1024) :: formatString
|
||||
character(len=pStringLen) :: msg
|
||||
character(len=pStringLen) :: formatString
|
||||
|
||||
select case (error_ID)
|
||||
|
||||
|
|
@ -550,14 +548,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
|
|||
msg = 'could not read file:'
|
||||
case (103)
|
||||
msg = 'could not assemble input files'
|
||||
case (104)
|
||||
msg = '{input} recursion limit reached'
|
||||
case (105)
|
||||
msg = 'unknown output:'
|
||||
case (106)
|
||||
msg = 'working directory does not exist:'
|
||||
case (107)
|
||||
msg = 'line length exceeds limit of 256'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! lattice error messages
|
||||
|
|
@ -777,8 +769,8 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg)
|
|||
integer, optional, intent(in) :: el,ip,g
|
||||
character(len=*), optional, intent(in) :: ext_msg
|
||||
|
||||
character(len=1024) :: msg
|
||||
character(len=1024) :: formatString
|
||||
character(len=pStringLen) :: msg
|
||||
character(len=pStringLen) :: formatString
|
||||
|
||||
select case (warning_ID)
|
||||
case (1)
|
||||
|
|
@ -924,38 +916,6 @@ end function IO_countDataLines
|
|||
#endif
|
||||
|
||||
|
||||
#ifdef Marc4DAMASK
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief count lines containig data up to next *keyword
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
integer function IO_countNumericalDataLines(fileUnit)
|
||||
|
||||
integer, intent(in) :: fileUnit !< file handle
|
||||
|
||||
|
||||
integer, allocatable, dimension(:) :: chunkPos
|
||||
character(len=pStringLen) :: line, &
|
||||
tmp
|
||||
|
||||
IO_countNumericalDataLines = 0
|
||||
line = ''
|
||||
|
||||
do while (trim(line) /= IO_EOF)
|
||||
line = IO_read(fileUnit)
|
||||
chunkPos = IO_stringPos(line)
|
||||
tmp = IO_lc(IO_stringValue(line,chunkPos,1))
|
||||
if (verify(trim(tmp),'0123456789') == 0) then ! numerical values
|
||||
IO_countNumericalDataLines = IO_countNumericalDataLines + 1
|
||||
else
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
backspace(fileUnit)
|
||||
|
||||
end function IO_countNumericalDataLines
|
||||
#endif
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief count items in consecutive lines depending on lines
|
||||
!> @details Marc: ints concatenated by "c" as last char or range of values a "to" b
|
||||
|
|
@ -1040,7 +1000,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN)
|
|||
|
||||
#if defined(Marc4DAMASK)
|
||||
do
|
||||
read(fileUnit,'(A256)',end=100) line
|
||||
read(fileUnit,'(A)',end=100) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
if (chunkPos(1) < 1) then ! empty line
|
||||
exit
|
||||
|
|
@ -1081,14 +1041,14 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN)
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! check if the element values in the elset are auto generated
|
||||
backspace(fileUnit)
|
||||
read(fileUnit,'(A256)',end=100) line
|
||||
read(fileUnit,'(A)',end=100) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
do i = 1,chunkPos(1)
|
||||
if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true.
|
||||
enddo
|
||||
|
||||
do l = 1,c
|
||||
read(fileUnit,'(A256)',end=100) line
|
||||
read(fileUnit,'(A)',end=100) line
|
||||
chunkPos = IO_stringPos(line)
|
||||
if (verify(IO_stringValue(line,chunkPos,1),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line
|
||||
do i = 1,chunkPos(1) ! loop over set names in line
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ module element
|
|||
integer, parameter, private :: &
|
||||
NELEMTYPE = 13
|
||||
|
||||
integer, dimension(NelemType), parameter, private :: NNODE = &
|
||||
integer, dimension(NELEMTYPE), parameter, private :: NNODE = &
|
||||
[ &
|
||||
3, & ! 2D 3node 1ip
|
||||
6, & ! 2D 6node 3ip
|
||||
|
|
@ -57,7 +57,7 @@ module element
|
|||
20 & ! 3D 20node 27ip
|
||||
] !< number of nodes that constitute a specific type of element
|
||||
|
||||
integer, dimension(NelemType), parameter, public :: GEOMTYPE = &
|
||||
integer, dimension(NELEMTYPE), parameter, public :: GEOMTYPE = &
|
||||
[ &
|
||||
1, &
|
||||
2, &
|
||||
|
|
@ -74,8 +74,7 @@ module element
|
|||
10 &
|
||||
] !< geometry type of particular element type
|
||||
|
||||
!integer, dimension(maxval(geomType)), parameter, private :: NCELLNODE = & ! Intel 16.0 complains
|
||||
integer, dimension(10), parameter, private :: NCELLNODE = &
|
||||
integer, dimension(maxval(GEOMTYPE)), parameter, private :: NCELLNODE = &
|
||||
[ &
|
||||
3, &
|
||||
7, &
|
||||
|
|
@ -89,8 +88,7 @@ module element
|
|||
64 &
|
||||
] !< number of cell nodes in a specific geometry type
|
||||
|
||||
!integer, dimension(maxval(geomType)), parameter, private :: NIP = & ! Intel 16.0 complains
|
||||
integer, dimension(10), parameter, private :: NIP = &
|
||||
integer, dimension(maxval(GEOMTYPE)), parameter, private :: NIP = &
|
||||
[ &
|
||||
1, &
|
||||
3, &
|
||||
|
|
@ -104,8 +102,7 @@ module element
|
|||
27 &
|
||||
] !< number of IPs in a specific geometry type
|
||||
|
||||
!integer, dimension(maxval(geomType)), parameter, private :: CELLTYPE = & ! Intel 16.0 complains
|
||||
integer, dimension(10), parameter, private :: CELLTYPE = &
|
||||
integer, dimension(maxval(GEOMTYPE)), parameter, private :: CELLTYPE = &
|
||||
[ &
|
||||
1, & ! 2D 3node
|
||||
2, & ! 2D 4node
|
||||
|
|
@ -119,8 +116,7 @@ module element
|
|||
4 & ! 3D 8node
|
||||
] !< cell type that is used by each geometry type
|
||||
|
||||
!integer, dimension(maxval(cellType)), parameter, private :: nIPNeighbor = & ! Intel 16.0 complains
|
||||
integer, dimension(4), parameter, private :: NIPNEIGHBOR = &
|
||||
integer, dimension(maxval(CELLTYPE)), parameter, private :: NIPNEIGHBOR = &
|
||||
[ &
|
||||
3, & ! 2D 3node
|
||||
4, & ! 2D 4node
|
||||
|
|
@ -128,8 +124,7 @@ module element
|
|||
6 & ! 3D 8node
|
||||
] !< number of ip neighbors / cell faces in a specific cell type
|
||||
|
||||
!integer, dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = & ! Intel 16.0 complains
|
||||
integer, dimension(4), parameter, private :: NCELLNODEPERCELLFACE = &
|
||||
integer, dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELLFACE = &
|
||||
[ &
|
||||
2, & ! 2D 3node
|
||||
2, & ! 2D 4node
|
||||
|
|
@ -137,8 +132,7 @@ module element
|
|||
4 & ! 3D 8node
|
||||
] !< number of cell nodes in a specific cell type
|
||||
|
||||
!integer, dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELL = & ! Intel 16.0 complains
|
||||
integer, dimension(4), parameter, private :: NCELLNODEPERCELL = &
|
||||
integer, dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELL = &
|
||||
[ &
|
||||
3, & ! 2D 3node
|
||||
4, & ! 2D 4node
|
||||
|
|
|
|||
|
|
@ -54,7 +54,7 @@ contains
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_damage_spectral_init
|
||||
|
||||
PetscInt, dimension(worldsize) :: localK
|
||||
PetscInt, dimension(0:worldsize-1) :: localK
|
||||
integer :: i, j, k, cell
|
||||
DM :: damage_grid
|
||||
Vec :: uBound, lBound
|
||||
|
|
@ -78,8 +78,8 @@ subroutine grid_damage_spectral_init
|
|||
! initialize solver specific parts of PETSc
|
||||
call SNESCreate(PETSC_COMM_WORLD,damage_snes,ierr); CHKERRQ(ierr)
|
||||
call SNESSetOptionsPrefix(damage_snes,'damage_',ierr);CHKERRQ(ierr)
|
||||
localK = 0
|
||||
localK(worldrank+1) = grid3
|
||||
localK = 0
|
||||
localK(worldrank) = grid3
|
||||
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
call DMDACreate3D(PETSC_COMM_WORLD, &
|
||||
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ module grid_mech_FEM
|
|||
F_aim_lastInc = math_I3, & !< previous average deformation gradient
|
||||
P_av = 0.0_pReal !< average 1st Piola--Kirchhoff stress
|
||||
|
||||
character(len=1024), private :: incInfo !< time and increment information
|
||||
character(len=pStringLen), private :: incInfo !< time and increment information
|
||||
|
||||
real(pReal), private, dimension(3,3,3,3) :: &
|
||||
C_volAvg = 0.0_pReal, & !< current volume average stiffness
|
||||
|
|
@ -81,7 +81,7 @@ contains
|
|||
subroutine grid_mech_FEM_init
|
||||
|
||||
real(pReal) :: HGCoeff = 0.0e-2_pReal
|
||||
PetscInt, dimension(worldsize) :: localK
|
||||
PetscInt, dimension(0:worldsize-1) :: localK
|
||||
real(pReal), dimension(3,3) :: &
|
||||
temp33_Real = 0.0_pReal
|
||||
real(pReal), dimension(4,8) :: &
|
||||
|
|
@ -94,7 +94,6 @@ subroutine grid_mech_FEM_init
|
|||
1.0_pReal,-1.0_pReal,-1.0_pReal,-1.0_pReal, &
|
||||
1.0_pReal, 1.0_pReal, 1.0_pReal, 1.0_pReal], [4,8])
|
||||
PetscErrorCode :: ierr
|
||||
integer :: rank
|
||||
integer(HID_T) :: fileHandle, groupHandle
|
||||
character(len=pStringLen) :: fileName
|
||||
real(pReal), dimension(3,3,3,3) :: devNull
|
||||
|
|
@ -121,8 +120,8 @@ subroutine grid_mech_FEM_init
|
|||
! initialize solver specific parts of PETSc
|
||||
call SNESCreate(PETSC_COMM_WORLD,mech_snes,ierr); CHKERRQ(ierr)
|
||||
call SNESSetOptionsPrefix(mech_snes,'mech_',ierr);CHKERRQ(ierr)
|
||||
localK = 0
|
||||
localK(worldrank+1) = grid3
|
||||
localK = 0
|
||||
localK(worldrank) = grid3
|
||||
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
call DMDACreate3d(PETSC_COMM_WORLD, &
|
||||
DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, &
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ module grid_mech_spectral_basic
|
|||
F_aim_lastInc = math_I3, & !< previous average deformation gradient
|
||||
P_av = 0.0_pReal !< average 1st Piola--Kirchhoff stress
|
||||
|
||||
character(len=1024), private :: incInfo !< time and increment information
|
||||
character(len=pStringLen), private :: incInfo !< time and increment information
|
||||
real(pReal), private, dimension(3,3,3,3) :: &
|
||||
C_volAvg = 0.0_pReal, & !< current volume average stiffness
|
||||
C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness
|
||||
|
|
|
|||
|
|
@ -59,7 +59,7 @@ module grid_mech_spectral_polarisation
|
|||
F_av = 0.0_pReal, & !< average incompatible def grad field
|
||||
P_av = 0.0_pReal !< average 1st Piola--Kirchhoff stress
|
||||
|
||||
character(len=1024), private :: incInfo !< time and increment information
|
||||
character(len=pStringLen), private :: incInfo !< time and increment information
|
||||
real(pReal), private, dimension(3,3,3,3) :: &
|
||||
C_volAvg = 0.0_pReal, & !< current volume average stiffness
|
||||
C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness
|
||||
|
|
@ -100,7 +100,7 @@ subroutine grid_mech_spectral_polarisation_init
|
|||
FandF_tau, & ! overall pointer to solution data
|
||||
F, & ! specific (sub)pointer
|
||||
F_tau ! specific (sub)pointer
|
||||
PetscInt, dimension(worldsize) :: localK
|
||||
PetscInt, dimension(0:worldsize-1) :: localK
|
||||
integer(HID_T) :: fileHandle, groupHandle
|
||||
integer :: fileUnit
|
||||
character(len=pStringLen) :: fileName
|
||||
|
|
@ -130,8 +130,8 @@ subroutine grid_mech_spectral_polarisation_init
|
|||
! initialize solver specific parts of PETSc
|
||||
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
|
||||
call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr)
|
||||
localK = 0
|
||||
localK(worldrank+1) = grid3
|
||||
localK = 0
|
||||
localK(worldrank) = grid3
|
||||
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
call DMDACreate3d(PETSC_COMM_WORLD, &
|
||||
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ contains
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine grid_thermal_spectral_init
|
||||
|
||||
PetscInt, dimension(worldsize) :: localK
|
||||
PetscInt, dimension(0:worldsize-1) :: localK
|
||||
integer :: i, j, k, cell
|
||||
DM :: thermal_grid
|
||||
PetscScalar, dimension(:,:,:), pointer :: x_scal
|
||||
|
|
@ -77,8 +77,8 @@ subroutine grid_thermal_spectral_init
|
|||
! initialize solver specific parts of PETSc
|
||||
call SNESCreate(PETSC_COMM_WORLD,thermal_snes,ierr); CHKERRQ(ierr)
|
||||
call SNESSetOptionsPrefix(thermal_snes,'thermal_',ierr);CHKERRQ(ierr)
|
||||
localK = 0
|
||||
localK(worldrank+1) = grid3
|
||||
localK = 0
|
||||
localK(worldrank) = grid3
|
||||
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
call DMDACreate3D(PETSC_COMM_WORLD, &
|
||||
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
|
||||
|
|
|
|||
|
|
@ -700,7 +700,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
|
|||
c_reduced, & !< reduced stiffness (depending on number of stress BC)
|
||||
sTimesC !< temp variable to check inversion
|
||||
logical :: errmatinv
|
||||
character(len=1024):: formatString
|
||||
character(len=pStringLen):: formatString
|
||||
|
||||
mask_stressVector = reshape(transpose(mask_stress), [9])
|
||||
size_reduced = count(mask_stressVector)
|
||||
|
|
|
|||
|
|
@ -65,7 +65,7 @@ subroutine kinematics_cleavage_opening_init
|
|||
|
||||
integer :: maxNinstance,p,instance
|
||||
|
||||
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>'
|
||||
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>'; flush(6)
|
||||
|
||||
maxNinstance = count(phase_kinematics == KINEMATICS_cleavage_opening_ID)
|
||||
if (maxNinstance == 0) return
|
||||
|
|
|
|||
|
|
@ -51,7 +51,7 @@ subroutine kinematics_slipplane_opening_init
|
|||
|
||||
integer :: maxNinstance,p,instance
|
||||
|
||||
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>'
|
||||
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>'; flush(6)
|
||||
|
||||
maxNinstance = count(phase_kinematics == KINEMATICS_slipplane_opening_ID)
|
||||
if (maxNinstance == 0) return
|
||||
|
|
@ -134,51 +134,35 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc,
|
|||
dLd_dTstar = 0.0_pReal
|
||||
do i = 1, prm%totalNslip
|
||||
|
||||
projection_d = math_outer(prm%slip_direction(1:3,i),prm%slip_normal(1:3,i))
|
||||
projection_d = math_outer(prm%slip_direction(1:3,i), prm%slip_normal(1:3,i))
|
||||
projection_t = math_outer(prm%slip_transverse(1:3,i),prm%slip_normal(1:3,i))
|
||||
projection_n = math_outer(prm%slip_normal(1:3,i),prm%slip_normal(1:3,i))
|
||||
projection_n = math_outer(prm%slip_normal(1:3,i), prm%slip_normal(1:3,i))
|
||||
|
||||
traction_d = math_mul33xx33(S,projection_d)
|
||||
traction_t = math_mul33xx33(S,projection_t)
|
||||
traction_n = math_mul33xx33(S,projection_n)
|
||||
|
||||
traction_crit = prm%critLoad(i)* damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage
|
||||
traction_crit = prm%critLoad(i)* damage(homog)%p(damageOffset) ! degrading critical load carrying capacity by damage
|
||||
|
||||
udotd = sign(1.0_pReal,traction_d)* &
|
||||
prm%sdot0* &
|
||||
(abs(traction_d)/traction_crit - &
|
||||
abs(traction_d)/prm%critLoad(i))**prm%n
|
||||
if (abs(udotd) > tol_math_check) then
|
||||
Ld = Ld + udotd*projection_d
|
||||
dudotd_dt = udotd*prm%n/traction_d
|
||||
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
|
||||
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
|
||||
dudotd_dt*projection_d(k,l)*projection_d(m,n)
|
||||
endif
|
||||
|
||||
udott = sign(1.0_pReal,traction_t)* &
|
||||
prm%sdot0* &
|
||||
(abs(traction_t)/traction_crit - &
|
||||
abs(traction_t)/prm%critLoad(i))**prm%n
|
||||
if (abs(udott) > tol_math_check) then
|
||||
Ld = Ld + udott*projection_t
|
||||
dudott_dt = udott*prm%n/traction_t
|
||||
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
|
||||
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
|
||||
dudott_dt*projection_t(k,l)*projection_t(m,n)
|
||||
endif
|
||||
udotd = sign(1.0_pReal,traction_d)* prm%sdot0* ( abs(traction_d)/traction_crit &
|
||||
- abs(traction_d)/prm%critLoad(i))**prm%n
|
||||
udott = sign(1.0_pReal,traction_t)* prm%sdot0* ( abs(traction_t)/traction_crit &
|
||||
- abs(traction_t)/prm%critLoad(i))**prm%n
|
||||
udotn = prm%sdot0* ( max(0.0_pReal,traction_n)/traction_crit &
|
||||
- max(0.0_pReal,traction_n)/prm%critLoad(i))**prm%n
|
||||
|
||||
udotn = &
|
||||
prm%sdot0* &
|
||||
(max(0.0_pReal,traction_n)/traction_crit - &
|
||||
max(0.0_pReal,traction_n)/prm%critLoad(i))**prm%n
|
||||
if (abs(udotn) > tol_math_check) then
|
||||
Ld = Ld + udotn*projection_n
|
||||
dudotn_dt = udotn*prm%n/traction_n
|
||||
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
|
||||
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
|
||||
dudotn_dt*projection_n(k,l)*projection_n(m,n)
|
||||
endif
|
||||
dudotd_dt = udotd*prm%n/traction_d
|
||||
dudott_dt = udott*prm%n/traction_t
|
||||
dudotn_dt = udotn*prm%n/traction_n
|
||||
|
||||
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
|
||||
dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + dudotd_dt*projection_d(k,l)*projection_d(m,n) &
|
||||
+ dudott_dt*projection_t(k,l)*projection_t(m,n) &
|
||||
+ dudotn_dt*projection_n(k,l)*projection_n(m,n)
|
||||
|
||||
Ld = Ld + udotd*projection_d &
|
||||
+ udott*projection_t &
|
||||
+ udotn*projection_n
|
||||
enddo
|
||||
|
||||
end associate
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ subroutine kinematics_thermal_expansion_init
|
|||
real(pReal), dimension(:), allocatable :: &
|
||||
temp
|
||||
|
||||
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>'
|
||||
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>'; flush(6)
|
||||
|
||||
Ninstance = count(phase_kinematics == KINEMATICS_thermal_expansion_ID)
|
||||
|
||||
|
|
|
|||
30
src/math.f90
30
src/math.f90
|
|
@ -398,19 +398,19 @@ pure function math_exp33(A,n)
|
|||
real(pReal), dimension(3,3), intent(in) :: A
|
||||
real(pReal), dimension(3,3) :: B, math_exp33
|
||||
real(pReal) :: invFac
|
||||
integer :: order
|
||||
|
||||
B = math_I3 ! init
|
||||
invFac = 1.0_pReal ! 0!
|
||||
math_exp33 = B ! A^0 = eye2
|
||||
integer :: n_
|
||||
|
||||
if (present(n)) then
|
||||
order = n
|
||||
n_ = n
|
||||
else
|
||||
order = 5
|
||||
n_ = 5
|
||||
endif
|
||||
|
||||
do i = 1, order
|
||||
|
||||
invFac = 1.0_pReal ! 0!
|
||||
B = math_I3
|
||||
math_exp33 = math_I3 ! A^0 = I
|
||||
|
||||
do i = 1, n_
|
||||
invFac = invFac/real(i,pReal) ! invfac = 1/(i!)
|
||||
B = matmul(B,A)
|
||||
math_exp33 = math_exp33 + invFac*B ! exp = SUM (A^i)/(i!)
|
||||
|
|
@ -882,16 +882,20 @@ real(pReal) function math_sampleGaussVar(meanvalue, stddev, width)
|
|||
real(pReal), intent(in), optional :: width ! width of considered values as multiples of standard deviation
|
||||
real(pReal), dimension(2) :: rnd ! random numbers
|
||||
real(pReal) :: scatter, & ! normalized scatter around meanvalue
|
||||
myWidth
|
||||
width_
|
||||
|
||||
if (abs(stddev) < tol_math_check) then
|
||||
math_sampleGaussVar = meanvalue
|
||||
else
|
||||
myWidth = merge(width,3.0_pReal,present(width)) ! use +-3*sigma as default value for scatter if not given
|
||||
|
||||
if (present(width)) then
|
||||
width_ = width
|
||||
else
|
||||
width_ = 3.0_pReal ! use +-3*sigma as default scatter
|
||||
endif
|
||||
|
||||
do
|
||||
call random_number(rnd)
|
||||
scatter = myWidth * (2.0_pReal * rnd(1) - 1.0_pReal)
|
||||
scatter = width_ * (2.0_pReal * rnd(1) - 1.0_pReal)
|
||||
if (rnd(2) <= exp(-0.5_pReal * scatter ** 2.0_pReal)) exit ! test if scattered value is drawn
|
||||
enddo
|
||||
|
||||
|
|
|
|||
|
|
@ -296,7 +296,7 @@ end subroutine readGeom
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> @brief Calculate undeformed position of IPs/cell centres (pretend to be an element)
|
||||
!> @brief Calculate undeformed position of IPs/cell centers (pretend to be an element)
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
function IPcoordinates0(grid,geomSize,grid3Offset)
|
||||
|
||||
|
|
|
|||
|
|
@ -488,8 +488,7 @@ subroutine inputRead_mapNodes(fileContent)
|
|||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if( IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'coordinates' ) then
|
||||
do i = 1,size(mesh_mapFEtoCPnode,2)
|
||||
mesh_mapFEtoCPnode(1,i) = IO_fixedIntValue (fileContent(l+1+i),[0,10],1)
|
||||
mesh_mapFEtoCPnode(2,i) = i
|
||||
mesh_mapFEtoCPnode(1:2,i) = [IO_fixedIntValue (fileContent(l+1+i),[0,10],1),i] ! ToDo: use IO_intValue
|
||||
enddo
|
||||
exit
|
||||
endif
|
||||
|
|
@ -520,9 +519,9 @@ subroutine inputRead_elemNodes(nodes, &
|
|||
chunkPos = IO_stringPos(fileContent(l))
|
||||
if( IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'coordinates' ) then
|
||||
do i=1,nNode
|
||||
m = mesh_FEasCP('node',IO_fixedIntValue(fileContent(l+1+i),node_ends,1))
|
||||
m = mesh_FEasCP('node',IO_fixedIntValue(fileContent(l+1+i),node_ends,1)) !ToDo: use IO_intValue
|
||||
do j = 1,3
|
||||
nodes(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(fileContent(l+1+i),node_ends,j+1)
|
||||
nodes(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(fileContent(l+1+i),node_ends,j+1) !ToDo: use IO_floatValue
|
||||
enddo
|
||||
enddo
|
||||
exit
|
||||
|
|
|
|||
|
|
@ -1,37 +1,9 @@
|
|||
! ###################################################################
|
||||
! Copyright (c) 2013-2015, Marc De Graef/Carnegie Mellon University
|
||||
! Modified 2017-2019, Martin Diehl/Max-Planck-Institut für Eisenforschung GmbH
|
||||
! All rights reserved.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without modification, are
|
||||
! permitted provided that the following conditions are met:
|
||||
!
|
||||
! - Redistributions of source code must retain the above copyright notice, this list
|
||||
! of conditions and the following disclaimer.
|
||||
! - Redistributions in binary form must reproduce the above copyright notice, this
|
||||
! list of conditions and the following disclaimer in the documentation and/or
|
||||
! other materials provided with the distribution.
|
||||
! - Neither the names of Marc De Graef, Carnegie Mellon University nor the names
|
||||
! of its contributors may be used to endorse or promote products derived from
|
||||
! this software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
! ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
|
||||
! LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
|
||||
! USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
! ###################################################################
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> @author Marc De Graef, Carnegie Mellon University
|
||||
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @author Philip Eisenlohr, Michigan State University
|
||||
!> @brief general quaternion math, not limited to unit quaternions
|
||||
!> @details w is the real part, (x, y, z) are the imaginary parts.
|
||||
!> @details w is the real part, (x, y, z) are the imaginary parts.
|
||||
!> @details https://en.wikipedia.org/wiki/Quaternion
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
module quaternions
|
||||
use prec
|
||||
|
|
@ -78,15 +50,16 @@ module quaternions
|
|||
|
||||
procedure, public :: abs__
|
||||
procedure, public :: dot_product__
|
||||
procedure, public :: conjg__
|
||||
procedure, public :: exp__
|
||||
procedure, public :: log__
|
||||
|
||||
procedure, public :: homomorphed => quat_homomorphed
|
||||
procedure, public :: asArray
|
||||
procedure, public :: conjg => conjg__
|
||||
procedure, public :: real => real__
|
||||
procedure, public :: aimag => aimag__
|
||||
|
||||
procedure, public :: homomorphed
|
||||
procedure, public :: asArray
|
||||
procedure, public :: inverse
|
||||
|
||||
end type
|
||||
|
||||
interface assignment (=)
|
||||
|
|
@ -117,6 +90,14 @@ module quaternions
|
|||
interface log
|
||||
module procedure log__
|
||||
end interface log
|
||||
|
||||
interface real
|
||||
module procedure real__
|
||||
end interface real
|
||||
|
||||
interface aimag
|
||||
module procedure aimag__
|
||||
end interface aimag
|
||||
|
||||
private :: &
|
||||
unitTest
|
||||
|
|
@ -125,49 +106,46 @@ contains
|
|||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief doing self test
|
||||
!> @brief do self test
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine quaternions_init
|
||||
|
||||
write(6,'(/,a)') ' <<<+- quaternions init -+>>>'
|
||||
write(6,'(/,a)') ' <<<+- quaternions init -+>>>'; flush(6)
|
||||
call unitTest
|
||||
|
||||
end subroutine quaternions_init
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> constructor for a quaternion from a 4-vector
|
||||
!> construct a quaternion from a 4-vector
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) pure function init__(array)
|
||||
|
||||
real(pReal), intent(in), dimension(4) :: array
|
||||
|
||||
init__%w=array(1)
|
||||
init__%x=array(2)
|
||||
init__%y=array(3)
|
||||
init__%z=array(4)
|
||||
init__%w = array(1)
|
||||
init__%x = array(2)
|
||||
init__%y = array(3)
|
||||
init__%z = array(4)
|
||||
|
||||
end function init__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> assing a quaternion
|
||||
!> assign a quaternion
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
elemental pure subroutine assign_quat__(self,other)
|
||||
|
||||
type(quaternion), intent(out) :: self
|
||||
type(quaternion), intent(in) :: other
|
||||
|
||||
self%w = other%w
|
||||
self%x = other%x
|
||||
self%y = other%y
|
||||
self%z = other%z
|
||||
|
||||
self = [other%w,other%x,other%y,other%z]
|
||||
|
||||
end subroutine assign_quat__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> assing a 4-vector
|
||||
!> assign a 4-vector
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
pure subroutine assign_vec__(self,other)
|
||||
|
||||
|
|
@ -183,67 +161,57 @@ end subroutine assign_vec__
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> addition of two quaternions
|
||||
!> add a quaternion
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function add__(self,other)
|
||||
|
||||
class(quaternion), intent(in) :: self,other
|
||||
|
||||
add__%w = self%w + other%w
|
||||
add__%x = self%x + other%x
|
||||
add__%y = self%y + other%y
|
||||
add__%z = self%z + other%z
|
||||
|
||||
add__ = [ self%w, self%x, self%y ,self%z] &
|
||||
+ [other%w, other%x, other%y,other%z]
|
||||
|
||||
end function add__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> unary positive operator
|
||||
!> return (unary positive operator)
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function pos__(self)
|
||||
|
||||
class(quaternion), intent(in) :: self
|
||||
|
||||
pos__%w = self%w
|
||||
pos__%x = self%x
|
||||
pos__%y = self%y
|
||||
pos__%z = self%z
|
||||
|
||||
pos__ = self * (+1.0_pReal)
|
||||
|
||||
end function pos__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> subtraction of two quaternions
|
||||
!> subtract a quaternion
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function sub__(self,other)
|
||||
|
||||
class(quaternion), intent(in) :: self,other
|
||||
|
||||
sub__%w = self%w - other%w
|
||||
sub__%x = self%x - other%x
|
||||
sub__%y = self%y - other%y
|
||||
sub__%z = self%z - other%z
|
||||
|
||||
sub__ = [ self%w, self%x, self%y ,self%z] &
|
||||
- [other%w, other%x, other%y,other%z]
|
||||
|
||||
end function sub__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> unary positive operator
|
||||
!> negate (unary negative operator)
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function neg__(self)
|
||||
|
||||
class(quaternion), intent(in) :: self
|
||||
|
||||
neg__%w = -self%w
|
||||
neg__%x = -self%x
|
||||
neg__%y = -self%y
|
||||
neg__%z = -self%z
|
||||
|
||||
neg__ = self * (-1.0_pReal)
|
||||
|
||||
end function neg__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> multiplication of two quaternions
|
||||
!> multiply with a quaternion
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function mul_quat__(self,other)
|
||||
|
||||
|
|
@ -258,23 +226,20 @@ end function mul_quat__
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> multiplication of quaternions with scalar
|
||||
!> multiply with a scalar
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function mul_scal__(self,scal)
|
||||
|
||||
class(quaternion), intent(in) :: self
|
||||
real(pReal), intent(in) :: scal
|
||||
|
||||
mul_scal__%w = self%w*scal
|
||||
mul_scal__%x = self%x*scal
|
||||
mul_scal__%y = self%y*scal
|
||||
mul_scal__%z = self%z*scal
|
||||
real(pReal), intent(in) :: scal
|
||||
|
||||
mul_scal__ = [self%w,self%x,self%y,self%z]*scal
|
||||
|
||||
end function mul_scal__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> division of two quaternions
|
||||
!> divide by a quaternion
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function div_quat__(self,other)
|
||||
|
||||
|
|
@ -286,12 +251,12 @@ end function div_quat__
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> divisiont of quaternions by scalar
|
||||
!> divide by a scalar
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function div_scal__(self,scal)
|
||||
|
||||
class(quaternion), intent(in) :: self
|
||||
real(pReal), intent(in) :: scal
|
||||
real(pReal), intent(in) :: scal
|
||||
|
||||
div_scal__ = [self%w,self%x,self%y,self%z]/scal
|
||||
|
||||
|
|
@ -299,7 +264,7 @@ end function div_scal__
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> equality of two quaternions
|
||||
!> test equality
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
logical elemental pure function eq__(self,other)
|
||||
|
||||
|
|
@ -312,7 +277,7 @@ end function eq__
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> inequality of two quaternions
|
||||
!> test inequality
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
logical elemental pure function neq__(self,other)
|
||||
|
||||
|
|
@ -324,20 +289,7 @@ end function neq__
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> quaternion to the power of a scalar
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function pow_scal__(self,expon)
|
||||
|
||||
class(quaternion), intent(in) :: self
|
||||
real(pReal), intent(in) :: expon
|
||||
|
||||
pow_scal__ = exp(log(self)*expon)
|
||||
|
||||
end function pow_scal__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> quaternion to the power of a quaternion
|
||||
!> raise to the power of a quaternion
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function pow_quat__(self,expon)
|
||||
|
||||
|
|
@ -350,45 +302,60 @@ end function pow_quat__
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> exponential of a quaternion
|
||||
!> ToDo: Lacks any check for invalid operations
|
||||
!> raise to the power of a scalar
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function pow_scal__(self,expon)
|
||||
|
||||
class(quaternion), intent(in) :: self
|
||||
real(pReal), intent(in) :: expon
|
||||
|
||||
pow_scal__ = exp(log(self)*expon)
|
||||
|
||||
end function pow_scal__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> take exponential
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function exp__(self)
|
||||
|
||||
class(quaternion), intent(in) :: self
|
||||
real(pReal) :: absImag
|
||||
|
||||
absImag = norm2([self%x, self%y, self%z])
|
||||
absImag = norm2(aimag(self))
|
||||
|
||||
exp__ = exp(self%w) * [ cos(absImag), &
|
||||
self%x/absImag * sin(absImag), &
|
||||
self%y/absImag * sin(absImag), &
|
||||
self%z/absImag * sin(absImag)]
|
||||
exp__ = merge(exp(self%w) * [ cos(absImag), &
|
||||
self%x/absImag * sin(absImag), &
|
||||
self%y/absImag * sin(absImag), &
|
||||
self%z/absImag * sin(absImag)], &
|
||||
IEEE_value(1.0_pReal,IEEE_SIGNALING_NAN), &
|
||||
dNeq0(absImag))
|
||||
|
||||
end function exp__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> logarithm of a quaternion
|
||||
!> ToDo: Lacks any check for invalid operations
|
||||
!> take logarithm
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function log__(self)
|
||||
|
||||
class(quaternion), intent(in) :: self
|
||||
real(pReal) :: absImag
|
||||
|
||||
absImag = norm2([self%x, self%y, self%z])
|
||||
absImag = norm2(aimag(self))
|
||||
|
||||
log__ = [log(abs(self)), &
|
||||
self%x/absImag * acos(self%w/abs(self)), &
|
||||
self%y/absImag * acos(self%w/abs(self)), &
|
||||
self%z/absImag * acos(self%w/abs(self))]
|
||||
log__ = merge([log(abs(self)), &
|
||||
self%x/absImag * acos(self%w/abs(self)), &
|
||||
self%y/absImag * acos(self%w/abs(self)), &
|
||||
self%z/absImag * acos(self%w/abs(self))], &
|
||||
IEEE_value(1.0_pReal,IEEE_SIGNALING_NAN), &
|
||||
dNeq0(absImag))
|
||||
|
||||
end function log__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> norm of a quaternion
|
||||
!> return norm
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
real(pReal) elemental pure function abs__(a)
|
||||
|
||||
|
|
@ -400,7 +367,7 @@ end function abs__
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> dot product of two quaternions
|
||||
!> calculate dot product
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
real(pReal) elemental pure function dot_product__(a,b)
|
||||
|
||||
|
|
@ -412,31 +379,31 @@ end function dot_product__
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> conjugate complex of a quaternion
|
||||
!> take conjugate complex
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function conjg__(a)
|
||||
|
||||
class(quaternion), intent(in) :: a
|
||||
|
||||
conjg__ = quaternion([a%w, -a%x, -a%y, -a%z])
|
||||
conjg__ = [a%w, -a%x, -a%y, -a%z]
|
||||
|
||||
end function conjg__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> homomorphed quaternion of a quaternion
|
||||
!> homomorph
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function quat_homomorphed(self)
|
||||
type(quaternion) elemental pure function homomorphed(self)
|
||||
|
||||
class(quaternion), intent(in) :: self
|
||||
|
||||
quat_homomorphed = quaternion(-[self%w,self%x,self%y,self%z])
|
||||
homomorphed = - self
|
||||
|
||||
end function quat_homomorphed
|
||||
end function homomorphed
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> quaternion as plain array
|
||||
!> return as plain array
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
pure function asArray(self)
|
||||
|
||||
|
|
@ -449,7 +416,7 @@ end function asArray
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> real part of a quaternion
|
||||
!> real part (scalar)
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
pure function real__(self)
|
||||
|
||||
|
|
@ -462,7 +429,7 @@ end function real__
|
|||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> imaginary part of a quaternion
|
||||
!> imaginary part (3-vector)
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
pure function aimag__(self)
|
||||
|
||||
|
|
@ -474,46 +441,87 @@ pure function aimag__(self)
|
|||
end function aimag__
|
||||
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
!> inverse
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
type(quaternion) elemental pure function inverse(self)
|
||||
|
||||
class(quaternion), intent(in) :: self
|
||||
|
||||
inverse = conjg(self)/abs(self)**2.0_pReal
|
||||
|
||||
end function inverse
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief check correctness of (some) quaternions functions
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine unitTest
|
||||
|
||||
real(pReal), dimension(4) :: qu
|
||||
|
||||
type(quaternion) :: q, q_2
|
||||
|
||||
call random_number(qu)
|
||||
q = qu
|
||||
qu = (qu-0.5_pReal) * 2.0_pReal
|
||||
q = quaternion(qu)
|
||||
|
||||
q_2 = q + q
|
||||
if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) call IO_error(401,ext_msg='add__')
|
||||
|
||||
q_2 = q - q
|
||||
if(any(dNeq0(q_2%asArray()))) call IO_error(401,ext_msg='sub__')
|
||||
|
||||
q_2 = q * 5.0_preal
|
||||
if(any(dNeq(q_2%asArray(),5.0_pReal*qu))) call IO_error(401,ext_msg='mul__')
|
||||
|
||||
q_2 = q / 0.5_preal
|
||||
if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) call IO_error(401,ext_msg='div__')
|
||||
|
||||
q_2 = q
|
||||
if(q_2 /= q) call IO_error(401,ext_msg='eq__')
|
||||
q_2= qu
|
||||
if(any(dNeq(q%asArray(),q_2%asArray()))) call IO_error(401,ext_msg='assign_vec__')
|
||||
|
||||
if(any(dNeq(q%asArray(),qu))) call IO_error(401,ext_msg='eq__')
|
||||
if(dNeq(q%real(), qu(1))) call IO_error(401,ext_msg='real()')
|
||||
if(any(dNeq(q%aimag(), qu(2:4)))) call IO_error(401,ext_msg='aimag()')
|
||||
q_2 = q + q
|
||||
if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) call IO_error(401,ext_msg='add__')
|
||||
|
||||
q_2 = q - q
|
||||
if(any(dNeq0(q_2%asArray()))) call IO_error(401,ext_msg='sub__')
|
||||
|
||||
q_2 = q * 5.0_pReal
|
||||
if(any(dNeq(q_2%asArray(),5.0_pReal*qu))) call IO_error(401,ext_msg='mul__')
|
||||
|
||||
q_2 = q / 0.5_pReal
|
||||
if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) call IO_error(401,ext_msg='div__')
|
||||
|
||||
q_2 = q * 0.3_pReal
|
||||
if(dNeq0(abs(q)) .and. q_2 == q) call IO_error(401,ext_msg='eq__')
|
||||
|
||||
q_2 = q
|
||||
if(q_2 /= q) call IO_error(401,ext_msg='neq__')
|
||||
|
||||
if(dNeq(abs(q),norm2(qu))) call IO_error(401,ext_msg='abs__')
|
||||
if(dNeq(abs(q)**2.0_pReal, real(q*q%conjg()),1.0e-14_pReal)) &
|
||||
call IO_error(401,ext_msg='abs__/*conjg')
|
||||
|
||||
if(any(dNeq(q%asArray(),qu))) call IO_error(401,ext_msg='eq__')
|
||||
if(dNeq(q%real(), qu(1))) call IO_error(401,ext_msg='real()')
|
||||
if(any(dNeq(q%aimag(), qu(2:4)))) call IO_error(401,ext_msg='aimag()')
|
||||
|
||||
q_2 = q%homomorphed()
|
||||
if(q /= q_2* (-1.0_pReal)) call IO_error(401,ext_msg='homomorphed')
|
||||
if(dNeq(q_2%real(), qu(1)* (-1.0_pReal))) call IO_error(401,ext_msg='homomorphed/real')
|
||||
if(any(dNeq(q_2%aimag(),qu(2:4)*(-1.0_pReal)))) call IO_error(401,ext_msg='homomorphed/aimag')
|
||||
|
||||
if(q /= q_2* (-1.0_pReal)) call IO_error(401,ext_msg='homomorphed')
|
||||
if(dNeq(q_2%real(), qu(1)* (-1.0_pReal))) call IO_error(401,ext_msg='homomorphed/real')
|
||||
if(any(dNeq(q_2%aimag(),qu(2:4)*(-1.0_pReal)))) call IO_error(401,ext_msg='homomorphed/aimag')
|
||||
|
||||
q_2 = conjg(q)
|
||||
if(dNeq(q_2%real(), q%real())) call IO_error(401,ext_msg='conjg/real')
|
||||
if(any(dNeq(q_2%aimag(),q%aimag()*(-1.0_pReal)))) call IO_error(401,ext_msg='conjg/aimag')
|
||||
|
||||
if(dNeq(abs(q),abs(q_2))) call IO_error(401,ext_msg='conjg/abs')
|
||||
if(q /= conjg(q_2)) call IO_error(401,ext_msg='conjg/involution')
|
||||
if(dNeq(q_2%real(), q%real())) call IO_error(401,ext_msg='conjg/real')
|
||||
if(any(dNeq(q_2%aimag(),q%aimag()*(-1.0_pReal)))) call IO_error(401,ext_msg='conjg/aimag')
|
||||
|
||||
if(abs(q) > 0.0_pReal) then
|
||||
q_2 = q * q%inverse()
|
||||
if( dNeq(real(q_2), 1.0_pReal,1.0e-15_pReal)) call IO_error(401,ext_msg='inverse/real')
|
||||
if(any(dNeq0(aimag(q_2), 1.0e-15_pReal))) call IO_error(401,ext_msg='inverse/aimag')
|
||||
|
||||
q_2 = q/abs(q)
|
||||
q_2 = conjg(q_2) - inverse(q_2)
|
||||
if(any(dNeq0(q_2%asArray(),1.0e-15_pReal))) call IO_error(401,ext_msg='inverse/conjg')
|
||||
endif
|
||||
|
||||
#if !(defined(__GFORTRAN__) && __GNUC__ < 9)
|
||||
if (norm2(aimag(q)) > 0.0_pReal) then
|
||||
if (dNeq0(abs(q-exp(log(q))),1.0e-13_pReal)) call IO_error(401,ext_msg='exp/log')
|
||||
if (dNeq0(abs(q-log(exp(q))),1.0e-13_pReal)) call IO_error(401,ext_msg='log/exp')
|
||||
endif
|
||||
#endif
|
||||
|
||||
end subroutine unitTest
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -47,6 +47,7 @@ module results
|
|||
results_openJobFile, &
|
||||
results_closeJobFile, &
|
||||
results_addIncrement, &
|
||||
results_finalizeIncrement, &
|
||||
results_addGroup, &
|
||||
results_openGroup, &
|
||||
results_closeGroup, &
|
||||
|
|
@ -119,6 +120,17 @@ subroutine results_addIncrement(inc,time)
|
|||
end subroutine results_addIncrement
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief finalize increment
|
||||
!> @details remove soft link
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine results_finalizeIncrement
|
||||
|
||||
call results_removeLink('current')
|
||||
|
||||
end subroutine results_finalizeIncrement
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief open a group from the results file
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -93,21 +93,24 @@ end function isDirectory
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief gets the current working directory
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
character(len=1024) function getCWD()
|
||||
function getCWD()
|
||||
|
||||
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
|
||||
character(len=:), allocatable :: getCWD
|
||||
integer(C_INT) :: stat
|
||||
integer :: i
|
||||
|
||||
call getCurrentWorkDir_C(charArray,stat)
|
||||
|
||||
if (stat /= 0_C_INT) then
|
||||
getCWD = 'Error occured when getting currend working directory'
|
||||
else
|
||||
getCWD = repeat('',len(getCWD))
|
||||
allocate(character(len=1024)::getCWD)
|
||||
arrayToString: do i=1,len(getCWD)
|
||||
if (charArray(i) /= C_NULL_CHAR) then
|
||||
getCWD(i:i)=charArray(i)
|
||||
else
|
||||
getCWD = getCWD(:i-1)
|
||||
exit
|
||||
endif
|
||||
enddo arrayToString
|
||||
|
|
@ -119,21 +122,24 @@ end function getCWD
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief gets the current host name
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
character(len=1024) function getHostName()
|
||||
function getHostName()
|
||||
|
||||
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
|
||||
character(len=:), allocatable :: getHostName
|
||||
integer(C_INT) :: stat
|
||||
integer :: i
|
||||
|
||||
call getHostName_C(charArray,stat)
|
||||
|
||||
if (stat /= 0_C_INT) then
|
||||
getHostName = 'Error occured when getting host name'
|
||||
else
|
||||
getHostName = repeat('',len(getHostName))
|
||||
allocate(character(len=1024)::getHostName)
|
||||
arrayToString: do i=1,len(getHostName)
|
||||
if (charArray(i) /= C_NULL_CHAR) then
|
||||
getHostName(i:i)=charArray(i)
|
||||
else
|
||||
getHostName = getHostName(:i-1)
|
||||
exit
|
||||
endif
|
||||
enddo arrayToString
|
||||
|
|
|
|||
Loading…
Reference in New Issue