├── docs ├── Doxyfile ├── Doxyfile.in └── CMakeLists.txt ├── .gitignore ├── cmake_config ├── GNU.cmake └── Intel.cmake ├── src ├── libtt_constants.f90 ├── libtt_precision.f90 ├── libtt.f90 ├── lapack │ ├── CMakeLists.txt │ └── libtt_common_lapack.f90 ├── CMakeLists.txt ├── libtt_logical.f90 ├── libtt_exception.f90 ├── libtt_print.f90 ├── libtt_solvers_eigenproblem.f90 ├── libtt_solvers_gauss.f90 ├── libtt_products.f90 ├── libtt_common.f90 ├── libtt_physics_transformation.f90 ├── libtt_voigt.f90 └── libtt_physics_elasticity.f90 ├── Jenkinsfile ├── examples ├── common │ ├── run_example.sh │ ├── Makefile │ └── main.f90 └── pretty_printing │ ├── run_example.sh │ ├── Makefile │ └── main.f90 ├── tests ├── test_common_lapack.pf ├── CMakeLists.txt ├── test_logical.pf ├── test_voigt.pf ├── test_physics_elasticity.pf ├── test_common.pf ├── test_products_doubleContract.pf ├── test_solvers.pf ├── test_tensors_common.pf └── test_products_dyadic.pf ├── CMakeLists.txt ├── README.md └── LICENSE.md /docs/Doxyfile: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /build 2 | *.mod 3 | /misc 4 | *.out 5 | /.vscode -------------------------------------------------------------------------------- /cmake_config/GNU.cmake: -------------------------------------------------------------------------------- 1 | # Compiler falgs for GNU compiler 2 | 3 | set(CMAKE_Fortan_FLAGS_DEBUG "-Wall -Wextra -Wsurprising -0g -g" 4 | CACHE STRING "Compiler flags for debugging") 5 | 6 | set(CMAKE_Fortan_FLAGS_RELEASE "-O2" 7 | CACHE STRING "Compiler flags for production") -------------------------------------------------------------------------------- /src/libtt_constants.f90: -------------------------------------------------------------------------------- 1 | !> Constants (e.g. pi) 2 | module libtt_constants 3 | 4 | use libtt_precision, only: dp 5 | 6 | implicit none 7 | save 8 | 9 | real(kind=dp), parameter :: pi = 4 * atan(1.0_8) 10 | real(kind=dp), parameter :: e = 2.71828182845904523536 11 | 12 | end module libtt_constants -------------------------------------------------------------------------------- /src/libtt_precision.f90: -------------------------------------------------------------------------------- 1 | module libtt_precision 2 | 3 | implicit none 4 | 5 | save 6 | 7 | integer, parameter :: sp = selected_real_kind(6, 37) 8 | integer, parameter :: dp = selected_real_kind(15, 307) 9 | integer, parameter :: qp = selected_real_kind(33, 4931) 10 | 11 | end module libtt_precision -------------------------------------------------------------------------------- /Jenkinsfile: -------------------------------------------------------------------------------- 1 | pipeline { 2 | agent any 3 | stages { 4 | stage('Build') { 5 | steps{ 6 | cmake arguments: '', installation: 'InSearchPath' 7 | cmakeBuild buildType: 'Debug', cleanBuild: true, installation: 'InSearchPath', steps: [[withCmake: true]] 8 | } 9 | } 10 | } 11 | } -------------------------------------------------------------------------------- /cmake_config/Intel.cmake: -------------------------------------------------------------------------------- 1 | # Compiler falgs for Intel compiler 2 | 3 | set(CMAKE_Fortan_FLAGS_DEBUG "-Wall -Wextra -Wsurprising -00 -g" 4 | CACHE STRING "Compiler flags for debugging") 5 | 6 | set(CMAKE_Fortan_FLAGS_RELEASE "-O2" 7 | CACHE STRING "Compiler flags for production") 8 | 9 | set(CMAKE_Fortran_FLAGS "-traceback -check all -save-temps -diag-disable 5462") -------------------------------------------------------------------------------- /src/libtt.f90: -------------------------------------------------------------------------------- 1 | !> Super module for tensortools library 2 | module libtt 3 | 4 | use libtt_common 5 | use libtt_exception 6 | use libtt_precision 7 | use libtt_print 8 | use libtt_products 9 | use libtt_solvers_gauss 10 | use libtt_physics_elasticity 11 | use libtt_voigt 12 | use libtt_logical 13 | use libtt_solvers_eigenproblem 14 | use libtt_constants 15 | 16 | end module libtt -------------------------------------------------------------------------------- /src/lapack/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | # CMake Configuration file for TensorTools library 2 | # 3 | # Subdirectory: src/lapack 4 | # 5 | # Version: 0.1.0 (04/2020) 6 | # Author: Lukas Lamm 7 | 8 | # Set source files 9 | set(SOURCE 10 | libtt_common_lapack.f90 11 | ) 12 | 13 | # Define library to build 14 | add_library(tt_lapack ${SOURCE}) 15 | target_include_directories(tt_lapack PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) 16 | target_link_libraries(tt_lapack tt ${LAPACK_LIBRARIES}) -------------------------------------------------------------------------------- /docs/Doxyfile.in: -------------------------------------------------------------------------------- 1 | DOXYFILE_ENCODING = UTF-8 2 | OPTIMIZE_FOR_FORTRAN = YES 3 | MARKDOWN_SUPPORT = YES 4 | 5 | PROJECT_NAME = @CMAKE_PROJECT_NAME@ 6 | PROJECT_BRIEF = "@CMAKE_PROJECT_DESCRIPTION@" 7 | PROJECT_NUMBER = @PROJECT_VERSION@ 8 | 9 | OUTPUT_DIRECTORY = @CMAKE_CURRENT_BINARY_DIR@/doc_doxygen/ 10 | INPUT = @CMAKE_CURRENT_SOURCE_DIR@/../src/ 11 | INPUT += @CMAKE_CURRENT_SOURCE_DIR@/../README.md 12 | USE_MDFILE_AS_MAINPAGE = README.md -------------------------------------------------------------------------------- /examples/common/run_example.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | green=$'\e[1;32m' 3 | end=$'\e[0m' 4 | 5 | if [ ! -f ./common_example.out ]; then 6 | printf "%s\n" "${green} Building example for common operations. ${end}" 7 | make 8 | else 9 | printf "%s\n" "${green} Executable already exists. No build needed. ${end}" 10 | fi 11 | 12 | printf "%s\n" "${green} Executing example. ${end}" 13 | ./common_example.out 14 | 15 | # Clean up 16 | printf "%s\n" "${green} Removing build files. ${end}" 17 | make clean 18 | 19 | -------------------------------------------------------------------------------- /examples/pretty_printing/run_example.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | green=$'\e[1;32m' 3 | end=$'\e[0m' 4 | 5 | if [ ! -f ./pretty_print.out ]; then 6 | printf "%s\n" "${green} Building example for pretty printing. ${end}" 7 | make 8 | else 9 | printf "%s\n" "${green} Executable already exists. No build needed. ${end}" 10 | fi 11 | 12 | printf "%s\n" "${green} Executing example. ${end}" 13 | ./pretty_print.out 14 | 15 | # Clean up 16 | printf "%s\n" "${green} Removing build files. ${end}" 17 | make clean 18 | -------------------------------------------------------------------------------- /examples/pretty_printing/Makefile: -------------------------------------------------------------------------------- 1 | FC=gfortran 2 | #FC=ifort 3 | 4 | FLAGS=-Wall -o pretty_print.out 5 | MODFLAGS=-Wall -c 6 | SRCROOT=../../src 7 | 8 | pretty_print.out: main.f90 libtt_print.mod libtt_precision.mod 9 | $(FC) $(FLAGS) main.f90 $(SRCROOT)/libtt_print.f90 $(SRCROOT)/libtt_precision.f90 10 | 11 | libtt_print.mod: $(SRCROOT)/libtt_print.f90 libtt_precision.mod 12 | $(FC) $(MODFLAGS) $(SRCROOT)/libtt_print.f90 13 | 14 | libtt_precision.mod: $(SRCROOT)/libtt_precision.f90 15 | $(FC) $(MODFLAGS) $(SRCROOT)/libtt_precision.f90 16 | 17 | .PHONY: clean 18 | 19 | clean: 20 | rm pretty_print.out *.mod *.o -------------------------------------------------------------------------------- /tests/test_common_lapack.pf: -------------------------------------------------------------------------------- 1 | module test_common_lapack 2 | use funit 3 | use libtt_precision 4 | use libtt_common_lapack, only: inverse 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | @test 11 | subroutine assert_inverse() 12 | real(kind=dp), dimension(2,2) :: A 13 | real(kind=dp), dimension(2,2) :: expected_result 14 | 15 | A = reshape((/2 ,1 ,-3 ,5/), (/2,2/)) 16 | expected_result = reshape((/ 5.0, -1.0, 3.0, 2.0 /), (/2,2/)) 17 | expected_result = expected_result / 13.0 18 | 19 | @assertEqual(expected_result, inverse(A)) 20 | end subroutine assert_inverse 21 | 22 | end module test_common_lapack -------------------------------------------------------------------------------- /docs/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | # CMake Configuration file for TensorTools library 2 | # 3 | # Subdirectory: docs 4 | # 5 | # Version: 0.1.0 (04/2020) 6 | # Author: Lukas Lamm 7 | 8 | # set input and output files 9 | set(DOXYFILE_IN ${CMAKE_CURRENT_SOURCE_DIR}/Doxyfile.in) 10 | set(DOXYFILE ${CMAKE_CURRENT_BINARY_DIR}/Doxyfile) 11 | 12 | # request to configure the file 13 | configure_file(${DOXYFILE_IN} ${DOXYFILE} @ONLY) 14 | 15 | # note the option ALL which allows to build the docs together with the 16 | # application 17 | add_custom_target(docs 18 | COMMAND ${DOXYGEN_EXECUTABLE} ${DOXYFILE} 19 | WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} 20 | COMMENT "Generating documentation with Doxygen" 21 | VERBATIM ) 22 | 23 | -------------------------------------------------------------------------------- /src/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | # CMake Configuration file for TensorTools library 2 | # 3 | # Subdirectory: src 4 | # 5 | # Version: 0.1.0 (04/2020) 6 | # Author: Lukas Lamm 7 | 8 | if(LIBTT_LAPACK) 9 | add_subdirectory(lapack) 10 | endif() 11 | 12 | # Set source files 13 | set(SOURCE libtt.f90 14 | libtt_exception.f90 15 | libtt_common.f90 16 | libtt_products.f90 17 | libtt_physics_elasticity.f90 18 | libtt_precision.f90 19 | libtt_print.f90 20 | libtt_voigt.f90 21 | libtt_solvers_gauss.f90 22 | libtt_solvers_eigenproblem.f90 23 | libtt_logical.f90 24 | libtt_constants.f90 25 | libtt_physics_transformation.f90 26 | ) 27 | 28 | # Define library to build 29 | add_library(tt ${SOURCE}) 30 | target_include_directories(tt PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}) 31 | if(LIBTT_LAPACK) 32 | target_link_libraries(tt tt_lapack) 33 | endif() -------------------------------------------------------------------------------- /examples/common/Makefile: -------------------------------------------------------------------------------- 1 | FC=gfortran 2 | #FC=ifort 3 | 4 | BINNAME=common_example.out 5 | 6 | FLAGS=-Wall 7 | MODFLAGS=-Wall -c 8 | SRCROOT=../../src 9 | 10 | $(BINNAME): main.f90 libtt_print.mod libtt_precision.mod libtt_common.mod libtt_products.mod 11 | $(FC) $(FLAGS) -o $(BINNAME) main.f90 $(SRCROOT)/libtt_print.f90 $(SRCROOT)/libtt_precision.f90 $(SRCROOT)/libtt_common.f90 $(SRCROOT)/libtt_products.f90 12 | 13 | libtt_common.mod: $(SRCROOT)/libtt_common.f90 libtt_precision.mod libtt_products.mod 14 | $(FC) $(MODFLAGS) $(SRCROOT)/libtt_common.f90 15 | 16 | libtt_products.mod: $(SRCROOT)/libtt_products.f90 libtt_precision.mod 17 | $(FC) $(MODFLAGS) $(SRCROOT)/libtt_products.f90 18 | 19 | libtt_print.mod: $(SRCROOT)/libtt_print.f90 libtt_precision.mod 20 | $(FC) $(MODFLAGS) $(SRCROOT)/libtt_print.f90 21 | 22 | libtt_precision.mod: $(SRCROOT)/libtt_precision.f90 23 | $(FC) $(MODFLAGS) $(SRCROOT)/libtt_precision.f90 24 | 25 | .PHONY: clean 26 | 27 | clean: 28 | rm $(BINNAME) *.mod *.o -------------------------------------------------------------------------------- /tests/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | add_pfunit_ctest (libtt_common_testSuite 2 | TEST_SOURCES test_common.pf test_tensors_common.pf 3 | LINK_LIBRARIES tt 4 | ) 5 | 6 | add_pfunit_ctest (libtt_physics_testSuite 7 | TEST_SOURCES test_physics_elasticity.pf 8 | LINK_LIBRARIES tt 9 | ) 10 | 11 | add_pfunit_ctest (libtt_products_testSuite 12 | TEST_SOURCES test_products_doubleContract.pf test_products_dyadic.pf 13 | LINK_LIBRARIES tt 14 | ) 15 | 16 | add_pfunit_ctest (libtt_voigt_testSuite 17 | TEST_SOURCES test_voigt.pf 18 | LINK_LIBRARIES tt 19 | ) 20 | 21 | add_pfunit_ctest (libtt_solvers_testSuite 22 | TEST_SOURCES test_solvers.pf 23 | LINK_LIBRARIES tt 24 | ) 25 | 26 | add_pfunit_ctest (libtt_logical_testSuite 27 | TEST_SOURCES test_logical.pf 28 | LINK_LIBRARIES tt 29 | ) 30 | 31 | # Lapack based routines 32 | if(LIBTT_LAPACK) 33 | 34 | add_pfunit_ctest (libtt_common_lapack_testSuite 35 | TEST_SOURCES test_common_lapack.pf 36 | LINK_LIBRARIES tt 37 | ) 38 | 39 | endif() -------------------------------------------------------------------------------- /examples/pretty_printing/main.f90: -------------------------------------------------------------------------------- 1 | program pretty_print 2 | 3 | ! Include packages needed for this example 4 | use libtt_precision, only: dp ! Compiler independent double precision 5 | use libtt_print, only: print ! Pretty printer for tensors 6 | 7 | implicit none 8 | 9 | ! Define some array / tensors 10 | real(kind=dp), dimension(3) :: a 11 | real(kind=dp), dimension(3,3) :: B 12 | real(kind=dp), dimension(3,3,3) :: C 13 | real(kind=dp), dimension(3,3,3,3) :: D 14 | real(kind=dp), dimension(4) :: vector 15 | real(kind=dp), dimension(3,4) :: matrix 16 | 17 | ! Fill tensors with random numbers 18 | call random_number(a) 19 | call random_number(B) 20 | call random_number(C) 21 | call random_number(D) 22 | call random_number(vector) 23 | call random_number(matrix) 24 | 25 | ! Print tensors to screen 26 | call print(a) 27 | call print(B) 28 | call print(C) 29 | call print(D) 30 | call print(vector) 31 | call print(matrix) 32 | 33 | end program pretty_print 34 | -------------------------------------------------------------------------------- /src/lapack/libtt_common_lapack.f90: -------------------------------------------------------------------------------- 1 | !> Collection of common functions and/or subroutines for the tensortools 2 | !! library. 3 | module libtt_common_lapack 4 | 5 | use libtt_precision 6 | 7 | implicit none 8 | private 9 | 10 | public :: inverse 11 | 12 | contains 13 | 14 | !> Inverse of NxN Matrix 15 | !! Computed using LAPACK routines 16 | !! 17 | !! @param A NxN Matrix 18 | !! @return res Inverse of A 19 | function inverse(A) result(res) 20 | real(kind=dp), dimension(:,:) :: A 21 | real(kind=dp), dimension(size(A,1), size(A,2)) :: res 22 | 23 | real(kind=dp), dimension(size(A,1)) :: work 24 | integer, dimension(size(A,1)) :: ipiv 25 | integer :: n, info 26 | 27 | res = A 28 | n = size(A,1) 29 | ! SGETRF computes an LU factorization of a general M-by-N matrix A 30 | ! using partial pivoting with row interchanges. 31 | call SGETRF(n,n,res,n,ipiv,info) 32 | 33 | if (info.ne.0) stop 'Matrix is numerically singular!' 34 | 35 | ! SGETRI computes the inverse of a matrix using the LU factorization 36 | ! computed by SGETRF. 37 | call SGETRI(n,res,n,ipiv,work,n,info) 38 | if (info.ne.0) stop 'Matrix inversion failed!' 39 | 40 | end function inverse 41 | 42 | end module libtt_common_lapack 43 | 44 | -------------------------------------------------------------------------------- /tests/test_logical.pf: -------------------------------------------------------------------------------- 1 | module test_logical 2 | use funit 3 | use libtt_precision 4 | use libtt_logical 5 | use libtt_common, only: eye 6 | 7 | implicit none 8 | 9 | real(kind=dp), dimension(3,3) :: A 10 | 11 | contains 12 | 13 | @test 14 | subroutine assert_isDiagonal_true() 15 | 16 | A = eye() 17 | 18 | @assertTrue(isDiagonal(A)) 19 | end subroutine assert_isDiagonal_true 20 | 21 | @test 22 | subroutine assert_isDiagonal_false() 23 | 24 | A = 0.0d0 25 | A(1,2) = 1.0d0 26 | @assertFalse(isDiagonal(A)) 27 | end subroutine assert_isDiagonal_false 28 | 29 | @test 30 | subroutine assert_isSymmetric_true() 31 | 32 | A = 0.0d0 33 | A(1,1) = 1.2d0 34 | A(1,2) = 1.0d0 35 | A(1,3) = 5.0d0 36 | A(2,1) = A(1,2) 37 | A(3,1) = A(1,3) 38 | 39 | @assertTrue(isSymmetric(A)) 40 | end subroutine assert_isSymmetric_true 41 | 42 | @test 43 | subroutine assert_isSymmetric_false() 44 | 45 | A = 0.0d0 46 | A(1,1) = 1.2d0 47 | A(1,2) = 1.0d0 48 | A(1,3) = 5.0d0 49 | 50 | @assertFalse(isSymmetric(A)) 51 | end subroutine assert_isSymmetric_false 52 | 53 | @test 54 | subroutine assert_isSquare_true() 55 | 56 | call random_number(A) 57 | @assertTrue(isSquare(A)) 58 | end subroutine assert_isSquare_true 59 | 60 | @test 61 | subroutine assert_isSquare_false() 62 | real(kind=dp), dimension(2,3) :: B 63 | 64 | call random_number(B) 65 | 66 | @assertFalse(isSymmetric(B)) 67 | end subroutine assert_isSquare_false 68 | 69 | end module test_logical -------------------------------------------------------------------------------- /tests/test_voigt.pf: -------------------------------------------------------------------------------- 1 | module test_voigt 2 | use funit 3 | use libtt_precision, only: dp 4 | use libtt_common, only: symmetric 5 | use libtt_voigt, only: toVoigt, toVoigtNonSym, & 6 | toTensor, toTensorNonSym 7 | 8 | implicit none 9 | 10 | real(kind=dp), dimension(3,3) :: A 11 | 12 | contains 13 | 14 | @before 15 | subroutine set_up() 16 | A = reshape((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3,3/)) 17 | 18 | end subroutine 19 | 20 | @test 21 | subroutine assert_toVoigt2nd_nonSym() 22 | real(kind=dp), dimension(9) :: expected_result 23 | 24 | expected_result = (/1, 4, 7, 2, 5, 8, 3, 6, 9/) 25 | 26 | @assertEqual(expected_result, toVoigtNonSym(A)) 27 | end subroutine assert_toVoigt2nd_nonSym 28 | 29 | @test 30 | subroutine assert_toVoigt2nd() 31 | real(kind=dp), dimension(6) :: expected_result 32 | 33 | expected_result = (/1, 5, 9, 4, 8, 7/) 34 | 35 | @assertEqual(expected_result, toVoigt(A)) 36 | end subroutine assert_toVoigt2nd 37 | 38 | @test 39 | subroutine assert_toTensor2nd_nonSym() 40 | real(kind=dp), dimension(9) :: input = (/1, 4, 7, 2, 5, 8, 3, 6, 9/) 41 | 42 | @assertEqual(A, toTensorNonSym(input)) 43 | end subroutine assert_toTensor2nd_nonSym 44 | 45 | @test 46 | subroutine assert_toTensor2nd() 47 | real(kind=dp), dimension(6) :: input = (/1, 5, 9, 4, 8, 7/) 48 | real(kind=dp), dimension(3,3) :: expected_result 49 | 50 | expected_result = reshape((/1, 4, 7, 4, 5, 8, 7, 8, 9/),(/3,3/)) 51 | 52 | @assertEqual(expected_result, toTensor(input)) 53 | end subroutine assert_toTensor2nd 54 | end module test_voigt -------------------------------------------------------------------------------- /tests/test_physics_elasticity.pf: -------------------------------------------------------------------------------- 1 | module test_physics_elasticity 2 | use funit 3 | use libtt_precision 4 | use libtt_physics_elasticity 5 | 6 | implicit none 7 | 8 | real(kind=dp), dimension(3,3) :: defGrad 9 | 10 | contains 11 | 12 | @before 13 | subroutine set_up() 14 | 15 | defGrad = reshape((/1, 2, 3, 4, 5, 6, 7, 8, 9/),& 16 | (/3,3/)) 17 | 18 | end subroutine set_up 19 | 20 | 21 | @test 22 | subroutine assert_rightCauchyGreen() 23 | real(kind=dp), dimension(3,3) :: expected_rightCauchyGreen 24 | 25 | expected_rightCauchyGreen = reshape((/14, 32, 50, 32, 77, 122, 50, 122, 194/),& 26 | (/3,3/)) 27 | 28 | @assertEqual(expected_rightCauchyGreen, getRightCauchyGreen(defGrad)) 29 | end subroutine assert_rightCauchyGreen 30 | 31 | 32 | @test 33 | subroutine assert_leftCauchyGreen() 34 | real(kind=dp), dimension(3,3) :: expected_leftCauchyGreen 35 | 36 | expected_leftCauchyGreen = reshape((/66, 78, 90, 78, 93, 108, 90, 108, 126/),& 37 | (/3,3/)) 38 | 39 | @assertEqual(expected_leftCauchyGreen, getLeftCauchyGreen(defGrad)) 40 | end subroutine assert_leftCauchyGreen 41 | 42 | 43 | @test 44 | subroutine assert_greenLagrange() 45 | real(kind=dp), dimension(3,3) :: expected_result 46 | real(kind=dp), dimension(3,3) :: rightCauchyGreen 47 | 48 | expected_result = 0.5 * reshape((/13, 32, 50, 32, 76, 122, 50, 122, 193/),& 49 | (/3,3/)) 50 | 51 | rightCauchyGreen = getRightCauchyGreen(defGrad) 52 | 53 | @assertEqual(expected_result, getGreenLagrange(rightCauchyGreen)) 54 | end subroutine assert_greenLagrange 55 | 56 | end module test_physics_elasticity -------------------------------------------------------------------------------- /tests/test_common.pf: -------------------------------------------------------------------------------- 1 | module test_common 2 | use funit 3 | use libtt_precision 4 | use libtt_common, only: kronecker,trace,det,inverseMatrix 5 | 6 | implicit none 7 | 8 | real(kind=dp), dimension(3,3), parameter :: A = reshape((/1, 2, 3, & 9 | 4, 5, 6, & 10 | 7, 8, 9/),& 11 | (/3,3/)) 12 | 13 | contains 14 | 15 | @test 16 | subroutine assert_iEqualJReturnsOne() 17 | integer :: res 18 | 19 | res = kronecker(1,1) 20 | 21 | @assertTrue(res == 1) 22 | end subroutine assert_iEqualJReturnsOne 23 | 24 | 25 | @test 26 | subroutine assert_iNotEqualJReturnsZero() 27 | integer :: res 28 | 29 | res = kronecker(1,2) 30 | 31 | @assertTrue(res == 0) 32 | end subroutine assert_iNotEqualJReturnsZero 33 | 34 | !@test 35 | subroutine assert_failsIfNonSymmetric() 36 | real(kind=dp), dimension(2,1) :: A 37 | real(kind=dp) :: res 38 | 39 | A = 0.0d0 40 | res = trace(A) 41 | 42 | @assertExceptionRaised('Input must be symmetric!') 43 | 44 | end subroutine assert_failsIfNonSymmetric 45 | 46 | @test 47 | subroutine assert_result2x2() 48 | real(kind=dp), dimension(2,2) :: B 49 | 50 | B = reshape((/1, 2, 3, 4/), (/2, 2/)) 51 | 52 | @assertEqual(5, trace(B)) 53 | end subroutine assert_result2x2 54 | 55 | @test 56 | subroutine assert_result3x3() 57 | 58 | @assertEqual(15, trace(A)) 59 | end subroutine assert_result3x3 60 | 61 | @test 62 | subroutine assert_determinant() 63 | real(kind=dp), dimension(3,3), parameter :: B = reshape((/2, 2, 3, & 64 | 4, 5, 6, & 65 | 7, 8, 9/),& 66 | (/3,3/)) 67 | 68 | @assertEqual(-3.0d0, det(B)) 69 | end subroutine assert_determinant 70 | 71 | @test 72 | subroutine assert_inverseMatrix() 73 | real(kind=dp), dimension(2,2) :: A 74 | real(kind=dp), dimension(2,2) :: expected_result 75 | 76 | A = reshape((/2 ,1 ,-3 ,5/), (/2,2/)) 77 | expected_result = reshape((/ 5.0, -1.0, 3.0, 2.0 /), (/2,2/)) 78 | expected_result = expected_result / 13.0 79 | 80 | @assertEqual(expected_result, inverseMatrix(A)) 81 | end subroutine assert_inverseMatrix 82 | 83 | end module test_common -------------------------------------------------------------------------------- /src/libtt_logical.f90: -------------------------------------------------------------------------------- 1 | !> Colloction of logical functions/subroutines 2 | module libtt_logical 3 | 4 | use libtt_precision, only: dp 5 | 6 | implicit none 7 | private 8 | 9 | public :: isDiagonal 10 | public :: isSymmetric 11 | public :: isSquare 12 | 13 | contains 14 | 15 | !> Check if matrix/tensor is diagonal 16 | !! 17 | !! @param A Square matrix / tensor of 2nd order 18 | !! @þaram res Logical (True if A is diagonal) 19 | pure function isDiagonal(A) result(res) 20 | real(kind=dp), dimension(:,:), intent(in) :: A 21 | logical :: res 22 | integer :: i 23 | integer :: j 24 | real(kind=dp), parameter :: tol = 1.0d-12 25 | 26 | res = .TRUE. 27 | do i = 2,size(A,1),1 28 | do j = 1,(i-1),1 29 | if (abs(A(i,j)) >= tol .OR. abs(A(j,i)) >= tol) then 30 | res = .FALSE. 31 | return 32 | end if 33 | end do 34 | end do 35 | 36 | end function isDiagonal 37 | 38 | !> Check if matrix/tensor is symmetric 39 | !! 40 | !! @param A Square matrix / tensor of 2nd order 41 | !! @param res Logical (True if A is symmetric) 42 | pure function isSymmetric(A) result(res) 43 | real(kind=dp), dimension(:,:), intent(in) :: A 44 | logical :: res 45 | integer :: i 46 | integer :: j 47 | real(kind=dp), parameter :: tol = 1.0d-12 48 | 49 | res = .TRUE. 50 | do i = 2,size(A,1),1 51 | do j = 1,(i-1),1 52 | if (A(i,j) /= A(j,i)) then 53 | res = .FALSE. 54 | return 55 | end if 56 | end do 57 | end do 58 | 59 | end function isSymmetric 60 | 61 | !> Check if matrix is square 62 | !! 63 | !! @param A Matrix / tensor of 2nd order 64 | !! @param res Logical (True if A is square) 65 | pure function isSquare(A) result(res) 66 | real(kind=dp), dimension(:,:), intent(in) :: A 67 | logical :: res 68 | integer, dimension(2) :: shp 69 | 70 | shp = shape(A) 71 | if (shp(1) /= shp(2)) then 72 | res = .FALSE. 73 | return 74 | end if 75 | 76 | res = .TRUE. 77 | 78 | end function isSquare 79 | 80 | end module libtt_logical -------------------------------------------------------------------------------- /examples/common/main.f90: -------------------------------------------------------------------------------- 1 | ! A short program to demonstrate the module libtt_common 2 | program common_example 3 | 4 | ! Include packages needed for this example 5 | use libtt_precision, only: dp ! Compiler independent double precision 6 | use libtt_print, only: print ! Pretty printer for tensors 7 | use libtt_common ! Common tensor operations 8 | 9 | implicit none 10 | 11 | ! Define some variables for this example 12 | integer :: number 13 | real(kind=dp) :: scalar 14 | real(kind=dp), dimension(3) :: vector 15 | real(kind=dp), dimension(3,3) :: a 16 | real(kind=dp), dimension(3,3) :: b 17 | 18 | ! Set some random values for tensors and print it to screen 19 | call random_number(a) 20 | write(*,'(/,A)') "Examples for libtt_common!" 21 | write(*,'(A)') "The following operations are performed on the tensor:" 22 | call print(a) 23 | 24 | ! Kronecker delta function 25 | ! Returns 1 if index i equals index j and 0 else. 26 | write(*,'(/,A,/)') "1. Example: Kronecker delta function" 27 | number = kronecker(1,1) 28 | write(*,'(A, I1)') "Kronecker delta function of i=1 and j=1: ", number 29 | number = kronecker(2,4) 30 | write(*,'(A, I1)') "Kronecker delta function of i=2 and j=4: ", number 31 | 32 | ! Identity tensor 33 | write(*,'(/,A,/)') "2. Example: Identity tensor" 34 | call print(eye()) 35 | 36 | ! Trace of 2nd order tensor 37 | write(*,'(/,A,/)') "3. Example: Trace of a tensor" 38 | scalar = trace(a) 39 | write(*,'(A, F8.6)') "Trace of A: ", scalar 40 | 41 | ! Determinant of 2nd order tensor 42 | write(*,'(/,A,/)') "4. Example: Determinant of a tensor" 43 | scalar = det(a) 44 | write(*,'(A, F8.6)') "Determinant of A: ", scalar 45 | 46 | ! Symmetric part of 2nd order tensor 47 | write(*,'(/,A)') "5. Example: Symmetric part of a tensor" 48 | b = symmetric(a) 49 | call print(b) 50 | 51 | ! Skew symmetric part of 2nd order tensor 52 | write(*,'(/,A)') "6. Example: Skew-symmetric part of a tensor" 53 | b = skew(a) 54 | call print(b) 55 | 56 | ! Inverse of 2nd order tensor 57 | write(*,'(/,A)') "7. Example: Inverse of a 2nd order tensor" 58 | b = inverse(a) 59 | call print(b) 60 | 61 | ! Deviatoric part of a 2nd order tensor 62 | write(*,'(/,A)') "8. Example: Deviatoric part of a 2nd order tensor" 63 | b = dev(a) 64 | call print(b) 65 | 66 | ! Diag function 67 | write(*,'(/,A)') "9. Example: Diag function applied to 2nd order tensor" 68 | call print(diag(A)) 69 | 70 | ! Diag function 71 | write(*,'(/,A)') "10. Example: Diag function applied to 1st order tensor" 72 | vector = (/1,2,3/) 73 | b = diag(vector) 74 | call print(b) 75 | 76 | write(*,'(/,A, /)') "Thats it." 77 | end program common_example 78 | -------------------------------------------------------------------------------- /tests/test_products_doubleContract.pf: -------------------------------------------------------------------------------- 1 | module test_products_doubleContract 2 | use funit 3 | use libtt_precision 4 | use libtt_products 5 | 6 | implicit none 7 | 8 | real(kind=dp), dimension(3,3) :: A 9 | real(kind=dp), dimension(3,3) :: B 10 | real(kind=dp), dimension(3,3,3,3) :: C 11 | 12 | contains 13 | 14 | @before 15 | subroutine set_up() 16 | A = reshape((/1, 2, 3, 4, 5, 6, 7, 8, 9/),& 17 | (/3,3/)) 18 | B = reshape((/2, 4, 3, 5, 1, 2, 4, 3, 4/),& 19 | (/3,3/)) 20 | C = reshape((/2, 2, 3, 5, 1, 5, 2, 7, 4, & 21 | 1, 4, 7, 5, 2, 2, 4, 3, 5, & 22 | 4, 5, 8, 5, 4, 2, 4, 2, 7, & 23 | 3, 4, 6, 5, 3, 2, 8, 6, 4, & 24 | 7, 9, 3, 5, 9, 2, 9, 3, 2, & 25 | 5, 3, 2, 5, 5, 2, 4, 4, 6, & 26 | 3, 0, 3, 5, 2, 2, 7, 3, 5, & 27 | 1, 2, 4, 1, 1, 2, 9, 8, 4, & 28 | 1, 4, 3, 1, 5, 2, 4, 3, 4/),& 29 | (/3,3,3,3/)) 30 | end subroutine set_up 31 | 32 | 33 | @test 34 | subroutine assert_rank22() 35 | real(kind=dp) :: result 36 | real(kind=dp), parameter :: expectedResult = 144.0d0 37 | 38 | @assertEqual(expectedResult, doubleContract(A, B)) 39 | end subroutine assert_rank22 40 | 41 | @test 42 | subroutine assert_rank22_operator() 43 | real(kind=dp) :: result 44 | real(kind=dp), parameter :: expectedResult = 144.0d0 45 | 46 | @assertEqual(expectedResult, A.ddot.B) 47 | end subroutine assert_rank22_operator 48 | 49 | @test 50 | subroutine assert_rank24() 51 | real(kind=dp), dimension(3,3) :: expectedResult 52 | 53 | expectedResult = reshape((/176, 169, 197, 216, 216, 188, 172, 201, 147/), (/3,3/)) 54 | 55 | @assertEqual(expectedResult, doubleContract(A, C)) 56 | end subroutine assert_rank24 57 | 58 | @test 59 | subroutine assert_rank24_operator() 60 | real(kind=dp), dimension(3,3) :: expectedResult 61 | 62 | expectedResult = reshape((/176, 169, 197, 216, 216, 188, 172, 201, 147/), (/3,3/)) 63 | 64 | @assertEqual(expectedResult, A.ddot.C) 65 | end subroutine assert_rank24_operator 66 | 67 | @test 68 | subroutine assert_rank42() 69 | real(kind=dp), dimension(3,3) :: expectedResult 70 | 71 | expectedResult = reshape((/131, 156, 172, 157, 171, 93, 280, 194, 200/), (/3,3/)) 72 | 73 | @assertEqual(expectedResult, doubleContract(C, A)) 74 | end subroutine assert_rank42 75 | 76 | @test 77 | subroutine assert_rank42_operator() 78 | real(kind=dp), dimension(3,3) :: expectedResult 79 | 80 | expectedResult = reshape((/131, 156, 172, 157, 171, 93, 280, 194, 200/), (/3,3/)) 81 | 82 | @assertEqual(expectedResult, C.ddot.A) 83 | end subroutine assert_rank42_operator 84 | 85 | end module test_products_doubleContract -------------------------------------------------------------------------------- /tests/test_solvers.pf: -------------------------------------------------------------------------------- 1 | module test_solvers 2 | use funit 3 | use libtt_precision , only: dp 4 | use libtt_solvers_gauss, only: gauss 5 | use libtt_solvers_eigenproblem, only: powerMethod, jacobi 6 | 7 | implicit none 8 | 9 | real(kind=dp), dimension(3,3) :: A 10 | real(kind=dp), dimension(3) :: b 11 | 12 | contains 13 | 14 | @before 15 | subroutine set_up() 16 | b = (/3, 3, 10/) 17 | A = reshape((/1, 3, 2, 2, 4, 10, 1, 0, 4/),& 18 | (/3,3/)) 19 | end subroutine set_up 20 | 21 | @test 22 | subroutine assert_gauss_result() 23 | 24 | call gauss(A, b) 25 | @assertEqual((/1, 0, 2/), b) 26 | 27 | end subroutine assert_gauss_result 28 | 29 | @test 30 | subroutine assert_gauss_matrix() 31 | real(kind=dp), dimension(3,3) :: expected_result 32 | 33 | expected_result = reshape((/3.0, 0.0, 0.0, 4.0, 22.0/3.0, 0.0, 0.0, 4.0, 7.0/11.0/),(/3,3/)) 34 | call gauss(A) 35 | @assertEqual(expected_result, A, tolerance=1.0d-5) 36 | 37 | end subroutine assert_gauss_matrix 38 | 39 | @test 40 | subroutine assert_powerMethod_vector() 41 | real(kind=dp), dimension(3) :: expected_result 42 | real(kind=dp) :: eigVal 43 | 44 | expected_result = (/0.23570226, 0.23570226, 0.94280904/) 45 | b = (/1,1,1/) 46 | call powerMethod(A, b, eigVal) 47 | 48 | @assertEqual(expected_result, b, tolerance=1.0d-5) 49 | end subroutine assert_powerMethod_vector 50 | 51 | @test 52 | subroutine assert_powerMethod_value() 53 | real(kind=dp) :: expected_result 54 | real(kind=dp) :: eigVal 55 | 56 | expected_result = 7.0d0 57 | b = (/1,1,1/) 58 | call powerMethod(A, b, eigVal) 59 | 60 | @assertEqual(expected_result, eigVal, tolerance=1.0d-5) 61 | end subroutine assert_powerMethod_value 62 | 63 | @test 64 | subroutine assert_jacobi_values() 65 | real(kind=dp), dimension(3,3) :: eigvec 66 | real(kind=dp), dimension(3) :: eigval 67 | real(kind=dp), dimension(3) :: expected_result 68 | 69 | A = reshape((/1,20,15,20,2,12,15,12,8/), (/3,3/)) 70 | expected_result = (/-18.8189675270, 35.012481662172, -5.19351413511/) 71 | call jacobi(A, eigvec, eigval) 72 | 73 | @assertEqual(expected_result, eigval, tolerance=1.0d-5) 74 | 75 | end subroutine assert_jacobi_values 76 | 77 | @test 78 | subroutine assert_jacobi_vectors() 79 | real(kind=dp), dimension(3,3) :: eigvec 80 | real(kind=dp), dimension(3) :: eigval 81 | real(kind=dp), dimension(3,3) :: expected_result 82 | 83 | A = reshape((/1,20,15,20,2,12,15,12,8/), (/3,3/)) 84 | 85 | expected_result = reshape((/0.75159970, -0.64645589, -0.13112081, & 86 | 0.58777957, 0.56616323, 0.57790515, & 87 | -0.29935441, -0.51142348, 0.80550169/), (/3,3/)) 88 | call jacobi(A, eigvec, eigval) 89 | 90 | @assertEqual(expected_result, eigvec, tolerance=1.0d-5) 91 | end subroutine assert_jacobi_vectors 92 | 93 | end module test_solvers -------------------------------------------------------------------------------- /src/libtt_exception.f90: -------------------------------------------------------------------------------- 1 | !> Exception module 2 | !! Provides implementation of exceptions to use it with pfUnit. 3 | !! Taken from pfUnit examples. 4 | module libtt_exception 5 | implicit none 6 | private 7 | 8 | public :: throw_exception 9 | public :: set_throw_method 10 | 11 | abstract interface 12 | subroutine throw(filename, line_number, message) 13 | character(len=*), intent(in) :: filename 14 | integer, intent(in) :: line_number 15 | character(len=*), optional, intent(in) :: message 16 | end subroutine throw 17 | end interface 18 | 19 | procedure (throw), pointer :: throw_method => null() 20 | logical, save :: initialized = .false. 21 | 22 | contains 23 | 24 | subroutine initialize() 25 | throw_method => Fail 26 | initialized = .true. 27 | end subroutine initialize 28 | 29 | subroutine set_throw_method(method) 30 | procedure (throw) :: method 31 | if (.not. initialized) call initialize() 32 | throw_method => method 33 | end subroutine set_throw_method 34 | 35 | subroutine throw_exception(filename, line_number, message) 36 | character(len=*), intent(in) :: filename 37 | integer, intent(in) :: line_number 38 | character(len=*), optional, intent(in) :: message 39 | 40 | if (.not. initialized) then 41 | call initialize() 42 | end if 43 | 44 | call throw_method(filename, line_number, message=message) 45 | 46 | end subroutine throw_exception 47 | 48 | 49 | subroutine Fail(filename, line, message) 50 | use, intrinsic :: iso_fortran_env, only: ERROR_UNIT 51 | character(*), intent(in) :: filename 52 | integer, intent(in) :: line 53 | character(*), optional, intent(in) :: message 54 | 55 | integer, parameter :: FIELD_WIDTH=40 56 | character(FIELD_WIDTH) :: use_name 57 | character(3) :: prefix 58 | character(:), allocatable :: base_name 59 | 60 | base_name = get_base_name(filename) 61 | if (len(base_name) > FIELD_WIDTH) then 62 | prefix = '...' 63 | use_name = base_name(2:) 64 | else 65 | prefix = ' ' 66 | use_name = base_name 67 | end if 68 | 69 | write(ERROR_UNIT,'(a,i5.5,1x,1x,a3,a80,1x,a)') & 70 | & 'FAIL at line=', line, prefix, use_name, & 71 | & '<'//adjustl(trim(message))//'>' 72 | 73 | end subroutine Fail 74 | 75 | function get_short_name(filename, maxlen) result(short_name) 76 | character(:), allocatable :: short_name 77 | character(*), intent(in) :: filename 78 | integer, optional, intent(in) :: maxlen 79 | integer, parameter :: MAX_LEN_SHORT_NAME = 60 80 | 81 | integer :: maxlen_ 82 | integer :: n 83 | 84 | maxlen_ = MAX_LEN_SHORT_NAME 85 | if (present(maxlen)) maxlen_ = maxlen 86 | 87 | n = len_trim(filename) 88 | short_name = filename(max(1,n+1-maxlen_):) 89 | 90 | end function get_short_name 91 | 92 | function get_base_name(filename) result(base_name) 93 | character(:), allocatable :: base_name 94 | character(*), intent(in) :: filename 95 | 96 | integer :: idx 97 | 98 | idx = scan(filename, '/', back=.true.) 99 | 100 | base_name = filename(idx+1:) 101 | 102 | end function get_base_name 103 | 104 | end module libtt_exception -------------------------------------------------------------------------------- /src/libtt_print.f90: -------------------------------------------------------------------------------- 1 | module libtt_print 2 | 3 | use libtt_precision, only: dp 4 | 5 | implicit none 6 | private 7 | 8 | public :: print 9 | 10 | interface print 11 | module procedure print0th 12 | module procedure print1st 13 | module procedure print2nd 14 | module procedure print3rd 15 | module procedure print4th 16 | end interface print 17 | 18 | contains 19 | 20 | subroutine print0th(a) 21 | real(kind=dp), intent(in) :: a 22 | 23 | call print_tensorInfo(0) 24 | write(*,'(6X, F16.8)') a 25 | 26 | end subroutine print0th 27 | 28 | subroutine print1st(a) 29 | real(kind=dp), dimension(:), intent(in) :: a 30 | 31 | if (size(a,1) == 3) then 32 | call print_tensorInfo(1) 33 | else 34 | call print_matrixInfo(shape(a)) 35 | end if 36 | 37 | call print_vector(a) 38 | 39 | end subroutine print1st 40 | 41 | subroutine print2nd(a) 42 | real(kind=dp), dimension(:,:), intent(in) :: a 43 | 44 | if (size(a,1) == 3 .and. size(a,2) == 3) then 45 | call print_tensorInfo(2) 46 | else 47 | call print_matrixInfo(shape(a)) 48 | end if 49 | call print_matrix(a) 50 | 51 | end subroutine print2nd 52 | 53 | subroutine print3rd(a) 54 | real(kind=dp), dimension(3,3,3), intent(in) :: a 55 | integer :: i 56 | 57 | call print_tensorInfo(3) 58 | 59 | do i = 1,3,1 60 | call print_subsetinfo((/i/), 3) 61 | call print_matrix(a(i,:,:)) 62 | end do 63 | 64 | end subroutine print3rd 65 | 66 | subroutine print4th(a) 67 | real(kind=dp), dimension(3,3,3,3), intent(in) :: a 68 | integer :: i 69 | integer :: j 70 | 71 | call print_tensorInfo(4) 72 | 73 | do i = 1,3,1 74 | do j = 1,3,1 75 | call print_subsetinfo((/i, j/), 4) 76 | call print_matrix(a(i,j,:,:)) 77 | end do 78 | end do 79 | 80 | end subroutine print4th 81 | 82 | subroutine print_matrix(a) 83 | real(kind=dp), dimension(:,:) :: a 84 | integer :: i 85 | integer :: j 86 | do i = 1,size(a,1),1 87 | do j = 1,size(a,2),1 88 | if (j == 1) then 89 | write(*,'(6X, F16.8)', advance="no") a(i,j) 90 | else if (j == size(a,2)) then 91 | write(*,'(F16.8)') a(i,j) 92 | else 93 | write(*,'(F16.8)', advance="no") a(i,j) 94 | end if 95 | end do 96 | end do 97 | 98 | end subroutine print_matrix 99 | 100 | subroutine print_vector(a) 101 | real(kind=dp), dimension(:), intent(in) :: a 102 | integer :: i 103 | 104 | do i = 1,size(a,1),1 105 | write(*, '(6X, F16.8)') a(i) 106 | end do 107 | 108 | end subroutine print_vector 109 | 110 | subroutine print_matrixInfo(dim) 111 | integer, dimension(:), intent(in) :: dim 112 | 113 | if (size(dim) == 1) then 114 | write(*,'(/, A, I1, A)') "Vector of dimension ", dim(1), ":" 115 | else 116 | write(*,'(/, A, I1, A, I1, A)') "Matrix of dimension ", dim(1), "x", dim(2), ":" 117 | end if 118 | 119 | end subroutine print_matrixInfo 120 | 121 | subroutine print_tensorInfo(rank) 122 | integer, intent(in) :: rank 123 | 124 | write(*,'(/, 3X, A, I1, A)') "Tensor of rank ", rank, ":" 125 | 126 | end subroutine print_tensorInfo 127 | 128 | subroutine print_subsetinfo(subset,rank) 129 | integer, dimension(:), intent(in) :: subset 130 | integer, intent(in) :: rank 131 | 132 | select case(rank) 133 | case (3) 134 | write(*,'(/, 3X, A, I1, A)') "Dimension (", subset(1), ",:,:):" 135 | case (4) 136 | write(*,'(/, 3X, A, I1, A, I1, A)') "Dimension (", subset(1), ",", subset(2), ",:,:):" 137 | end select 138 | 139 | end subroutine print_subsetinfo 140 | 141 | end module libtt_print -------------------------------------------------------------------------------- /tests/test_tensors_common.pf: -------------------------------------------------------------------------------- 1 | module test_tensors_common 2 | use funit 3 | use libtt_precision 4 | use libtt_common 5 | 6 | implicit none 7 | 8 | real(kind=dp), dimension(3,3) :: expected_result 9 | real(kind=dp), dimension(3,3) :: A 10 | real(kind=dp), dimension(3,3) :: B 11 | 12 | contains 13 | 14 | @before 15 | subroutine set_up() 16 | 17 | A = reshape((/1, 2, 3, & 18 | 4, 5, 6, & 19 | 7, 8, 9/),& 20 | (/3,3/)) 21 | 22 | B = reshape((/1, 0, 0, & 23 | 0, 0, 0, & 24 | 0, 0, 0/),& 25 | (/3,3/)) 26 | 27 | end subroutine set_up 28 | 29 | @test 30 | subroutine assert_eye() 31 | expected_result = reshape((/1, 0, 0, 0, 1, 0, 0, 0, 1/),& 32 | (/3,3/)) 33 | 34 | @assertEqual(expected_result, eye()) 35 | end subroutine assert_eye 36 | 37 | @test 38 | subroutine assert_eye_nDim() 39 | real(kind=dp), dimension(2,2) :: expected_result 40 | expected_result = reshape((/1, 0, 0, 1/),& 41 | (/2,2/)) 42 | 43 | @assertEqual(expected_result, eye(2)) 44 | end subroutine assert_eye_nDim 45 | 46 | !@test 47 | !subroutine assert_eye_4() 48 | ! real(kind=dp), dimension(3,3,3,3) :: expected_result 49 | ! expected_result = reshape((/1, 0, 0, 1/),& 50 | ! (/2,2/)) 51 | 52 | !@assertEqual(expected_result, eye_4()) 53 | !end subroutine assert_eye_4 54 | 55 | @test 56 | subroutine assert_symmetric() 57 | 58 | expected_result = reshape((/1, 3, 5, 3, 5, 7, 5, 7, 9/),& 59 | (/3,3/)) 60 | 61 | @assertEqual(expected_result, symmetric(A)) 62 | end subroutine assert_symmetric 63 | 64 | 65 | @test 66 | subroutine assert_skew() 67 | 68 | expected_result = reshape((/0, -1, -2, 1, 0, -1, 2, 1, 0/),& 69 | (/3,3/)) 70 | 71 | @assertEqual(expected_result, skew(A)) 72 | end subroutine assert_skew 73 | 74 | 75 | @test 76 | subroutine assert_skewPlusSymmetric() 77 | 78 | expected_result = A 79 | @assertEqual(expected_result, skew(A)+symmetric(A)) 80 | end subroutine assert_skewPlusSymmetric 81 | 82 | 83 | @test 84 | subroutine assert_inverse() 85 | real(kind=dp), dimension(3,3), parameter :: B = reshape((/2, 2, 3, & 86 | 4, 5, 6, & 87 | 7, 8, 9/),& 88 | (/3,3/)) 89 | 90 | expected_result = reshape((/1.0d0, -2.0d0, 1.0d0, & 91 | -2.0d0, 1.0d0, 0.0d0, & 92 | 1.0d0, 2.0d0/3.0d0, -2.0d0/3.0d0/),& 93 | (/3,3/)) 94 | 95 | @assertEqual(expected_result, inverse(B)) 96 | end subroutine assert_inverse 97 | 98 | 99 | @test 100 | subroutine assert_diag_returnsDiagonalElements() 101 | 102 | @assertEqual((/1, 5, 9/), diag(A)) 103 | end subroutine assert_diag_returnsDiagonalElements 104 | 105 | 106 | @test 107 | subroutine assert_diag_buildsDiagonalTensor() 108 | real(kind=dp), dimension(3,3) :: B 109 | 110 | B = reshape((/1, 0, 0, 0, 5, 0, 0, 0, 9/), (/3,3/)) 111 | 112 | @assertEqual(B, diag((/1.0d0, 5.0d0, 9.0d0/))) 113 | end subroutine assert_diag_buildsDiagonalTensor 114 | 115 | 116 | @test 117 | subroutine assert_dev() 118 | real(kind=dp), dimension(3,3) :: B 119 | 120 | B = reshape((/-4, 2, 3, 4, 0, 6, 7, 8, 4/), (/3,3/)) 121 | 122 | @assertEqual(B, dev(A)) 123 | end subroutine assert_dev 124 | 125 | @test 126 | subroutine assert_principal_invariants() 127 | real(kind=dp), dimension(3) :: expected_result 128 | 129 | expected_result = (/15.0, -18.0, 0.0/) 130 | @assertEqual(expected_result, invariants(A)) 131 | end subroutine assert_principal_invariants 132 | 133 | @test 134 | subroutine assert_mixed_invariants() 135 | real(kind=dp), dimension(5) :: expected_result 136 | 137 | expected_result = (/15.0, -18.0, 0.0, 1.0, 30.0/) 138 | @assertEqual(expected_result, invariants(A, B)) 139 | end subroutine assert_mixed_invariants 140 | 141 | end module test_tensors_common -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | # CMake Configuration file for TensorTools library 2 | # 3 | # Version: 0.1.0 (04/2020) 4 | # Author: Lukas Lamm 5 | 6 | #----------------------------------------------------------------------# 7 | # Define Cmake version 8 | #----------------------------------------------------------------------# 9 | cmake_minimum_required(VERSION 3.1...3.15) 10 | if(${CMAKE_VERSION} VERSION_LESS 3.12) 11 | cmake_policy(VERSION ${CMAKE_MAJOR_VERSION}.${CMAKE_MINOR_VERSION}) 12 | endif() 13 | 14 | #----------------------------------------------------------------------# 15 | # Set default installation directory 16 | #----------------------------------------------------------------------# 17 | #if (CMAKE_INSTALL_PREFIX_INITIALIZED_TO_DEFAULT) 18 | # set (CMAKE_INSTALL_PREFIX "${CMAKE_BINARY_DIR}/install" CACHE PATH "default install path" FORCE) 19 | # message(STATUS "LIBTT: Setting default install prefix to ${CMAKE_INSTALL_PREFIX} \n 20 | # Override with -DCMAKE_INSTALL_PREFIX=.") 21 | #endif() 22 | 23 | #----------------------------------------------------------------------# 24 | # Project & language definition 25 | #----------------------------------------------------------------------# 26 | project(TensorTools VERSION 0.1.0 27 | DESCRIPTION "A small modern fortran library for tensor calculus" 28 | LANGUAGES NONE) 29 | enable_language(Fortran) 30 | 31 | #----------------------------------------------------------------------# 32 | # Set default compilaation to debug 33 | #----------------------------------------------------------------------# 34 | if(NOT DEFINED CMAKE_BUILD_TYPE) 35 | set(CMAKE_BUILD_TYPE Debug 36 | CACHE STRING "Choose type of build: Debug") 37 | else() 38 | set(CMAKE_BUILD_TYPE ${CMAKE_BUILD_TYPE} 39 | CACHE STRING "Choose type of build: ${CMAKE_BUILD_TYPE}") 40 | endif() 41 | 42 | #----------------------------------------------------------------------# 43 | # Set compiler options 44 | #----------------------------------------------------------------------# 45 | include(cmake_config/${CMAKE_Fortran_COMPILER_ID}.cmake RESULT_VARIABLE found) 46 | 47 | if(NOT found) 48 | message(FATAL_ERROR "Unrecognized Fortran compiler. Only gfortran and ifort are supperted!") 49 | else() 50 | message(STATUS "${CMAKE_Fortran_COMPILER_ID} compiler selected.") 51 | endif() 52 | 53 | #----------------------------------------------------------------------# 54 | # Set directory for Fortran modules 55 | #----------------------------------------------------------------------# 56 | set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/modules) 57 | 58 | #----------------------------------------------------------------------# 59 | # Find LAPACK 60 | #----------------------------------------------------------------------# 61 | option(LIBTT_LAPACK "Enable/Disable Lapack routines" OFF) 62 | if(LIBTT_LAPACK) 63 | find_package(LAPACK) 64 | if(NOT LAPACK_FOUND) 65 | message(FATAL_ERROR "LAPACK not found! Please install Lapack first!") 66 | endif() 67 | else() 68 | message(STATUS "No Lapack routines will be build. \n Enable with -DLIBTT_LAPACK=ON") 69 | endif() 70 | 71 | #----------------------------------------------------------------------# 72 | # Add subdirectories 73 | #----------------------------------------------------------------------# 74 | # Source files 75 | add_subdirectory(src) 76 | 77 | #----------------------------------------------------------------------# 78 | # Testing 79 | # Examples: https://github.com/Goddard-Fortran-Ecosystem/pFUnit_demos/tree/main/Basic 80 | #----------------------------------------------------------------------# 81 | option(LIBTT_TESTS "Enable/disable testing framework" OFF) 82 | if(LIBTT_TESTS) 83 | find_package(PFUNIT REQUIRED) 84 | enable_testing() 85 | add_subdirectory(tests) 86 | message(STATUS "LIBTT: Tests enabled \n Override with -DLIBTT_TESTS=OFF") 87 | endif() 88 | 89 | #----------------------------------------------------------------------# 90 | # Documentation 91 | # Only enable documentation if it is the main package 92 | # Needed: doxygen & graphviz 93 | #----------------------------------------------------------------------# 94 | option(LIBTT_DOCS "Enable/disable documentation" OFF) 95 | if((CMAKE_PROJECT_NAME STREQUAL PROJECT_NAME) AND LIBTT_DOCS) 96 | find_package(Doxygen) 97 | if(Doxygen_FOUND) 98 | add_subdirectory(docs) 99 | message(STATUS "LIBTT: Documentation enabled \n Override with -DLIBTT_DOCS=OFF") 100 | else() 101 | message(STATUS "LIBTT: Doxygen not found, not building docs") 102 | endif() 103 | endif() 104 | 105 | 106 | 107 | #----------------------------------------------------------------------# 108 | # Installation 109 | #----------------------------------------------------------------------# 110 | #install(FILES) -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # TensorTools 2 | [![Build Status](https://jenkins.llamm.de/buildStatus/icon?job=tensor_tools_2%2Fmaster)](https://jenkins.llamm.de/job/tensor_tools_2/job/master/) 3 | ![](https://img.shields.io/badge/license-LGPL--V2.1-blue) 4 | 5 | A modern Fortran library for tensor calculus. 6 | 7 | ## Getting started 8 | The following instructions will give you a copy of the project up and running on your local machine. 9 | Notice, this library is only tested on Unix like operating systems (e.g. Linux, MacOs), Windows is not supported at the moment. 10 | 11 | ### Download 12 | To get the latest version of this package, you can easily clone this repository by using 13 | ``` 14 | git clone https://github.com/llamm-de/tensor_tools.git 15 | ``` 16 | 17 | ### Prerequisites & Dependencies 18 | This package uses [CMake](https://cmake.org/) for the creation of build files. In order to build this package yourself, you would need to have CMake installed on your system. 19 | 20 | Some optional third party dependencies are: 21 | 22 | * [**pFUnit**](https://github.com/Goddard-Fortran-Ecosystem/pFUnit) (Optional) - To run the unit test for TensorTools 23 | * [**Doxygen**](https://www.doxygen.nl/) (Optional) - To automatically build the documentation of TensorTools 24 | * [**LAPACK**](http://www.netlib.org/lapack/) (Optional) - To use the more advanced and performance oriented algorithms in TensorTools 25 | 26 | These dependencies are disabled by default. If you wish to use them, you can activate them by providing the options ```LIBTT_TESTS=ON```, ```LIBTT_LAPACK=ON``` and/or ```LIBTT_DOCS=ON``` when running CMake. 27 | 28 | ### Build & Installation 29 | First create a build directory 30 | ``` 31 | mkdir build 32 | ``` 33 | within the directory you cloned TensorTools into. Next run Cmake to configure the build files, i.e. 34 | ``` 35 | cd build 36 | cmake -DCMAKE_INSTALL_PREFIX= .. 37 | ``` 38 | Here, you have to specify the installation path explicitly. If you did not specify the path, the executable will be build into the build directory you just created. 39 | 40 | Finally you can compile and install TensorTools by calling 41 | ``` 42 | make 43 | ``` 44 | Congratulations, now you should be able to include the installed library into your projects. 45 | 46 | ### Include TensorTools into your project 47 | There are various possibilities to include the tensor tools library into your own project. A few of them are listed below. 48 | 49 | #### Use CMake 50 | The most easy way to include TensorTools to your poject is available if your project is build using CMake. 51 | 52 | #### Link against a static labrary 53 | After having build the static library as described above, you only have to tell your linker where to find the ```libtt.a``` file. 54 | 55 | #### Copy source files 56 | If you do not want to care about setting up CMake or configuring your build link against a static library, you can also use the quick and dirty way by copying the source files directly into your projects source directory. 57 | 58 | ## LAPACK routines 59 | TensorTools offers some advanced and/or computational efficient routines which are based on the LAPACK library for linear algebra. The build of these routines is disabled by default. If you want to use them, you would need to set the corresponding option when running CMake, e.g. 60 | ``` 61 | cmake -DLIBTT_LAPACK=ON .. 62 | ``` 63 | 64 | ## Testing 65 | If you want to run the tests for this framework, let CMake generate your build files and compile everything using 66 | ``` 67 | cmake -DLIBTT_TESTS=ON -DCMAKE_PREFIX_PATH= .. 68 | make 69 | ``` 70 | Now you can run the tests by calling 71 | ``` 72 | ctest 73 | ``` 74 | from the build directory. 75 | 76 | ## Examples 77 | You can find examples on the functionality of this library within the ```examples``` directory. To run an example, got to the directory of the desired example and run the prepared shell script, e.g. 78 | ``` 79 | ./run_example.sh 80 | ``` 81 | This will build and execute the desired example for you. 82 | 83 | ## Documentation 84 | If you want to create a documentation for this framework, let CMake generate your build files and compile everything using 85 | ``` 86 | cmake -DLIBTT_DOCS=ON .. 87 | ``` 88 | Now you can create the documentation by calling 89 | ``` 90 | make docs 91 | ``` 92 | from the build directory. 93 | 94 | ## Versioning 95 | We use [SemVer](http://semver.org/) for versioning. 96 | 97 | ## Contributing 98 | If you wish to contribute to this project, feel free to report issues on GitHub or to even fork and open a pull request. 99 | 100 | ### Main authors 101 | * [**Lukas Lamm**](https://www.llamm.de) - Just some random guy working with computers 102 | 103 | ## License & Copyright 104 | This project is licensed under the LGPL License - see the [LICENSE.md](LICENSE.md) file for details. 105 | 106 | Copyright © 2020 by Lukas Lamm 107 | -------------------------------------------------------------------------------- /src/libtt_solvers_eigenproblem.f90: -------------------------------------------------------------------------------- 1 | !> Module of procedures to solve eigenvalue /-vector problems 2 | module libtt_solvers_eigenproblem 3 | 4 | use libtt_precision, only: dp 5 | 6 | implicit none 7 | private 8 | 9 | public :: powerMethod 10 | public :: jacobi 11 | 12 | contains 13 | 14 | !> Power method to solve for largest eigenvalue-eigenvector pair 15 | !! 16 | !! @param A NxN Matrix 17 | !! @param x Startvector / Eigenvector 18 | !! @param eigVal Dominant eigenvalue of A 19 | subroutine powerMethod(A, x, eigVal) 20 | real(kind=dp), dimension(:,:) :: A 21 | real(kind=dp), dimension(:) :: x 22 | real(kind=dp) :: eigVal 23 | real(kind=dp) :: tolerance 24 | integer :: maxIter 25 | integer :: iter 26 | real(kind=dp) :: delta 27 | real(kind=dp), dimension(:), allocatable :: y 28 | real(kind=dp) :: eigVal_old 29 | logical :: flag 30 | 31 | tolerance = 1.0d-12 32 | maxIter = 10**2 33 | 34 | ! Initialization 35 | allocate(y(size(x,1))) 36 | x = x/norm2(x) 37 | iter = 0 38 | delta = 2*tolerance 39 | eigVal_old = 0.0d0 40 | 41 | ! Main iteration 42 | do while (iter <= maxIter .AND. delta >= tolerance) 43 | 44 | y = matmul(A,x) 45 | 46 | ! Eigenvector 47 | x = y/norm2(y) 48 | 49 | ! Eigenvalue 50 | eigVal = dot_product(x, matmul(A,x)) 51 | 52 | if (iter > 0) then 53 | delta = abs(eigVal - eigVal_old) 54 | end if 55 | 56 | iter = iter + 1 57 | eigVal_old = eigVal 58 | 59 | end do 60 | 61 | ! Error handling 62 | if (iter == maxIter .AND. delta >= tolerance) then 63 | error stop "ERROR in POWERMETHOD: Solution did not converge!" 64 | end if 65 | 66 | deallocate(y) 67 | 68 | end subroutine 69 | 70 | !> Jacobi method to compute eigenvalues/-vectors for symmetric tensors/matrices 71 | !! Results are not sorted! 72 | !! 73 | !! @param A Symmetric NxN Matrix 74 | !! @param eigvec Array of eigenvectors of A 75 | !! @param eigval Array of eigenvalues of A 76 | subroutine jacobi(A, eigvec, eigval) 77 | 78 | use libtt_common, only: eye, diag 79 | use libtt_logical, only: isSquare, isSymmetric, isDiagonal 80 | use libtt_constants, only: pi 81 | 82 | real(kind=dp), dimension(:,:), intent(in) :: A 83 | real(kind=dp), dimension(:,:) :: eigvec 84 | real(kind=dp), dimension(:) :: eigval 85 | 86 | real(kind=dp), dimension(:,:), allocatable :: B 87 | integer :: n 88 | integer :: i 89 | real(kind=dp) :: pivot 90 | real(kind=dp) :: max 91 | real(kind=dp) :: theta 92 | real(kind=dp) :: factor 93 | real(kind=dp), dimension(:,:), allocatable :: Q 94 | integer, dimension(2) :: idx 95 | 96 | if ((.NOT.isSquare(A)) .OR. (.NOT.isSymmetric(A))) then 97 | error stop "ERROR in JACOBI EIGENVALUE: Matrix is not square or symmetric!" 98 | end if 99 | 100 | n = size(A, 1) 101 | 102 | allocate(Q(n,n)) 103 | allocate(B(n,n)) 104 | 105 | B = A 106 | eigvec = eye(n) 107 | 108 | do while (.NOT. isDiagonal(B)) 109 | 110 | pivot = 0.0 111 | idx = 0 112 | 113 | ! Get maximum pivot element 114 | do i = 2,n,1 115 | max = maxval(abs(B(i, 1:(i-1)))) 116 | if (max > pivot) then 117 | pivot = maxval(abs(B(i, 1:(i-1)))) 118 | idx(2) = maxloc(abs(B(i, 1:(i-1))), 1) 119 | idx(1) = i 120 | end if 121 | end do 122 | 123 | ! Construct rotational matrix Q 124 | theta = 0.0 125 | if (B(idx(1), idx(1)) /= B(idx(2), idx(2))) then 126 | factor = 2 * B(idx(1), idx(2)) / (B(idx(2), idx(2)) - B(idx(1), idx(1))) 127 | theta = 0.5 * atan(factor) 128 | else 129 | theta = 0.25 * pi 130 | end if 131 | Q = eye(n) 132 | Q(idx(1), idx(1)) = cos(theta) 133 | Q(idx(1), idx(2)) = sin(theta) 134 | Q(idx(2), idx(2)) = cos(theta) 135 | Q(idx(2), idx(1)) = -sin(theta) 136 | 137 | ! Perform linearization step 138 | eigvec = matmul(eigvec, Q) 139 | B = matmul(transpose(Q), matmul(B, Q)) 140 | end do 141 | 142 | do i =1,n,1 143 | eigval(i) = B(i,i) 144 | end do 145 | 146 | ! Clean up 147 | deallocate(Q) 148 | deallocate(B) 149 | 150 | end subroutine jacobi 151 | 152 | 153 | end module libtt_solvers_eigenproblem 154 | -------------------------------------------------------------------------------- /tests/test_products_dyadic.pf: -------------------------------------------------------------------------------- 1 | module test_products_dyadic 2 | use funit 3 | use libtt_precision 4 | use libtt_products, only: dyad, operator(.dyad.) 5 | 6 | implicit none 7 | 8 | real(kind=dp), dimension(3) :: A 9 | real(kind=dp), dimension(3,3) :: B 10 | real(kind=dp), dimension(3,3,3) :: C 11 | 12 | contains 13 | 14 | @before 15 | subroutine set_up() 16 | A = (/1, 2, 3/) 17 | B = reshape((/2, 4, 3, 5, 1, 2, 4, 3, 4/),& 18 | (/3,3/)) 19 | C = reshape((/2, 4, 3, 5, 1, 2, 4, 3, 4, & 20 | 1, 2, 4, 3, 5, 6, 4, 5, 9, & 21 | 3, 2, 5, 8, 7, 1, 2, 7, 5/),& 22 | (/3,3,3/)) 23 | end subroutine set_up 24 | 25 | 26 | @test 27 | subroutine assert_rank11() 28 | real(kind=dp), dimension(3,3) :: expectedResult 29 | 30 | expectedResult = reshape((/1, 2, 3, 2, 4, 6, 3, 6, 9/), (/3,3/)) 31 | 32 | @assertEqual(expectedResult, dyad(A,A)) 33 | end subroutine assert_rank11 34 | 35 | @test 36 | subroutine assert_rank11_itself() 37 | real(kind=dp), dimension(3,3) :: expectedResult 38 | 39 | expectedResult = reshape((/1, 2, 3, 2, 4, 6, 3, 6, 9/), (/3,3/)) 40 | 41 | @assertEqual(expectedResult, dyad(A)) 42 | end subroutine assert_rank11_itself 43 | 44 | 45 | @test 46 | subroutine assert_rank12() 47 | real(kind=dp), dimension(3,3,3) :: expectedResult 48 | 49 | expectedResult = reshape((/2, 4, 6, 4, 8, 12, 3, 6, 9, & 50 | 5, 10, 15, 1, 2, 3, 2, 4, 6, & 51 | 4, 8, 12, 3, 6, 9, 4, 8, 12/), (/3,3,3/)) 52 | 53 | @assertEqual(expectedResult, dyad(A,B)) 54 | end subroutine assert_rank12 55 | 56 | 57 | @test 58 | subroutine assert_rank21() 59 | real(kind=dp), dimension(3,3,3) :: expectedResult 60 | 61 | expectedResult = reshape((/2, 4, 3, 5, 1, 2, 4, 3, 4, & 62 | 4, 8, 6, 10, 2, 4, 8, 6, 8, & 63 | 6, 12, 9, 15, 3, 6, 12, 9, 12/), (/3,3,3/)) 64 | 65 | @assertEqual(expectedResult, dyad(B,A)) 66 | end subroutine assert_rank21 67 | 68 | 69 | @test 70 | subroutine assert_rank22() 71 | real(kind=dp), dimension(3,3,3,3) :: expectedResult 72 | 73 | expectedResult(1,1,:,:) = reshape((/4, 8, 6, 10, 2, 4, 8, 6, 8/), (/3,3/)) 74 | expectedResult(1,2,:,:) = reshape((/10, 20, 15, 25, 5, 10, 20, 15, 20/), (/3,3/)) 75 | expectedResult(1,3,:,:) = reshape((/8, 16, 12, 20, 4, 8, 16, 12, 16/), (/3,3/)) 76 | expectedResult(2,1,:,:) = reshape((/8, 16, 12, 20, 4, 8, 16, 12, 16/), (/3,3/)) 77 | expectedResult(2,2,:,:) = reshape((/2, 4, 3, 5, 1, 2, 4, 3, 4/), (/3,3/)) 78 | expectedResult(2,3,:,:) = reshape((/6, 12, 9, 15, 3, 6, 12, 9, 12/), (/3,3/)) 79 | expectedResult(3,1,:,:) = reshape((/6, 12, 9, 15, 3, 6, 12, 9, 12/), (/3,3/)) 80 | expectedResult(3,2,:,:) = reshape((/4, 8, 6, 10, 2, 4, 8, 6, 8/), (/3,3/)) 81 | expectedResult(3,3,:,:) = reshape((/8, 16, 12, 20, 4, 8, 16, 12, 16/), (/3,3/)) 82 | 83 | @assertEqual(expectedResult, dyad(B,B)) 84 | end subroutine assert_rank22 85 | 86 | @test 87 | subroutine assert_rank22_itself() 88 | real(kind=dp), dimension(3,3,3,3) :: expectedResult 89 | 90 | expectedResult(1,1,:,:) = reshape((/4, 8, 6, 10, 2, 4, 8, 6, 8/), (/3,3/)) 91 | expectedResult(1,2,:,:) = reshape((/10, 20, 15, 25, 5, 10, 20, 15, 20/), (/3,3/)) 92 | expectedResult(1,3,:,:) = reshape((/8, 16, 12, 20, 4, 8, 16, 12, 16/), (/3,3/)) 93 | expectedResult(2,1,:,:) = reshape((/8, 16, 12, 20, 4, 8, 16, 12, 16/), (/3,3/)) 94 | expectedResult(2,2,:,:) = reshape((/2, 4, 3, 5, 1, 2, 4, 3, 4/), (/3,3/)) 95 | expectedResult(2,3,:,:) = reshape((/6, 12, 9, 15, 3, 6, 12, 9, 12/), (/3,3/)) 96 | expectedResult(3,1,:,:) = reshape((/6, 12, 9, 15, 3, 6, 12, 9, 12/), (/3,3/)) 97 | expectedResult(3,2,:,:) = reshape((/4, 8, 6, 10, 2, 4, 8, 6, 8/), (/3,3/)) 98 | expectedResult(3,3,:,:) = reshape((/8, 16, 12, 20, 4, 8, 16, 12, 16/), (/3,3/)) 99 | 100 | @assertEqual(expectedResult, dyad(B)) 101 | end subroutine assert_rank22_itself 102 | 103 | @test 104 | subroutine assert_rank11_operator() 105 | real(kind=dp), dimension(3,3) :: expectedResult 106 | 107 | expectedResult = reshape((/1, 2, 3, 2, 4, 6, 3, 6, 9/), (/3,3/)) 108 | 109 | @assertEqual(expectedResult, A.dyad.A) 110 | end subroutine assert_rank11_operator 111 | 112 | 113 | @test 114 | subroutine assert_rank12_operator() 115 | real(kind=dp), dimension(3,3,3) :: expectedResult 116 | 117 | expectedResult = reshape((/2, 4, 6, 4, 8, 12, 3, 6, 9, & 118 | 5, 10, 15, 1, 2, 3, 2, 4, 6, & 119 | 4, 8, 12, 3, 6, 9, 4, 8, 12/), (/3,3,3/)) 120 | 121 | @assertEqual(expectedResult, A.dyad.B) 122 | end subroutine assert_rank12_operator 123 | 124 | 125 | @test 126 | subroutine assert_rank21_operator() 127 | real(kind=dp), dimension(3,3,3) :: expectedResult 128 | 129 | expectedResult = reshape((/2, 4, 3, 5, 1, 2, 4, 3, 4, & 130 | 4, 8, 6, 10, 2, 4, 8, 6, 8, & 131 | 6, 12, 9, 15, 3, 6, 12, 9, 12/), (/3,3,3/)) 132 | 133 | @assertEqual(expectedResult, B.dyad.A) 134 | end subroutine assert_rank21_operator 135 | 136 | 137 | @test 138 | subroutine assert_rank22_operator() 139 | real(kind=dp), dimension(3,3,3,3) :: expectedResult 140 | 141 | expectedResult(1,1,:,:) = reshape((/4, 8, 6, 10, 2, 4, 8, 6, 8/), (/3,3/)) 142 | expectedResult(1,2,:,:) = reshape((/10, 20, 15, 25, 5, 10, 20, 15, 20/), (/3,3/)) 143 | expectedResult(1,3,:,:) = reshape((/8, 16, 12, 20, 4, 8, 16, 12, 16/), (/3,3/)) 144 | expectedResult(2,1,:,:) = reshape((/8, 16, 12, 20, 4, 8, 16, 12, 16/), (/3,3/)) 145 | expectedResult(2,2,:,:) = reshape((/2, 4, 3, 5, 1, 2, 4, 3, 4/), (/3,3/)) 146 | expectedResult(2,3,:,:) = reshape((/6, 12, 9, 15, 3, 6, 12, 9, 12/), (/3,3/)) 147 | expectedResult(3,1,:,:) = reshape((/6, 12, 9, 15, 3, 6, 12, 9, 12/), (/3,3/)) 148 | expectedResult(3,2,:,:) = reshape((/4, 8, 6, 10, 2, 4, 8, 6, 8/), (/3,3/)) 149 | expectedResult(3,3,:,:) = reshape((/8, 16, 12, 20, 4, 8, 16, 12, 16/), (/3,3/)) 150 | 151 | @assertEqual(expectedResult, B.dyad.B) 152 | end subroutine assert_rank22_operator 153 | 154 | 155 | end module test_products_dyadic -------------------------------------------------------------------------------- /src/libtt_solvers_gauss.f90: -------------------------------------------------------------------------------- 1 | !> Solver for linear system of equations using Gauss elimination 2 | module libtt_solvers_gauss 3 | 4 | use libtt_precision, only: dp 5 | 6 | implicit none 7 | private 8 | 9 | public :: gauss 10 | 11 | !> Interface for Gaussian elimination algorithm with partial pivoting 12 | interface gauss 13 | module procedure gauss_linSys 14 | module procedure gauss_matrix 15 | end interface gauss 16 | 17 | !> Interface to forward elimination in gaussian algorithm 18 | interface eliminateForward 19 | module procedure eliminateForward_linSys 20 | module procedure eliminateForward_matrix 21 | end interface eliminateForward 22 | 23 | !> Interface to row switching function for vectors and matrices 24 | interface switchRow 25 | module procedure switchRow_rank1 26 | module procedure switchRow_rank2 27 | end interface switchRow 28 | 29 | contains 30 | 31 | !> Gaussian elimination to solve nxn linear system of equations A*x=b 32 | !! This routine return an upper triangular matrix as a and the solution 33 | !! vector as b. 34 | !! 35 | !! @param a System matrix 36 | !! @param b Right hand side vector 37 | subroutine gauss_linSys(a,b) 38 | real(kind=dp), dimension(:,:), intent(inout) :: a ! System matrix 39 | real(kind=dp), dimension(:), intent(inout) :: b ! Right hand side vector 40 | 41 | call eliminateForward_linSys(a,b) 42 | call substituteBackward(a,b) 43 | 44 | end subroutine gauss_linSys 45 | 46 | !> Gaussian elimination for nxn matrix 47 | !! This routine return an upper triangular matrix as a. 48 | !! 49 | !! @param a System matrix 50 | subroutine gauss_matrix(a) 51 | real(kind=dp), dimension(:,:), intent(inout) :: a ! System matrix 52 | 53 | call eliminateForward_matrix(a) 54 | 55 | end subroutine gauss_matrix 56 | 57 | !> Backward substitution to solve system of equations 58 | !! 59 | !! @param a System matrix 60 | !! @param b Right-hand side 61 | subroutine substituteBackward(a, b) 62 | real(kind=dp), dimension(:,:), intent(inout) :: a ! System matrix 63 | real(kind=dp), dimension(:), intent(inout) :: b ! Right hand side vector 64 | integer :: n ! Number of rows/columns 65 | integer :: i ! Row iterator 66 | 67 | n = size(a,1) 68 | 69 | b(n) = b(n)/a(n,n) 70 | do i = (n-1),1,-1 71 | b(i) = (b(i) - dot_product(a(i,(i+1):n),b((i+1):n))) / a(i,i) 72 | end do 73 | 74 | end subroutine substituteBackward 75 | 76 | !> Forward elimination for linear system using scaled partial pivoting 77 | !! 78 | !! @param a System matrix 79 | !! @param b Right-hand side 80 | subroutine eliminateForward_linSys(a, b) 81 | real(kind=dp), dimension(:,:), intent(inout) :: a ! System matrix 82 | real(kind=dp), dimension(:), intent(inout) :: b ! Right hand side vector 83 | integer :: n ! Number of rows/columns 84 | integer :: i ! Row iterator 85 | integer :: j ! Column iterator 86 | integer :: index ! Column iterator 87 | real(kind=dp) :: fac ! Multiplication factor for elimination 88 | real(kind=dp), dimension(:), allocatable :: scales ! Scaling factors 89 | 90 | n = size(a,1) 91 | allocate(scales(n)) 92 | call getScalingFactors(a, scales) 93 | 94 | do j = 1,(n-1),1 95 | 96 | ! Search for pivot and switch rows 97 | index = maxloc(abs(a(j:n,j)/scales(j:n)),1) 98 | index = index + j - 1 99 | if (index /= j) then 100 | call switchRow(a, (/j, index/)) 101 | call switchRow(b, (/j, index/)) 102 | call switchRow(scales, (/j, index/)) 103 | end if 104 | 105 | call check_zero_pivot(a, j) 106 | 107 | do i = (j+1),n,1 108 | fac = a(i,j)/a(j,j) 109 | a(i,:) = a(i,:) - a(j,:)* fac 110 | b(i) = b(i) - b(j) * fac 111 | end do 112 | end do 113 | 114 | deallocate(scales) 115 | 116 | end subroutine eliminateForward_linSys 117 | 118 | !> Forward elimination for a single martrix using scaled partial pivoting 119 | !! 120 | !! @param a System matrix 121 | !! @param b Right-hand side 122 | subroutine eliminateForward_matrix(a) 123 | real(kind=dp), dimension(:,:), intent(inout) :: a ! System matrix 124 | integer :: n ! Number of rows/columns 125 | integer :: i ! Row iterator 126 | integer :: j ! Column iterator 127 | integer :: index ! Column iterator 128 | real(kind=dp) :: fac ! Multiplication factor for elimination 129 | real(kind=dp), dimension(:), allocatable :: scales ! Scaling factors 130 | 131 | n = size(a,1) 132 | allocate(scales(n)) 133 | call getScalingFactors(a, scales) 134 | 135 | do j = 1,(n-1),1 136 | 137 | ! Search for pivot and switch rows 138 | index = maxloc(abs(a(j:n,j)/scales(j:n)),1) 139 | index = index + j - 1 140 | if (index /= j) then 141 | call switchRow(a, (/j, index/)) 142 | end if 143 | 144 | call check_zero_pivot(a, j) 145 | 146 | do i = (j+1),n,1 147 | fac = a(i,j)/a(j,j) 148 | a(i,:) = a(i,:) - a(j,:)* fac 149 | end do 150 | end do 151 | 152 | deallocate(scales) 153 | 154 | end subroutine eliminateForward_matrix 155 | 156 | !> Zero pivoting error function 157 | subroutine check_zero_pivot(a, j) 158 | real(kind=8), dimension(:,:), intent(in) :: a 159 | integer, intent(in) :: j 160 | 161 | if (a(j,j) == 0) then 162 | write(*,'(/, 3X, A, I3, A, I3, A)') "ERROR in GAUSS(): Zero pivot element at (", j, ",", j, ")!" 163 | write(*,'(3X, A)') "Matrix might be singular!" 164 | write(*,'(3X, A, /)') "Process terminated!" 165 | error stop 166 | end if 167 | 168 | end subroutine check_zero_pivot 169 | 170 | !> Scaling factors for scaled partial pivoting 171 | !! 172 | !! @param a System matrix 173 | !! @param res Array of scaling factors 174 | subroutine getScalingFactors(a, res) 175 | real(kind=dp), dimension(:,:), intent(in) :: a 176 | real(kind=dp), dimension(:), intent(out) :: res 177 | integer :: i 178 | 179 | do i = 1,size(a,1),1 180 | res(i) = maxval(abs(a(i,:)),1) 181 | end do 182 | 183 | end subroutine getScalingFactors 184 | 185 | !> Switching of rows in vector 186 | !! 187 | !! @param a Vector 188 | !! @param rows Array containing indices of rows to switch 189 | subroutine switchRow_rank1(a, rows) 190 | real(kind=dp), dimension(:), intent(inout) :: a 191 | integer, dimension(2), intent(in) :: rows 192 | real(kind=dp) :: tmp 193 | 194 | tmp = a(rows(1)) 195 | a(rows(1)) = a(rows(2)) 196 | a(rows(2)) = tmp 197 | 198 | end subroutine switchRow_rank1 199 | 200 | !> Switching of rows in matrix 201 | !! 202 | !! @param a System matrix 203 | !! @param rows Array containing indices of rows to switch 204 | subroutine switchRow_rank2(a, rows) 205 | real(kind=dp), dimension(:,:), intent(inout) :: a 206 | integer, dimension(2), intent(in) :: rows 207 | real(kind=dp), dimension(:), allocatable :: tmp 208 | 209 | allocate(tmp(size(a,2))) 210 | 211 | tmp = a(rows(1),:) 212 | a(rows(1),:) = a(rows(2),:) 213 | a(rows(2),:) = tmp 214 | 215 | deallocate(tmp) 216 | 217 | end subroutine switchRow_rank2 218 | 219 | end module libtt_solvers_gauss -------------------------------------------------------------------------------- /src/libtt_products.f90: -------------------------------------------------------------------------------- 1 | !> Collection of tensor products for tensors of different ranks. 2 | module libtt_products 3 | 4 | use libtt_precision 5 | 6 | implicit none 7 | private 8 | 9 | public :: doubleContract 10 | public :: operator(.ddot.) 11 | public :: dyad 12 | public :: operator(.dyad.) 13 | 14 | !> Double contracting (inner) product A:B for tensors of various 15 | !! ranks. 16 | interface operator(.ddot.) 17 | module procedure double_contract_ranks22 18 | module procedure double_contract_ranks24 19 | module procedure double_contract_ranks42 20 | end interface 21 | 22 | !> Double contracting (inner) product A:B for tensors of various 23 | !! ranks. 24 | interface doubleContract 25 | module procedure double_contract_ranks22 26 | module procedure double_contract_ranks24 27 | module procedure double_contract_ranks42 28 | end interface doubleContract 29 | 30 | !> Dyadic product of tensors A and B 31 | interface operator(.dyad.) 32 | module procedure dyadic_ranks11 33 | module procedure dyadic_ranks11_self 34 | module procedure dyadic_ranks12 35 | module procedure dyadic_ranks21 36 | module procedure dyadic_ranks22 37 | module procedure dyadic_ranks22_self 38 | end interface 39 | 40 | !> Dyadic product of tensors A and B 41 | interface dyad 42 | module procedure dyadic_ranks11 43 | module procedure dyadic_ranks11_self 44 | module procedure dyadic_ranks12 45 | module procedure dyadic_ranks21 46 | module procedure dyadic_ranks22 47 | module procedure dyadic_ranks22_self 48 | end interface dyad 49 | 50 | contains 51 | 52 | !> Double contracting product of two tensors of rank 2 53 | !! @param[in] a First tensor of product A:B 54 | !! @param[in] b Second tensor of product A:B 55 | !! @param[out] result Scalar result of product A:B 56 | pure function double_contract_ranks22(a, b) result(res) 57 | real(kind=dp) :: res 58 | real(kind=dp), dimension (3,3), intent(in) :: a, b 59 | 60 | integer :: i,j 61 | 62 | res = 0 63 | do i = 1,3,1 64 | do j = 1,3,1 65 | res = res + a(i,j)*b(i,j) 66 | end do 67 | end do 68 | end function double_contract_ranks22 69 | 70 | !> Double contracting product for tensors of rank 2 and rank 4 71 | !! @param[in] a First tensor (rank 2) of product A:B 72 | !! @param[in] b Second tensor (rank 4) of product A:B 73 | !! @param[out] result Rank 2 tensor result of product A:B 74 | pure function double_contract_ranks24(a, b) result(res) 75 | real(kind=dp), dimension(3,3,3,3), intent(in) :: b 76 | real(kind=dp), dimension(3,3), intent(in) :: a 77 | real(kind=dp), dimension(3,3) ::res 78 | 79 | integer :: i, j, m, n 80 | 81 | do m = 1,3,1 82 | do n = 1,3,1 83 | do i = 1,3,1 84 | do j = 1,3,1 85 | res(m,n) = res(m,n) + a(i,j)*b(i,j,m,n) 86 | end do 87 | end do 88 | end do 89 | end do 90 | end function double_contract_ranks24 91 | 92 | !> Double contracting product for tensors of rank 4 and rank 2 93 | !! @param[in] a First tensor (rank 4) of product A:B 94 | !! @param[in] b Second tensor (rank 2) of product A:B 95 | !! @param[out] result Rank 2 tensor result of product A:B 96 | pure function double_contract_ranks42(a, b) result(res) 97 | real(kind=dp), dimension(3,3,3,3), intent(in) :: a 98 | real(kind=dp), dimension(3,3), intent(in) :: b 99 | real(kind=dp), dimension(3,3) :: res 100 | 101 | integer :: i, j, k, l 102 | 103 | do i = 1,3,1 104 | do j = 1,3,1 105 | do k = 1,3,1 106 | do l = 1,3,1 107 | res(i,j) = res(i,j) + a(i,j,k,l)*b(k,l) 108 | end do 109 | end do 110 | end do 111 | end do 112 | end function double_contract_ranks42 113 | 114 | !> Dyadic product of tensors of rank 1 115 | !! @param a Rank 1 tensor 116 | !! @param b Rank 1 tensor 117 | !! @return res Rank 2 tensor 118 | pure function dyadic_ranks11(a, b) result(res) 119 | real(kind=dp), dimension(3), intent(in) :: a 120 | real(kind=dp), dimension(3), intent(in) :: b 121 | real(kind=dp), dimension(3,3) :: res 122 | integer :: i 123 | integer :: j 124 | 125 | res = 0.0d0 126 | 127 | do i = 1,3,1 128 | do j = 1,3,1 129 | res(i,j) = res(i,j) + a(i)*b(j) 130 | end do 131 | end do 132 | 133 | end function dyadic_ranks11 134 | 135 | !> Dyadic product of tensor of rank 1 with itself 136 | !! @param a Rank 1 tensor 137 | !! @return res Rank 2 tensor 138 | pure function dyadic_ranks11_self(a) result(res) 139 | real(kind=dp), dimension(3), intent(in) :: a 140 | real(kind=dp), dimension(3,3) :: res 141 | 142 | res = dyadic_ranks11(a,a) 143 | 144 | end function dyadic_ranks11_self 145 | 146 | !> Dyadic product of tensors of rank 1 and 2 147 | !! @param a Rank 1 tensor 148 | !! @param b Rank 2 tensor 149 | !! @return res Rank 3 tensor 150 | pure function dyadic_ranks12(a, b) result(res) 151 | real(kind=dp), dimension(3), intent(in) :: a 152 | real(kind=dp), dimension(3,3), intent(in) :: b 153 | real(kind=dp), dimension(3,3,3) :: res 154 | integer :: i 155 | integer :: j 156 | integer :: k 157 | 158 | res = 0.0d0 159 | 160 | do i = 1,3,1 161 | do j = 1,3,1 162 | do k = 1,3,1 163 | res(i,j,k) = res(i,j,k) + a(i)*b(j,k) 164 | end do 165 | end do 166 | end do 167 | 168 | end function dyadic_ranks12 169 | 170 | !> Dyadic product of tensors of rank 2 and 1 171 | !! @param a Rank 2 tensor 172 | !! @param b Rank 1 tensor 173 | !! @return res Rank 3 tensor 174 | pure function dyadic_ranks21(a, b) result(res) 175 | real(kind=dp), dimension(3,3), intent(in) :: a 176 | real(kind=dp), dimension(3), intent(in) :: b 177 | real(kind=dp), dimension(3,3,3) :: res 178 | integer :: i 179 | integer :: j 180 | integer :: k 181 | 182 | res = 0.0d0 183 | 184 | do i = 1,3,1 185 | do j = 1,3,1 186 | do k = 1,3,1 187 | res(i,j,k) = res(i,j,k) + a(i,j)*b(k) 188 | end do 189 | end do 190 | end do 191 | 192 | end function dyadic_ranks21 193 | 194 | !> Dyadic product of tensors of rank 2 195 | !! @param a Rank 2 tensor 196 | !! @param b Rank 2 tensor 197 | !! @return res Rank 4 tensor 198 | pure function dyadic_ranks22(a, b) result(res) 199 | real(kind=dp), dimension(3,3), intent(in) :: a 200 | real(kind=dp), dimension(3,3), intent(in) :: b 201 | real(kind=dp), dimension(3,3,3,3) :: res 202 | integer :: i 203 | integer :: j 204 | integer :: k 205 | integer :: l 206 | 207 | res = 0.0d0 208 | 209 | do i = 1,3,1 210 | do j = 1,3,1 211 | do k = 1,3,1 212 | do l = 1,3,1 213 | res(i,j,k,l) = res(i,j,k,l) + a(i,j)*b(k,l) 214 | end do 215 | end do 216 | end do 217 | end do 218 | 219 | end function dyadic_ranks22 220 | 221 | !> Dyadic product of tensor of rank 2 with itself 222 | !! @param a Rank 2 tensor 223 | !! @return res Rank 4 tensor 224 | pure function dyadic_ranks22_self(a) result(res) 225 | real(kind=dp), dimension(3,3), intent(in) :: a 226 | real(kind=dp), dimension(3,3,3,3) :: res 227 | 228 | res = dyadic_ranks22(a,a) 229 | 230 | end function dyadic_ranks22_self 231 | 232 | end module libtt_products -------------------------------------------------------------------------------- /src/libtt_common.f90: -------------------------------------------------------------------------------- 1 | !> Collection of common functions and/or subroutines for the tensortools 2 | !! library. 3 | module libtt_common 4 | 5 | use libtt_precision 6 | 7 | implicit none 8 | private 9 | 10 | public :: kronecker 11 | public :: trace 12 | public :: det 13 | public :: eye 14 | public :: eye_4 15 | public :: symmetric 16 | public :: skew 17 | public :: inverse 18 | public :: inverseMatrix 19 | public :: diag 20 | public :: dev 21 | public :: invariants 22 | 23 | interface diag 24 | module procedure getDiagElementsFromTensor 25 | module procedure makeDiagonalTensor 26 | end interface diag 27 | 28 | interface eye 29 | module procedure eye_matrix 30 | module procedure eye_tensor 31 | end interface eye 32 | 33 | interface invariants 34 | module procedure principal_invariants 35 | module procedure mixed_invariants 36 | end interface invariants 37 | 38 | 39 | contains 40 | 41 | !> Kronecker delta function 42 | !! Evaluates the Kronecker delta function \f$\delta_{ij}\f$, 43 | !! i.e. returns 1 if input parameters i and j are equal. 44 | !! Returns 0 else. 45 | !! 46 | !! @param i Integer 47 | !! @param j Integer 48 | !! @return res Result (1 or 0) 49 | pure function kronecker(i,j) result(res) 50 | integer, intent(in) :: i,j 51 | integer :: res 52 | 53 | if (i==j) then 54 | res = 1 55 | else 56 | res = 0 57 | endif 58 | end function kronecker 59 | 60 | !> Trace of a tensor / matrix 61 | !! 62 | !! @param a Matrix tensor (rank n) 63 | !! @return res Trace of the matrix / tensor 64 | pure function trace(a) result(res) 65 | real(kind=dp), dimension (:,:), intent(in) :: a 66 | real(kind=dp) :: res 67 | integer :: i 68 | 69 | res = 0.0d0 70 | 71 | do i = 1,size(a,1) 72 | res = res + a(i,i) 73 | end do 74 | 75 | end function trace 76 | 77 | !> Determinant of 2nd order tensor 78 | !! 79 | !! @param a Matrix tensor (rank n) 80 | !! @return res Trace of the matrix / tensor 81 | pure function det(a) result(res) 82 | real(kind=dp), dimension(3,3), intent(in) :: a 83 | real(kind=dp) :: res 84 | 85 | res = a(1,1)*a(2,2)*a(3,3) - & 86 | a(1,1)*a(2,3)*a(3,2) - & 87 | a(2,1)*a(1,2)*a(3,3) + & 88 | a(2,1)*a(1,3)*a(3,2) + & 89 | a(3,1)*a(1,2)*a(2,3) - & 90 | a(3,1)*a(1,3)*a(2,2) 91 | end function det 92 | 93 | !> Identity matrix 94 | !! 95 | !! @param n Dimension of identity matrix 96 | !! @return res Identity matrix 97 | function eye_matrix(n) result(res) 98 | integer, intent(in) :: n 99 | real(kind=dp), dimension(n,n) :: res 100 | 101 | integer :: i 102 | 103 | res = 0.0d0 104 | do i = 1,n,1 105 | res(i,i) = 1.0d0 106 | end do 107 | 108 | end function 109 | 110 | !> Identity tensor of 2nd order 111 | !! 112 | !! @return res Identity tensor of 2nd order 113 | function eye_tensor() result(res) 114 | real(kind=dp), dimension(3,3) :: res 115 | 116 | res = 0.0d0 117 | res(1,1) = 1.0d0 118 | res(2,2) = 1.0d0 119 | res(3,3) = 1.0d0 120 | 121 | end function eye_tensor 122 | 123 | !> Identity tensor of higher rank than 4 124 | !! 125 | !! @return res Identity tensor of higher rank 126 | function eye_4() result(res) 127 | real(kind=dp), dimension(3,3,3,3) :: res 128 | integer :: i 129 | integer :: j 130 | integer :: k 131 | integer :: l 132 | 133 | do i =1,3,1 134 | do j = 1,3,1 135 | do k = 1,3,1 136 | do l = 1,3,1 137 | res(i,j,k,l) = 0.5*(kronecker(i,k)*kronecker(j,l) + kronecker(i,l)*kronecker(j,k)) 138 | end do 139 | end do 140 | end do 141 | end do 142 | 143 | end function eye_4 144 | 145 | !> Symmetric part of 2nd order tensor 146 | !! 147 | !! @param A Tensor of second order 148 | !! @return res Symmetric part of A 149 | pure function symmetric(A) result(res) 150 | real(kind=dp), dimension(3,3), intent(in) :: A 151 | real(kind=dp), dimension(3,3) :: res 152 | 153 | res = 0.5d0 * (A + transpose(A)) 154 | 155 | end function symmetric 156 | 157 | !> Scew symmetric part of 2nd order tensor 158 | !! 159 | !! @param A Tensor of second order 160 | !! @return res Scew symmetric part of A 161 | pure function skew(A) result(res) 162 | real(kind=dp), dimension(3,3), intent(in) :: A 163 | real(kind=dp), dimension(3,3) :: res 164 | 165 | res = 0.5d0 * (A - transpose(A)) 166 | 167 | end function skew 168 | 169 | !> Inverse of a 2x2 matrix 170 | !! 171 | !! @param A 2x2 Matrix 172 | !! @return res Inverse of A 173 | pure function inverseMatrix(A) result(res) 174 | real(kind=dp), dimension(2,2), intent(in) :: A 175 | real(kind=dp), dimension(2,2) :: res 176 | 177 | res(1,1) = A(2,2) 178 | res(1,2) = -A(1,2) 179 | res(2,1) = -A(2,1) 180 | res(2,2) = A(1,1) 181 | res = res / (A(1,1)*A(2,2) - A(1,2)*A(2,1)) 182 | 183 | end function inverseMatrix 184 | 185 | !> Inverse of 2nd order tensor 186 | !! 187 | !! @param A Tensor of second order 188 | !! @return res Inverse of A 189 | pure function inverse(A) result(res) 190 | real(kind=dp), dimension(3,3), intent(in) :: A 191 | real(kind=dp), dimension(3,3) :: res 192 | 193 | res(1,1) = A(2,2)*A(3,3) - A(2,3)*A(3,2) 194 | res(2,1) = A(2,3)*A(3,1) - A(3,3)*A(2,1) 195 | res(3,1) = A(2,1)*A(3,2) - A(3,1)*A(2,2) 196 | res(1,2) = A(3,2)*A(1,3) - A(1,2)*A(3,3) 197 | res(2,2) = A(3,3)*A(1,1) - A(1,3)*A(3,1) 198 | res(3,2) = A(3,1)*A(1,2) - A(1,1)*A(3,2) 199 | res(1,3) = A(1,2)*A(2,3) - A(2,2)*A(1,3) 200 | res(2,3) = A(1,3)*A(2,1) - A(2,3)*A(1,1) 201 | res(3,3) = A(1,1)*A(2,2) - A(2,1)*A(1,2) 202 | res = 1/det(A) * res 203 | end function inverse 204 | 205 | !> Get diagonal element from tensor 2nd order 206 | !! 207 | !! @param A Tensor of second order 208 | !! @return res Array of diagonal elements 209 | pure function getDiagElementsFromTensor(A) result(res) 210 | real(kind=dp), dimension(3,3), intent(in) :: A 211 | real(kind=dp), dimension(3) :: res 212 | 213 | res(1) = A(1,1) 214 | res(2) = A(2,2) 215 | res(3) = A(3,3) 216 | end function getDiagElementsFromTensor 217 | 218 | !> Make diagonal tensor from vector entries 219 | !! 220 | !! @param vec Array containing diagonal entries 221 | !! @return res Diagonal tensor 222 | pure function makeDiagonalTensor(vec) result(res) 223 | real(kind=dp), dimension(3), intent(in) :: vec 224 | real(kind=dp), dimension(3,3) :: res 225 | 226 | res = 0.0d0 227 | res(1,1) = vec(1) 228 | res(2,2) = vec(2) 229 | res(3,3) = vec(3) 230 | end function makeDiagonalTensor 231 | 232 | !> Get deviatoric part of 2nd order tensor 233 | !! 234 | !! @param A 2nd order tensor 235 | !! @return res Deviatoric part of A 236 | function dev(A) result(res) 237 | real(kind=dp), dimension(3,3), intent(in) :: A 238 | real(kind=dp), dimension(3,3) :: res 239 | 240 | res = A - trace(A)/3 * eye() 241 | 242 | end function dev 243 | 244 | !> Get principal invariants of 2nd order tensor 245 | !! 246 | !! @param A Second order tensor 247 | !! @return res Array of invariants 248 | pure function principal_invariants(A) result(res) 249 | real(kind=dp), dimension(3,3), intent(in) :: A 250 | real(kind=dp), dimension(3) :: res 251 | 252 | res(1) = trace(A) 253 | res(2) = 0.5 * (trace(A)**2 - trace(matmul(A,A))) 254 | res(3) = det(A) 255 | 256 | end function principal_invariants 257 | 258 | !> Get mixed invariants of two 2nd order tensor 259 | !! 260 | !! @param A Second order tensor 261 | !! @param B Second order tensor 262 | !! @return res Array of mixed invariants 263 | pure function mixed_invariants(A,B) result(res) 264 | 265 | use libtt_products, only: doubleContract 266 | 267 | real(kind=dp), dimension(3,3), intent(in) :: A 268 | real(kind=dp), dimension(3,3), intent(in) :: B 269 | real(kind=dp), dimension(5) :: res 270 | 271 | res(1:3) = principal_invariants(A) 272 | res(4) = doubleContract(B, A) 273 | res(5) = doubleContract(B, matmul(A,A)) 274 | 275 | end function mixed_invariants 276 | 277 | end module libtt_common 278 | 279 | -------------------------------------------------------------------------------- /src/libtt_physics_transformation.f90: -------------------------------------------------------------------------------- 1 | module libtt_physics_transformation 2 | 3 | use libtt_precision, only: dp 4 | 5 | implicit none 6 | private 7 | 8 | public :: pushForward 9 | 10 | interface pushForward 11 | module procedure push_stress 12 | module procedure push_tangent 13 | !module procedure push_stress_voigt 14 | !module procedure push_tangent_voigt 15 | end interface pushForward 16 | 17 | contains 18 | 19 | !> Push forward stresses from one to the other configuration 20 | !! 21 | !! Input: 22 | !! stress : Stress tensor to be pushed forward 23 | !! def_grad : Deformation gradient tensor 24 | !! quantity_in : Character(3), defining the input quantity 25 | !! Options are: 26 | !! 'pk2' - Second Piola-Kirchhoff stress 27 | !! 'pk1' - First Piola-Kirchhoff stress 28 | !! 'sig' - Cauchy stress 29 | !! 'tau' - Kirchhoff stress 30 | !! quantity_out : Character(3), defining the output quantity 31 | !! Options are: 32 | !! 'pk1' - First Piola-Kirchhoff stress 33 | !! 'sig' - Cauchy stress 34 | !! 'tau' - Kirchhoff stress 35 | !! 36 | !! Output: 37 | !! stress : Stress tensor in new configuration 38 | function push_stress(stress, def_grad, quantity_in, quantity_out) result(res) 39 | 40 | use libtt_common, only: det 41 | 42 | real(kind=dp), dimension(3,3), intent(in) :: def_grad ! Deformation gradient 43 | character(len=3), intent(in) :: quantity_in ! Name of input stress 44 | character(len=3), intent(in) :: quantity_out ! Name of output stress 45 | real(kind=dp), dimension(3,3), intent(in) :: stress 46 | real(kind=dp), dimension(3,3) :: res 47 | real(kind=dp) :: det_f 48 | 49 | if (quantity_in == 'pk2' .AND. quantity_out == 'pk1') then 50 | ! Push from second Piola-Kirchhoff to first Piola-Kirchhoff 51 | res = matmul(def_grad, stress) 52 | 53 | else if (quantity_in == 'pk2' .AND. quantity_out == 'sig') then 54 | ! Push from second Piola-Kirchhoff to Cauchy 55 | det_f = det(def_grad) 56 | res = (1/det_f) * matmul(def_grad, matmul(stress, transpose(def_grad))) 57 | 58 | else if (quantity_in == 'pk1' .AND. quantity_out == 'sig') then 59 | ! Push from first Piola-Kirchhoff to Cauchy 60 | det_f = det(def_grad) 61 | res = (1/det_f) * matmul(stress, transpose(def_grad)) 62 | 63 | else if (quantity_in == 'pk2' .AND. quantity_out == 'tau') then 64 | ! Push from second Piola-Kirchhoff to Kirchhoff 65 | res = matmul(def_grad, matmul(stress, transpose(def_grad))) 66 | 67 | else if (quantity_in == 'pk1' .AND. quantity_out == 'tau') then 68 | ! Push from first Piola-Kirchhoff to Kirchhoff 69 | res = matmul(stress, transpose(def_grad)) 70 | 71 | else if (quantity_in == 'sig' .AND. quantity_out == 'tau') then 72 | ! Push from Cauchy to Kirchhoff 73 | det_f = det(def_grad) 74 | res = det_f * stress 75 | 76 | else if (quantity_in == 'tau' .AND. quantity_out == 'sig') then 77 | ! Push from Kirchhoff to Cauchy 78 | det_f = det(def_grad) 79 | res = (1/det_f) * stress 80 | 81 | else 82 | ! Raise undefined error! 83 | write(*,*) 'ERROR: Undefined push-forward sequence!' 84 | error stop 85 | 86 | end if 87 | 88 | end function push_stress 89 | 90 | !> Wrapper for push forward operation on Voigt notation stress tensors 91 | !! 92 | !! Input: 93 | !! stress : Stress tensor to be pushed forward 94 | !! def_grad : Deformation gradient tensor 95 | !! quantity_in : Character(3), defining the input quantity 96 | !! Options are: 97 | !! 'pk2' - Second Piola-Kirchhoff stress 98 | !! 'pk1' - First Piola-Kirchhoff stress 99 | !! 'sig' - Cauchy stress 100 | !! 'tau' - Kirchhoff stress 101 | !! quantity_out : Character(3), defining the output quantity 102 | !! Options are: 103 | !! 'pk1' - First Piola-Kirchhoff stress 104 | !! 'sig' - Cauchy stress 105 | !! 'tau' - Kirchhoff stress 106 | !! 107 | !! Output: 108 | !! stress : Stress tensor in new configuration 109 | ! subroutine push_stress_voigt(stress, def_grad, quantity_in, quantity_out) 110 | 111 | ! use libtt_voigt, only: toTensor, toVoigt 112 | 113 | ! real(kind=dp), dimension(3,3), intent(in) :: def_grad ! Deformation gradient 114 | ! character(len=3), intent(in) :: quantity_in ! Name of input stress 115 | ! character(len=3), intent(in) :: quantity_out ! Name of output stress 116 | ! real(kind=dp), dimension(:), intent(inout) :: stress 117 | ! logical :: symmetry 118 | ! real(kind=dp), dimension(3,3) :: stress_tens 119 | 120 | ! ! Convert voigt to tensor notation 121 | ! stress_tens = toTensor(stress) 122 | 123 | ! ! Push stress 124 | ! call push_stress(stress_tens, def_grad, quantity_in, quantity_out) 125 | 126 | ! ! Convert back to voigt notation 127 | ! stress = toVoigt(stress_tens) 128 | 129 | ! end subroutine push_stress_voigt 130 | 131 | !> Push forward operation of tangent operator 132 | !! 133 | !! Input: 134 | !! tangent : Tangent modulus to be pushed 135 | !! def_grad : Deformation gradient tensor 136 | !! 137 | !! Output: 138 | !! tangent : Tangent modulus in new configuration 139 | !! 140 | function push_tangent(tangent, def_grad) result(res) 141 | 142 | use libtt_common, only: det 143 | 144 | real(kind=dp), dimension(3,3), intent(in) :: def_grad 145 | real(kind=dp), dimension(3,3,3,3), intent(in) :: tangent 146 | real(kind=dp), dimension(3,3,3,3) :: res 147 | integer :: a, b, c, d, i, j, k, l 148 | real(kind=dp) :: det_f 149 | real(kind=dp), dimension(3,3,3,3) :: tmp_tang 150 | 151 | ! Get qunatities neede for operation 152 | det_f = det(def_grad) 153 | tmp_tang = 0.0d0 154 | 155 | ! Performe push operation 156 | do a = 1,3,1 157 | do b = 1,3,1 158 | do c = 1,3,1 159 | do d = 1,3,1 160 | do i = 1,3,1 161 | do j = 1,3,1 162 | do k = 1,3,1 163 | do l = 1,3,1 164 | tmp_tang(a,b,c,d) = tmp_tang(a,b,c,d) + & 165 | def_grad(a,i) * & 166 | def_grad(b,j) * & 167 | def_grad(c,k) * & 168 | def_grad(d,l) * & 169 | tangent(i,j,k,l) 170 | end do 171 | end do 172 | end do 173 | end do 174 | end do 175 | end do 176 | end do 177 | end do 178 | 179 | res = (1/det_f) * tmp_tang 180 | 181 | end function push_tangent 182 | 183 | !> Wrapper for push forward operation on tangents given in voigt notation 184 | !! 185 | !! 186 | !! Input: 187 | !! tangent : Tangent modulus to be pushed 188 | !! def_grad : Deformation gradient tensor 189 | !! 190 | !! Output: 191 | !! tangent : Tangent modulus in new configuration 192 | !! 193 | ! subroutine push_tangent_voigt(tangent, def_grad) 194 | 195 | ! real(kind=dp), dimension(3,3), intent(in) :: def_grad 196 | ! real(kind=dp), dimension(6,6), intent(inout) :: tangent 197 | ! real(kind=dp), dimension(3,3,3,3) :: tangent_tens 198 | 199 | ! ! Convert to tensor notation 200 | ! call toTensor(tangent_tens, tangent, .TRUE.) 201 | 202 | ! ! Performe operation 203 | ! call push_tangent(tangent_tens, def_grad) 204 | 205 | ! ! Convert back to voigt notation 206 | ! call toVoigt(tangent, tangent_tens, .TRUE.) 207 | 208 | ! end subroutine push_tangent_voigt 209 | 210 | end module libtt_physics_transformation -------------------------------------------------------------------------------- /src/libtt_voigt.f90: -------------------------------------------------------------------------------- 1 | module libtt_voigt 2 | 3 | use libtt_precision, only: dp 4 | 5 | implicit none 6 | private 7 | 8 | public :: toVoigt 9 | public :: toVoigtNonSym 10 | public :: toTensor 11 | public :: toTensorNonSym 12 | 13 | interface toVoigt 14 | module procedure toVoigt2nd 15 | end interface toVoigt 16 | 17 | interface toVoigtNonSym 18 | module procedure toVoigt2nd_nonSym 19 | module procedure toVoigt4th_nonSym 20 | end interface toVoigtNonSym 21 | 22 | interface toTensor 23 | module procedure toTensor2nd 24 | module procedure toTensor4th 25 | end interface toTensor 26 | 27 | interface toTensorNonSym 28 | module procedure toTensor2nd_nonSym 29 | module procedure toTensor4th_nonSym 30 | end interface toTensorNonSym 31 | contains 32 | 33 | pure function toVoigt2nd_nonSym(a) result(res) 34 | real(kind=dp), dimension(3,3), intent(in) :: a 35 | real(kind=dp), dimension(9) :: res 36 | 37 | res(1) = a(1,1) 38 | res(2) = a(1,2) 39 | res(3) = a(1,3) 40 | res(4) = a(2,1) 41 | res(5) = a(2,2) 42 | res(6) = a(2,3) 43 | res(7) = a(3,1) 44 | res(8) = a(3,2) 45 | res(9) = a(3,3) 46 | 47 | end function toVoigt2nd_nonSym 48 | 49 | pure function toVoigt2nd(a) result(res) 50 | real(kind=dp), dimension(3,3), intent(in) :: a 51 | real(kind=dp), dimension(6) :: res 52 | 53 | res(1) = a(1,1) 54 | res(2) = a(2,2) 55 | res(3) = a(3,3) 56 | res(4) = a(1,2) 57 | res(5) = a(2,3) 58 | res(6) = a(1,3) 59 | 60 | end function toVoigt2nd 61 | 62 | pure function toVoigt4th_nonSym(a) result(res) 63 | real(kind=dp), dimension(3,3,3,3) , intent(in) :: a 64 | real(kind=dp), dimension(9,9) :: res 65 | 66 | res(1,1) = a(1,1,1,1) 67 | res(1,2) = a(1,1,1,2) 68 | res(1,3) = a(1,1,1,3) 69 | res(1,4) = a(1,1,2,1) 70 | res(1,5) = a(1,1,2,2) 71 | res(1,6) = a(1,1,2,3) 72 | res(1,7) = a(1,1,3,1) 73 | res(1,8) = a(1,1,3,2) 74 | res(1,9) = a(1,1,3,3) 75 | 76 | res(2,1) = a(1,2,1,1) 77 | res(2,2) = a(1,2,1,2) 78 | res(2,3) = a(1,2,1,3) 79 | res(2,4) = a(1,2,2,1) 80 | res(2,5) = a(1,2,2,2) 81 | res(2,6) = a(1,2,2,3) 82 | res(2,7) = a(1,2,3,1) 83 | res(2,8) = a(1,2,3,2) 84 | res(2,9) = a(1,2,3,3) 85 | 86 | res(3,1) = a(1,3,1,1) 87 | res(3,2) = a(1,3,1,2) 88 | res(3,3) = a(1,3,1,3) 89 | res(3,4) = a(1,3,2,1) 90 | res(3,5) = a(1,3,2,2) 91 | res(3,6) = a(1,3,2,3) 92 | res(3,7) = a(1,3,3,1) 93 | res(3,8) = a(1,3,3,2) 94 | res(3,9) = a(1,3,3,3) 95 | 96 | res(4,1) = a(2,1,1,1) 97 | res(4,2) = a(2,1,1,2) 98 | res(4,3) = a(2,1,1,3) 99 | res(4,4) = a(2,1,2,1) 100 | res(4,5) = a(2,1,2,2) 101 | res(4,6) = a(2,1,2,3) 102 | res(4,7) = a(2,1,3,1) 103 | res(4,8) = a(2,1,3,2) 104 | res(4,9) = a(2,1,3,3) 105 | 106 | res(5,1) = a(2,2,1,1) 107 | res(5,2) = a(2,2,1,2) 108 | res(5,3) = a(2,2,1,3) 109 | res(5,4) = a(2,2,2,1) 110 | res(5,5) = a(2,2,2,2) 111 | res(5,6) = a(2,2,2,3) 112 | res(5,7) = a(2,2,3,1) 113 | res(5,8) = a(2,2,3,2) 114 | res(5,9) = a(2,2,3,3) 115 | 116 | res(6,1) = a(2,3,1,1) 117 | res(6,2) = a(2,3,1,2) 118 | res(6,3) = a(2,3,1,3) 119 | res(6,4) = a(2,3,2,1) 120 | res(6,5) = a(2,3,2,2) 121 | res(6,6) = a(2,3,2,3) 122 | res(6,7) = a(2,3,3,1) 123 | res(6,8) = a(2,3,3,2) 124 | res(6,9) = a(2,3,3,3) 125 | 126 | res(7,1) = a(3,1,1,1) 127 | res(7,2) = a(3,1,1,2) 128 | res(7,3) = a(3,1,1,3) 129 | res(7,4) = a(3,1,2,1) 130 | res(7,5) = a(3,1,2,2) 131 | res(7,6) = a(3,1,2,3) 132 | res(7,7) = a(3,1,3,1) 133 | res(7,8) = a(3,1,3,2) 134 | res(7,9) = a(3,1,3,3) 135 | 136 | res(8,1) = a(3,2,1,1) 137 | res(8,2) = a(3,2,1,2) 138 | res(8,3) = a(3,2,1,3) 139 | res(8,4) = a(3,2,2,1) 140 | res(8,5) = a(3,2,2,2) 141 | res(8,6) = a(3,2,2,3) 142 | res(8,7) = a(3,2,3,1) 143 | res(8,8) = a(3,2,3,2) 144 | res(8,9) = a(3,2,3,3) 145 | 146 | res(9,1) = a(3,3,1,1) 147 | res(9,2) = a(3,3,1,2) 148 | res(9,3) = a(3,3,1,3) 149 | res(9,4) = a(3,3,2,1) 150 | res(9,5) = a(3,3,2,2) 151 | res(9,6) = a(3,3,2,3) 152 | res(9,7) = a(3,3,3,1) 153 | res(9,8) = a(3,3,3,2) 154 | res(9,9) = a(3,3,3,3) 155 | 156 | end function toVoigt4th_nonSym 157 | 158 | pure function toTensor2nd_nonSym(a) result(res) 159 | real(kind=dp), dimension(9), intent(in) :: a 160 | real(kind=dp), dimension(3,3) :: res 161 | 162 | res(1,1) = a(1) 163 | res(1,2) = a(2) 164 | res(1,3) = a(3) 165 | res(2,1) = a(4) 166 | res(2,2) = a(5) 167 | res(2,3) = a(6) 168 | res(3,1) = a(7) 169 | res(3,2) = a(8) 170 | res(3,3) = a(9) 171 | 172 | end function toTensor2nd_nonSym 173 | 174 | pure function toTensor4th_nonSym(a) result(res) 175 | real(kind=dp), dimension(9,9), intent(in) :: a 176 | real(kind=dp), dimension(3,3,3,3) :: res 177 | 178 | res(1,1,1,1) = a(1,1) 179 | res(1,1,1,2) = a(1,2) 180 | res(1,1,1,3) = a(1,3) 181 | res(1,1,2,1) = a(1,4) 182 | res(1,1,2,2) = a(1,5) 183 | res(1,1,2,3) = a(1,6) 184 | res(1,1,3,1) = a(1,7) 185 | res(1,1,3,2) = a(1,8) 186 | res(1,1,3,3) = a(1,9) 187 | 188 | res(1,2,1,1) = a(2,1) 189 | res(1,2,1,2) = a(2,2) 190 | res(1,2,1,3) = a(2,3) 191 | res(1,2,2,1) = a(2,4) 192 | res(1,2,2,2) = a(2,5) 193 | res(1,2,2,3) = a(2,6) 194 | res(1,2,3,1) = a(2,7) 195 | res(1,2,3,2) = a(2,8) 196 | res(1,2,3,3) = a(2,9) 197 | 198 | res(1,3,1,1) = a(3,1) 199 | res(1,3,1,2) = a(3,2) 200 | res(1,3,1,3) = a(3,3) 201 | res(1,3,2,1) = a(3,4) 202 | res(1,3,2,2) = a(3,5) 203 | res(1,3,2,3) = a(3,6) 204 | res(1,3,3,1) = a(3,7) 205 | res(1,3,3,2) = a(3,8) 206 | res(1,3,3,3) = a(3,9) 207 | 208 | res(2,1,1,1) = a(4,1) 209 | res(2,1,1,2) = a(4,2) 210 | res(2,1,1,3) = a(4,3) 211 | res(2,1,2,1) = a(4,4) 212 | res(2,1,2,2) = a(4,5) 213 | res(2,1,2,3) = a(4,6) 214 | res(2,1,3,1) = a(4,7) 215 | res(2,1,3,2) = a(4,8) 216 | res(2,1,3,3) = a(4,9) 217 | 218 | res(2,2,1,1) = a(5,1) 219 | res(2,2,1,2) = a(5,2) 220 | res(2,2,1,3) = a(5,3) 221 | res(2,2,2,1) = a(5,4) 222 | res(2,2,2,2) = a(5,5) 223 | res(2,2,2,3) = a(5,6) 224 | res(2,2,3,1) = a(5,7) 225 | res(2,2,3,2) = a(5,8) 226 | res(2,2,3,3) = a(5,9) 227 | 228 | res(2,3,1,1) = a(6,1) 229 | res(2,3,1,2) = a(6,2) 230 | res(2,3,1,3) = a(6,3) 231 | res(2,3,2,1) = a(6,4) 232 | res(2,3,2,2) = a(6,5) 233 | res(2,3,2,3) = a(6,6) 234 | res(2,3,3,1) = a(6,7) 235 | res(2,3,3,2) = a(6,8) 236 | res(2,3,3,3) = a(6,9) 237 | 238 | res(3,1,1,1) = a(7,1) 239 | res(3,1,1,2) = a(7,2) 240 | res(3,1,1,3) = a(7,3) 241 | res(3,1,2,1) = a(7,4) 242 | res(3,1,2,2) = a(7,5) 243 | res(3,1,2,3) = a(7,6) 244 | res(3,1,3,1) = a(7,7) 245 | res(3,1,3,2) = a(7,8) 246 | res(3,1,3,3) = a(7,9) 247 | 248 | res(3,2,1,1) = a(8,1) 249 | res(3,2,1,2) = a(8,2) 250 | res(3,2,1,3) = a(8,3) 251 | res(3,2,2,1) = a(8,4) 252 | res(3,2,2,2) = a(8,5) 253 | res(3,2,2,3) = a(8,6) 254 | res(3,2,3,1) = a(8,7) 255 | res(3,2,3,2) = a(8,8) 256 | res(3,2,3,3) = a(8,9) 257 | 258 | res(3,3,1,1) = a(9,1) 259 | res(3,3,1,2) = a(9,2) 260 | res(3,3,1,3) = a(9,3) 261 | res(3,3,2,1) = a(9,4) 262 | res(3,3,2,2) = a(9,5) 263 | res(3,3,2,3) = a(9,6) 264 | res(3,3,3,1) = a(9,7) 265 | res(3,3,3,2) = a(9,8) 266 | res(3,3,3,3) = a(9,9) 267 | 268 | end function toTensor4th_nonSym 269 | 270 | pure function toTensor2nd(a) result(res) 271 | real(kind=dp), dimension(6), intent(in) :: a 272 | real(kind=dp), dimension(3,3) :: res 273 | 274 | res(1,1) = a(1) 275 | res(2,2) = a(2) 276 | res(3,3) = a(3) 277 | res(1,2) = a(4) 278 | res(2,3) = a(5) 279 | res(1,3) = a(6) 280 | res(2,1) = res(1,2) 281 | res(3,2) = res(2,3) 282 | res(3,1) = res(1,3) 283 | 284 | end function toTensor2nd 285 | 286 | pure function toTensor4th(voigt) result(tensor) 287 | 288 | real(kind=dp), dimension(6,6), intent(in) :: voigt 289 | real(kind=dp), dimension(3,3,3,3) :: tensor 290 | 291 | integer :: a,b,c,d 292 | 293 | tensor(1,1,1,1) = voigt(1,1) 294 | tensor(1,1,2,2) = voigt(1,2) 295 | tensor(1,1,3,3) = voigt(1,3) 296 | tensor(1,1,1,2) = voigt(1,4) 297 | tensor(1,1,1,3) = voigt(1,5) 298 | tensor(1,1,2,3) = voigt(1,6) 299 | 300 | tensor(2,2,1,1) = voigt(2,1) 301 | tensor(2,2,2,2) = voigt(2,2) 302 | tensor(2,2,3,3) = voigt(2,3) 303 | tensor(2,2,1,2) = voigt(2,4) 304 | tensor(2,2,1,3) = voigt(2,5) 305 | tensor(2,2,2,3) = voigt(2,6) 306 | 307 | tensor(3,3,1,1) = voigt(3,1) 308 | tensor(3,3,2,2) = voigt(3,2) 309 | tensor(3,3,3,3) = voigt(3,3) 310 | tensor(3,3,1,2) = voigt(3,4) 311 | tensor(3,3,1,3) = voigt(3,5) 312 | tensor(3,3,2,3) = voigt(3,6) 313 | 314 | tensor(1,2,1,1) = voigt(4,1) 315 | tensor(1,2,2,2) = voigt(4,2) 316 | tensor(1,2,3,3) = voigt(4,3) 317 | tensor(1,2,1,2) = voigt(4,4) 318 | tensor(1,2,1,3) = voigt(4,5) 319 | tensor(1,2,2,3) = voigt(4,6) 320 | 321 | tensor(1,3,1,1) = voigt(5,1) 322 | tensor(1,3,2,2) = voigt(5,2) 323 | tensor(1,3,3,3) = voigt(5,3) 324 | tensor(1,3,1,2) = voigt(5,4) 325 | tensor(1,3,1,3) = voigt(5,5) 326 | tensor(1,3,2,3) = voigt(5,6) 327 | 328 | tensor(2,3,1,1) = voigt(6,1) 329 | tensor(2,3,2,2) = voigt(6,2) 330 | tensor(2,3,3,3) = voigt(6,3) 331 | tensor(2,3,1,2) = voigt(6,4) 332 | tensor(2,3,1,3) = voigt(6,5) 333 | tensor(2,3,2,3) = voigt(6,6) 334 | 335 | ! Exploit minor symmetries 336 | do a = 1,3,1 337 | do b = 1,3,1 338 | do c = 1,3,1 339 | do d = 1,3,1 340 | tensor(b,a,c,d) = tensor(a,b,c,d) 341 | tensor(a,b,d,c) = tensor(a,b,c,d) 342 | end do 343 | end do 344 | end do 345 | end do 346 | 347 | end function toTensor4th 348 | 349 | end module libtt_voigt 350 | -------------------------------------------------------------------------------- /src/libtt_physics_elasticity.f90: -------------------------------------------------------------------------------- 1 | !> Module for special tensors used in pyhsical simulations (e.g. solid mechanics) 2 | module libtt_physics_elasticity 3 | 4 | use libtt_precision 5 | use libtt_common, only: eye, eye_4, inverse, det, trace 6 | use libtt_products, only: dyad 7 | 8 | implicit none 9 | private 10 | 11 | real(kind=dp), dimension(5), parameter :: ab_coefficients = [1/2.d0, 1/20.d0, 11/1050.d0, 19/7000.d0, 519/673750.d0] 12 | 13 | public :: getRightCauchyGreen 14 | public :: getLeftCauchyGreen 15 | public :: getGreenLagrange 16 | public :: getNeoHooke_stress 17 | public :: getNeoHooke_tangent 18 | public :: getArrudaBoyce_stress 19 | public :: getArrudaBoyce_energy 20 | public :: getDerivativeInvRCG 21 | public :: getStVenant_stress 22 | public :: getStVenant_tangent 23 | public :: getAnisotropicReese_stress 24 | public :: getAnisotropicReese_tangent 25 | 26 | 27 | contains 28 | 29 | !> Right Cauchy Green tensor 30 | !! 31 | !! @param defGrad Deformation gradient tensor 32 | !! @return res Right Cauchy Green tensor 33 | pure function getRightCauchyGreen(defGrad) result(res) 34 | 35 | real(kind=dp), dimension(3,3), intent(in) :: defGrad 36 | real(kind=dp), dimension(3,3) :: res 37 | 38 | res = matmul(transpose(defGrad), defGrad) 39 | 40 | end function getRightCauchyGreen 41 | 42 | !> Left Cauchy Green tensor 43 | !! 44 | !! @param defGrad Deformation gradient tensor 45 | !! @return res Left Cauchy Green tensor 46 | pure function getLeftCauchyGreen(defGrad) result(res) 47 | 48 | real(kind=dp), dimension(3,3), intent(in) :: defGrad 49 | real(kind=dp), dimension(3,3) :: res 50 | 51 | res = matmul(defGrad, transpose(defGrad)) 52 | 53 | end function getLeftCauchyGreen 54 | 55 | !> Green Lagrange strain tensor 56 | !! 57 | !! @param rightCauchyGreen Right Cauchy Green strain tensor 58 | !! @return res Green Lagrange strain tensor 59 | function getGreenLagrange(rightCauchyGreen) result(res) 60 | 61 | real(kind=dp), dimension(3,3), intent(in) :: rightCauchyGreen 62 | real(kind=dp), dimension(3,3) :: res 63 | 64 | res = 0.5d0*(RightCauchyGreen - eye()) 65 | 66 | end function getGreenLagrange 67 | 68 | 69 | !> Neo Hookean material model (stress response) 70 | !! Based on the formulation of the strain energy function as: 71 | !! psi = mu/2 * (trace(C) - 3) - mu * ln(J) + lambda/4 *(J^2 - 1 - 2*ln(J)) 72 | !! 73 | !! @param rightCauchyGreen Right Cauchy Green strain tensor 74 | !! @param mu Material Parameter (Lame mu) 75 | !! @param lambda Material Parameter (Lame lambda) 76 | !! @return res 2nd Piola Kirchhoff stress tensor 77 | function getNeoHooke_stress(rightCauchyGreen, mu, lambda) result(res) 78 | real(kind=dp), dimension(3,3), intent(in) :: rightCauchyGreen 79 | real(kind=dp) , intent(in) :: mu 80 | real(kind=dp) , intent(in) :: lambda 81 | real(kind=dp), dimension(3,3) :: res 82 | real(kind=dp), dimension(3,3) :: invRCG 83 | real(kind=dp) :: J 84 | 85 | invRCG = inverse(rightCauchyGreen) 86 | J = sqrt(det(rightCauchyGreen)) 87 | 88 | res = mu * (eye() - invRCG) + lambda/2.0d0 * (J**2 - 1)*invRCG 89 | 90 | end function getNeoHooke_stress 91 | 92 | !> Neo Hookean material model (material tangent modulus) 93 | !! Based on the formulation of the strain energy function as: 94 | !! psi = mu/2 * (trace(C) - 3) - mu * ln(J) + lambda/4 *(J^2 - 1 - 2*ln(J)) 95 | !! 96 | !! @param rightCauchyGreen Right Cauchy Green strain tensor 97 | !! @param mu Material Parameter (Lame mu) 98 | !! @param lambda Material Parameter (Lame lambda) 99 | !! @return res 4th order material tangent modulus (ref. config.) 100 | pure function getNeoHooke_tangent(rightCauchyGreen, mu, lambda) result(res) 101 | real(kind=dp), dimension(3,3), intent(in) :: rightCauchyGreen 102 | real(kind=dp) , intent(in) :: mu 103 | real(kind=dp) , intent(in) :: lambda 104 | real(kind=dp), dimension(3,3,3,3) :: res 105 | real(kind=dp), dimension(3,3,3,3) :: derivativeInvRCG 106 | real(kind=dp), dimension(3,3) :: invRCG 107 | real(kind=dp) :: J 108 | 109 | invRCG = inverse(rightCauchyGreen) 110 | J = sqrt(det(rightCauchyGreen)) 111 | derivativeInvRCG = getDerivativeInvRCG(invRCG) 112 | 113 | res = 2.0d0 * (lambda/2.0d0 * (J**2 - 1) - mu) * derivativeInvRCG + & 114 | lambda * J**2 * dyad(invRCG) 115 | 116 | end function getNeoHooke_tangent 117 | 118 | 119 | !> Arruda Boyce material model (material tangent modulus) 120 | !! Based on the formulation of the strain energy function as: 121 | !! psi = mu * SUM_k ( C_k / N^(k-1) * (trace(C)^k - 3^k)) - mu * ln(J) + lambda/4 *(J^2 - 1 - 2*ln(J)) 122 | !! 123 | !! @param rightCauchyGreen Right Cauchy Green strain tensor 124 | !! @param mu Material Parameter (Lame mu) 125 | !! @param lambda Material Parameter (Lame lambda) 126 | !! @param N Material Parameter (Chain length) 127 | !! @return res Energy 128 | function getArrudaBoyce_energy(rightCauchyGreen, mu, lambda, N) result(res) 129 | real(kind=dp), dimension(3,3), intent(in) :: rightCauchyGreen 130 | real(kind=dp) , intent(in) :: mu 131 | real(kind=dp) , intent(in) :: N 132 | real(kind=dp) , intent(in) :: lambda 133 | real(kind=dp) :: res 134 | real(kind=dp) :: J 135 | real(kind=dp) :: ab_sum 136 | integer :: i 137 | 138 | J = sqrt(det(rightCauchyGreen)) 139 | 140 | ab_sum = 0 141 | do i = 1,5,1 142 | ab_sum = ab_sum + ab_coefficients(i)/N**(i-1) * ( trace(rightCauchyGreen)**i - 3**i ) 143 | end do 144 | 145 | res = mu * (ab_sum - log(J)) + lambda/4.0d0 * (J**2 - 1 - 2*log(J)) 146 | 147 | end function getArrudaBoyce_energy 148 | 149 | 150 | !> Arruda Boyce material model (material tangent modulus) 151 | !! Based on the formulation of the strain energy function as: 152 | !! psi = mu * SUM_k ( C_k / N^(k-1) * (trace(C)^k - 3^k)) - mu * ln(J) + lambda/4 *(J^2 - 1 - 2*ln(J)) 153 | !! 154 | !! @param rightCauchyGreen Right Cauchy Green strain tensor 155 | !! @param mu Material Parameter (Lame mu) 156 | !! @param lambda Material Parameter (Lame lambda) 157 | !! @param N Material Parameter (Chain length) 158 | !! @return res 2nd Piola Kirchhoff stress tensor 159 | function getArrudaBoyce_stress(rightCauchyGreen, mu, lambda, N) result(res) 160 | real(kind=dp), dimension(3,3), intent(in) :: rightCauchyGreen 161 | real(kind=dp) , intent(in) :: mu 162 | real(kind=dp) , intent(in) :: N 163 | real(kind=dp) , intent(in) :: lambda 164 | real(kind=dp), dimension(3,3) :: res 165 | real(kind=dp), dimension(3,3) :: invRCG 166 | real(kind=dp) :: J 167 | real(kind=dp) :: ab_sum 168 | integer :: i 169 | 170 | invRCG = inverse(rightCauchyGreen) 171 | J = sqrt(det(rightCauchyGreen)) 172 | 173 | ab_sum = 0 174 | do i = 1,5,1 175 | ab_sum = ab_sum + ab_coefficients(i)/N**(i-1) * i * trace(rightCauchyGreen)**(i-1) 176 | end do 177 | 178 | res = 2 * (mu * (ab_sum * eye() - 0.5d0 * invRCG) + lambda/4.0d0 * (J**2 - 1) * invRCG) 179 | 180 | end function getArrudaBoyce_stress 181 | 182 | 183 | !> Derivative of inverse of right Cauchy Green wrt. the right Cauchy Green tensor 184 | !! 185 | !! @param invRightCauchyGreen Inverse of right Cauchy Green strain tensor 186 | !! @return res 4th order tensor 187 | pure function getDerivativeInvRCG(invRightCauchyGreen) result(res) 188 | real(kind=dp), dimension(3,3), intent(in) :: invRightCauchyGreen 189 | real(kind=dp), dimension(3,3,3,3) :: res 190 | integer :: i 191 | integer :: j 192 | integer :: k 193 | integer :: l 194 | 195 | res = 0.0d0 196 | 197 | do i = 1,3,1 198 | do j = 1,3,1 199 | do k = 1,3,1 200 | do l = 1,3,1 201 | res(i,j,k,l) = res(i,j,k,l) + & 202 | 0.5d0 * (invRightCauchyGreen(i,k) * invRightCauchyGreen(l,j) + & 203 | invRightCauchyGreen(i,l) * invRightCauchyGreen(k,j)) 204 | end do 205 | end do 206 | end do 207 | end do 208 | 209 | res = -1.0d0 * res 210 | 211 | end function getDerivativeInvRCG 212 | 213 | !> St.Venant Kirchhoff material model (stress response) 214 | !! 215 | !! @param rightCauchyGreen Right Cauchy Green strain tensor 216 | !! @param mu Material Parameter (Lame mu) 217 | !! @param lambda Material Parameter (Lame lambda) 218 | !! @return res 2nd Piola Kirchhoff stress tensor 219 | function getStVenant_stress(rightCauchyGreen, mu, lambda) result(res) 220 | real(kind=dp), dimension(3,3), intent(in) :: rightCauchyGreen 221 | real(kind=dp) , intent(in) :: mu 222 | real(kind=dp) , intent(in) :: lambda 223 | real(kind=dp), dimension(3,3) :: res 224 | real(kind=dp), dimension(3,3) :: greenStrain 225 | 226 | greenStrain = getGreenLagrange(rightCauchyGreen) 227 | 228 | res = lambda * trace(greenStrain) * eye() + 2 * mu * greenStrain 229 | 230 | end function getStVenant_stress 231 | 232 | !> St.Venant Kirchhoff material model (stress response) 233 | !! 234 | !! @param rightCauchyGreen Right Cauchy Green strain tensor 235 | !! @param mu Material Parameter (Lame mu) 236 | !! @param lambda Material Parameter (Lame lambda) 237 | !! @return res 4th order material tangent modulus (ref. config.) 238 | function getStVenant_tangent(mu, lambda) result(res) 239 | 240 | use libtt_print 241 | real(kind=dp) , intent(in) :: mu 242 | real(kind=dp) , intent(in) :: lambda 243 | real(kind=dp), dimension(3,3,3,3) :: res 244 | 245 | res = eye_4() 246 | res = 2 * mu * res 247 | res = res + lambda * dyad(eye()) 248 | 249 | end function getStVenant_tangent 250 | 251 | !> Anisotropic material model after Reese at al. 2000 (stress response) 252 | !! 253 | !! @param rightCauchyGreen Right Cauchy Green strain tensor 254 | !! @param fibreDir Fibre direction vector 255 | !! @param k Material Parameter (stiffness) 256 | !! @param alpha Material Parameter (shape) 257 | !! @return res 2nd Piola Kirchhoff stress tensor 258 | function getAnisotropicReese_stress(rightCauchyGreen, fibreDir, k, alpha) result(res) 259 | 260 | use libtt_common , only: invariants 261 | use libtt_products, only: dyad, doubleContract 262 | 263 | real(kind=dp), dimension(3,3), intent(in) :: rightCauchyGreen 264 | real(kind=dp), dimension(3) , intent(in) :: fibreDir 265 | real(kind=dp) , intent(in) :: k 266 | integer , intent(in) :: alpha 267 | real(kind=dp), dimension(3,3) :: res 268 | real(kind=dp), dimension(3,3) :: structuralTensor 269 | real(kind=dp), dimension(5) :: invars 270 | 271 | structuralTensor = dyad(fibreDir) 272 | invars = invariants(rightCauchyGreen, structuralTensor) 273 | 274 | res = 2 * alpha * k * (invars(4) - 1)**(alpha-1) * structuralTensor 275 | 276 | end function getAnisotropicReese_stress 277 | 278 | !> Anisotropic material model after Reese at al. 2000 (tangent modulus) 279 | !! 280 | !! @param rightCauchyGreen Right Cauchy Green strain tensor 281 | !! @param fibreDir Fibre direction vector 282 | !! @param k Material Parameter (stiffness) 283 | !! @param alpha Material Parameter (shape) 284 | !! @return res 4th order material tangent modulus (ref. config.) 285 | function getAnisotropicReese_tangent(rightCauchyGreen, fibreDir, k, alpha) result(res) 286 | 287 | use libtt_common, only: invariants 288 | use libtt_products, only: dyad 289 | 290 | real(kind=dp), dimension(3,3), intent(in) :: rightCauchyGreen 291 | real(kind=dp), dimension(3) , intent(in) :: fibreDir 292 | real(kind=dp) , intent(in) :: k 293 | integer , intent(in) :: alpha 294 | real(kind=dp), dimension(3,3,3,3) :: res 295 | real(kind=dp), dimension(3,3) :: structuralTensor 296 | real(kind=dp), dimension(5) :: invars 297 | 298 | structuralTensor = dyad(fibreDir) 299 | invars = invariants(rightCauchyGreen, structuralTensor) 300 | 301 | res = 4 * alpha**2 * k * (invars(4) - 1)**(alpha - 2) * dyad(structuralTensor, structuralTensor) 302 | 303 | end function getAnisotropicReese_tangent 304 | 305 | end module libtt_physics_elasticity 306 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 2.1, February 1999 3 | 4 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | [This is the first released version of the Lesser GPL. It also counts 10 | as the successor of the GNU Library Public License, version 2, hence 11 | the version number 2.1.] 12 | 13 | Preamble 14 | 15 | The licenses for most software are designed to take away your 16 | freedom to share and change it. By contrast, the GNU General Public 17 | Licenses are intended to guarantee your freedom to share and change 18 | free software--to make sure the software is free for all its users. 19 | 20 | This license, the Lesser General Public License, applies to some 21 | specially designated software packages--typically libraries--of the 22 | Free Software Foundation and other authors who decide to use it. You 23 | can use it too, but we suggest you first think carefully about whether 24 | this license or the ordinary General Public License is the better 25 | strategy to use in any particular case, based on the explanations below. 26 | 27 | When we speak of free software, we are referring to freedom of use, 28 | not price. Our General Public Licenses are designed to make sure that 29 | you have the freedom to distribute copies of free software (and charge 30 | for this service if you wish); that you receive source code or can get 31 | it if you want it; that you can change the software and use pieces of 32 | it in new free programs; and that you are informed that you can do 33 | these things. 34 | 35 | To protect your rights, we need to make restrictions that forbid 36 | distributors to deny you these rights or to ask you to surrender these 37 | rights. These restrictions translate to certain responsibilities for 38 | you if you distribute copies of the library or if you modify it. 39 | 40 | For example, if you distribute copies of the library, whether gratis 41 | or for a fee, you must give the recipients all the rights that we gave 42 | you. You must make sure that they, too, receive or can get the source 43 | code. If you link other code with the library, you must provide 44 | complete object files to the recipients, so that they can relink them 45 | with the library after making changes to the library and recompiling 46 | it. And you must show them these terms so they know their rights. 47 | 48 | We protect your rights with a two-step method: (1) we copyright the 49 | library, and (2) we offer you this license, which gives you legal 50 | permission to copy, distribute and/or modify the library. 51 | 52 | To protect each distributor, we want to make it very clear that 53 | there is no warranty for the free library. Also, if the library is 54 | modified by someone else and passed on, the recipients should know 55 | that what they have is not the original version, so that the original 56 | author's reputation will not be affected by problems that might be 57 | introduced by others. 58 | 59 | Finally, software patents pose a constant threat to the existence of 60 | any free program. We wish to make sure that a company cannot 61 | effectively restrict the users of a free program by obtaining a 62 | restrictive license from a patent holder. Therefore, we insist that 63 | any patent license obtained for a version of the library must be 64 | consistent with the full freedom of use specified in this license. 65 | 66 | Most GNU software, including some libraries, is covered by the 67 | ordinary GNU General Public License. This license, the GNU Lesser 68 | General Public License, applies to certain designated libraries, and 69 | is quite different from the ordinary General Public License. We use 70 | this license for certain libraries in order to permit linking those 71 | libraries into non-free programs. 72 | 73 | When a program is linked with a library, whether statically or using 74 | a shared library, the combination of the two is legally speaking a 75 | combined work, a derivative of the original library. The ordinary 76 | General Public License therefore permits such linking only if the 77 | entire combination fits its criteria of freedom. The Lesser General 78 | Public License permits more lax criteria for linking other code with 79 | the library. 80 | 81 | We call this license the "Lesser" General Public License because it 82 | does Less to protect the user's freedom than the ordinary General 83 | Public License. It also provides other free software developers Less 84 | of an advantage over competing non-free programs. These disadvantages 85 | are the reason we use the ordinary General Public License for many 86 | libraries. However, the Lesser license provides advantages in certain 87 | special circumstances. 88 | 89 | For example, on rare occasions, there may be a special need to 90 | encourage the widest possible use of a certain library, so that it becomes 91 | a de-facto standard. To achieve this, non-free programs must be 92 | allowed to use the library. A more frequent case is that a free 93 | library does the same job as widely used non-free libraries. In this 94 | case, there is little to gain by limiting the free library to free 95 | software only, so we use the Lesser General Public License. 96 | 97 | In other cases, permission to use a particular library in non-free 98 | programs enables a greater number of people to use a large body of 99 | free software. For example, permission to use the GNU C Library in 100 | non-free programs enables many more people to use the whole GNU 101 | operating system, as well as its variant, the GNU/Linux operating 102 | system. 103 | 104 | Although the Lesser General Public License is Less protective of the 105 | users' freedom, it does ensure that the user of a program that is 106 | linked with the Library has the freedom and the wherewithal to run 107 | that program using a modified version of the Library. 108 | 109 | The precise terms and conditions for copying, distribution and 110 | modification follow. Pay close attention to the difference between a 111 | "work based on the library" and a "work that uses the library". The 112 | former contains code derived from the library, whereas the latter must 113 | be combined with the library in order to run. 114 | 115 | GNU LESSER GENERAL PUBLIC LICENSE 116 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 117 | 118 | 0. This License Agreement applies to any software library or other 119 | program which contains a notice placed by the copyright holder or 120 | other authorized party saying it may be distributed under the terms of 121 | this Lesser General Public License (also called "this License"). 122 | Each licensee is addressed as "you". 123 | 124 | A "library" means a collection of software functions and/or data 125 | prepared so as to be conveniently linked with application programs 126 | (which use some of those functions and data) to form executables. 127 | 128 | The "Library", below, refers to any such software library or work 129 | which has been distributed under these terms. A "work based on the 130 | Library" means either the Library or any derivative work under 131 | copyright law: that is to say, a work containing the Library or a 132 | portion of it, either verbatim or with modifications and/or translated 133 | straightforwardly into another language. (Hereinafter, translation is 134 | included without limitation in the term "modification".) 135 | 136 | "Source code" for a work means the preferred form of the work for 137 | making modifications to it. For a library, complete source code means 138 | all the source code for all modules it contains, plus any associated 139 | interface definition files, plus the scripts used to control compilation 140 | and installation of the library. 141 | 142 | Activities other than copying, distribution and modification are not 143 | covered by this License; they are outside its scope. The act of 144 | running a program using the Library is not restricted, and output from 145 | such a program is covered only if its contents constitute a work based 146 | on the Library (independent of the use of the Library in a tool for 147 | writing it). Whether that is true depends on what the Library does 148 | and what the program that uses the Library does. 149 | 150 | 1. You may copy and distribute verbatim copies of the Library's 151 | complete source code as you receive it, in any medium, provided that 152 | you conspicuously and appropriately publish on each copy an 153 | appropriate copyright notice and disclaimer of warranty; keep intact 154 | all the notices that refer to this License and to the absence of any 155 | warranty; and distribute a copy of this License along with the 156 | Library. 157 | 158 | You may charge a fee for the physical act of transferring a copy, 159 | and you may at your option offer warranty protection in exchange for a 160 | fee. 161 | 162 | 2. You may modify your copy or copies of the Library or any portion 163 | of it, thus forming a work based on the Library, and copy and 164 | distribute such modifications or work under the terms of Section 1 165 | above, provided that you also meet all of these conditions: 166 | 167 | a) The modified work must itself be a software library. 168 | 169 | b) You must cause the files modified to carry prominent notices 170 | stating that you changed the files and the date of any change. 171 | 172 | c) You must cause the whole of the work to be licensed at no 173 | charge to all third parties under the terms of this License. 174 | 175 | d) If a facility in the modified Library refers to a function or a 176 | table of data to be supplied by an application program that uses 177 | the facility, other than as an argument passed when the facility 178 | is invoked, then you must make a good faith effort to ensure that, 179 | in the event an application does not supply such function or 180 | table, the facility still operates, and performs whatever part of 181 | its purpose remains meaningful. 182 | 183 | (For example, a function in a library to compute square roots has 184 | a purpose that is entirely well-defined independent of the 185 | application. Therefore, Subsection 2d requires that any 186 | application-supplied function or table used by this function must 187 | be optional: if the application does not supply it, the square 188 | root function must still compute square roots.) 189 | 190 | These requirements apply to the modified work as a whole. If 191 | identifiable sections of that work are not derived from the Library, 192 | and can be reasonably considered independent and separate works in 193 | themselves, then this License, and its terms, do not apply to those 194 | sections when you distribute them as separate works. But when you 195 | distribute the same sections as part of a whole which is a work based 196 | on the Library, the distribution of the whole must be on the terms of 197 | this License, whose permissions for other licensees extend to the 198 | entire whole, and thus to each and every part regardless of who wrote 199 | it. 200 | 201 | Thus, it is not the intent of this section to claim rights or contest 202 | your rights to work written entirely by you; rather, the intent is to 203 | exercise the right to control the distribution of derivative or 204 | collective works based on the Library. 205 | 206 | In addition, mere aggregation of another work not based on the Library 207 | with the Library (or with a work based on the Library) on a volume of 208 | a storage or distribution medium does not bring the other work under 209 | the scope of this License. 210 | 211 | 3. You may opt to apply the terms of the ordinary GNU General Public 212 | License instead of this License to a given copy of the Library. To do 213 | this, you must alter all the notices that refer to this License, so 214 | that they refer to the ordinary GNU General Public License, version 2, 215 | instead of to this License. (If a newer version than version 2 of the 216 | ordinary GNU General Public License has appeared, then you can specify 217 | that version instead if you wish.) Do not make any other change in 218 | these notices. 219 | 220 | Once this change is made in a given copy, it is irreversible for 221 | that copy, so the ordinary GNU General Public License applies to all 222 | subsequent copies and derivative works made from that copy. 223 | 224 | This option is useful when you wish to copy part of the code of 225 | the Library into a program that is not a library. 226 | 227 | 4. You may copy and distribute the Library (or a portion or 228 | derivative of it, under Section 2) in object code or executable form 229 | under the terms of Sections 1 and 2 above provided that you accompany 230 | it with the complete corresponding machine-readable source code, which 231 | must be distributed under the terms of Sections 1 and 2 above on a 232 | medium customarily used for software interchange. 233 | 234 | If distribution of object code is made by offering access to copy 235 | from a designated place, then offering equivalent access to copy the 236 | source code from the same place satisfies the requirement to 237 | distribute the source code, even though third parties are not 238 | compelled to copy the source along with the object code. 239 | 240 | 5. A program that contains no derivative of any portion of the 241 | Library, but is designed to work with the Library by being compiled or 242 | linked with it, is called a "work that uses the Library". Such a 243 | work, in isolation, is not a derivative work of the Library, and 244 | therefore falls outside the scope of this License. 245 | 246 | However, linking a "work that uses the Library" with the Library 247 | creates an executable that is a derivative of the Library (because it 248 | contains portions of the Library), rather than a "work that uses the 249 | library". The executable is therefore covered by this License. 250 | Section 6 states terms for distribution of such executables. 251 | 252 | When a "work that uses the Library" uses material from a header file 253 | that is part of the Library, the object code for the work may be a 254 | derivative work of the Library even though the source code is not. 255 | Whether this is true is especially significant if the work can be 256 | linked without the Library, or if the work is itself a library. The 257 | threshold for this to be true is not precisely defined by law. 258 | 259 | If such an object file uses only numerical parameters, data 260 | structure layouts and accessors, and small macros and small inline 261 | functions (ten lines or less in length), then the use of the object 262 | file is unrestricted, regardless of whether it is legally a derivative 263 | work. (Executables containing this object code plus portions of the 264 | Library will still fall under Section 6.) 265 | 266 | Otherwise, if the work is a derivative of the Library, you may 267 | distribute the object code for the work under the terms of Section 6. 268 | Any executables containing that work also fall under Section 6, 269 | whether or not they are linked directly with the Library itself. 270 | 271 | 6. As an exception to the Sections above, you may also combine or 272 | link a "work that uses the Library" with the Library to produce a 273 | work containing portions of the Library, and distribute that work 274 | under terms of your choice, provided that the terms permit 275 | modification of the work for the customer's own use and reverse 276 | engineering for debugging such modifications. 277 | 278 | You must give prominent notice with each copy of the work that the 279 | Library is used in it and that the Library and its use are covered by 280 | this License. You must supply a copy of this License. If the work 281 | during execution displays copyright notices, you must include the 282 | copyright notice for the Library among them, as well as a reference 283 | directing the user to the copy of this License. Also, you must do one 284 | of these things: 285 | 286 | a) Accompany the work with the complete corresponding 287 | machine-readable source code for the Library including whatever 288 | changes were used in the work (which must be distributed under 289 | Sections 1 and 2 above); and, if the work is an executable linked 290 | with the Library, with the complete machine-readable "work that 291 | uses the Library", as object code and/or source code, so that the 292 | user can modify the Library and then relink to produce a modified 293 | executable containing the modified Library. (It is understood 294 | that the user who changes the contents of definitions files in the 295 | Library will not necessarily be able to recompile the application 296 | to use the modified definitions.) 297 | 298 | b) Use a suitable shared library mechanism for linking with the 299 | Library. A suitable mechanism is one that (1) uses at run time a 300 | copy of the library already present on the user's computer system, 301 | rather than copying library functions into the executable, and (2) 302 | will operate properly with a modified version of the library, if 303 | the user installs one, as long as the modified version is 304 | interface-compatible with the version that the work was made with. 305 | 306 | c) Accompany the work with a written offer, valid for at 307 | least three years, to give the same user the materials 308 | specified in Subsection 6a, above, for a charge no more 309 | than the cost of performing this distribution. 310 | 311 | d) If distribution of the work is made by offering access to copy 312 | from a designated place, offer equivalent access to copy the above 313 | specified materials from the same place. 314 | 315 | e) Verify that the user has already received a copy of these 316 | materials or that you have already sent this user a copy. 317 | 318 | For an executable, the required form of the "work that uses the 319 | Library" must include any data and utility programs needed for 320 | reproducing the executable from it. However, as a special exception, 321 | the materials to be distributed need not include anything that is 322 | normally distributed (in either source or binary form) with the major 323 | components (compiler, kernel, and so on) of the operating system on 324 | which the executable runs, unless that component itself accompanies 325 | the executable. 326 | 327 | It may happen that this requirement contradicts the license 328 | restrictions of other proprietary libraries that do not normally 329 | accompany the operating system. Such a contradiction means you cannot 330 | use both them and the Library together in an executable that you 331 | distribute. 332 | 333 | 7. You may place library facilities that are a work based on the 334 | Library side-by-side in a single library together with other library 335 | facilities not covered by this License, and distribute such a combined 336 | library, provided that the separate distribution of the work based on 337 | the Library and of the other library facilities is otherwise 338 | permitted, and provided that you do these two things: 339 | 340 | a) Accompany the combined library with a copy of the same work 341 | based on the Library, uncombined with any other library 342 | facilities. This must be distributed under the terms of the 343 | Sections above. 344 | 345 | b) Give prominent notice with the combined library of the fact 346 | that part of it is a work based on the Library, and explaining 347 | where to find the accompanying uncombined form of the same work. 348 | 349 | 8. You may not copy, modify, sublicense, link with, or distribute 350 | the Library except as expressly provided under this License. Any 351 | attempt otherwise to copy, modify, sublicense, link with, or 352 | distribute the Library is void, and will automatically terminate your 353 | rights under this License. However, parties who have received copies, 354 | or rights, from you under this License will not have their licenses 355 | terminated so long as such parties remain in full compliance. 356 | 357 | 9. You are not required to accept this License, since you have not 358 | signed it. However, nothing else grants you permission to modify or 359 | distribute the Library or its derivative works. These actions are 360 | prohibited by law if you do not accept this License. Therefore, by 361 | modifying or distributing the Library (or any work based on the 362 | Library), you indicate your acceptance of this License to do so, and 363 | all its terms and conditions for copying, distributing or modifying 364 | the Library or works based on it. 365 | 366 | 10. Each time you redistribute the Library (or any work based on the 367 | Library), the recipient automatically receives a license from the 368 | original licensor to copy, distribute, link with or modify the Library 369 | subject to these terms and conditions. You may not impose any further 370 | restrictions on the recipients' exercise of the rights granted herein. 371 | You are not responsible for enforcing compliance by third parties with 372 | this License. 373 | 374 | 11. If, as a consequence of a court judgment or allegation of patent 375 | infringement or for any other reason (not limited to patent issues), 376 | conditions are imposed on you (whether by court order, agreement or 377 | otherwise) that contradict the conditions of this License, they do not 378 | excuse you from the conditions of this License. If you cannot 379 | distribute so as to satisfy simultaneously your obligations under this 380 | License and any other pertinent obligations, then as a consequence you 381 | may not distribute the Library at all. For example, if a patent 382 | license would not permit royalty-free redistribution of the Library by 383 | all those who receive copies directly or indirectly through you, then 384 | the only way you could satisfy both it and this License would be to 385 | refrain entirely from distribution of the Library. 386 | 387 | If any portion of this section is held invalid or unenforceable under any 388 | particular circumstance, the balance of the section is intended to apply, 389 | and the section as a whole is intended to apply in other circumstances. 390 | 391 | It is not the purpose of this section to induce you to infringe any 392 | patents or other property right claims or to contest validity of any 393 | such claims; this section has the sole purpose of protecting the 394 | integrity of the free software distribution system which is 395 | implemented by public license practices. Many people have made 396 | generous contributions to the wide range of software distributed 397 | through that system in reliance on consistent application of that 398 | system; it is up to the author/donor to decide if he or she is willing 399 | to distribute software through any other system and a licensee cannot 400 | impose that choice. 401 | 402 | This section is intended to make thoroughly clear what is believed to 403 | be a consequence of the rest of this License. 404 | 405 | 12. If the distribution and/or use of the Library is restricted in 406 | certain countries either by patents or by copyrighted interfaces, the 407 | original copyright holder who places the Library under this License may add 408 | an explicit geographical distribution limitation excluding those countries, 409 | so that distribution is permitted only in or among countries not thus 410 | excluded. In such case, this License incorporates the limitation as if 411 | written in the body of this License. 412 | 413 | 13. The Free Software Foundation may publish revised and/or new 414 | versions of the Lesser General Public License from time to time. 415 | Such new versions will be similar in spirit to the present version, 416 | but may differ in detail to address new problems or concerns. 417 | 418 | Each version is given a distinguishing version number. If the Library 419 | specifies a version number of this License which applies to it and 420 | "any later version", you have the option of following the terms and 421 | conditions either of that version or of any later version published by 422 | the Free Software Foundation. If the Library does not specify a 423 | license version number, you may choose any version ever published by 424 | the Free Software Foundation. 425 | 426 | 14. If you wish to incorporate parts of the Library into other free 427 | programs whose distribution conditions are incompatible with these, 428 | write to the author to ask for permission. For software which is 429 | copyrighted by the Free Software Foundation, write to the Free 430 | Software Foundation; we sometimes make exceptions for this. Our 431 | decision will be guided by the two goals of preserving the free status 432 | of all derivatives of our free software and of promoting the sharing 433 | and reuse of software generally. 434 | 435 | NO WARRANTY 436 | 437 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 438 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 439 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 440 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 441 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 442 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 443 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 444 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 445 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 446 | 447 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 448 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 449 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 450 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 451 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 452 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 453 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 454 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 455 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 456 | DAMAGES. 457 | 458 | END OF TERMS AND CONDITIONS 459 | 460 | How to Apply These Terms to Your New Libraries 461 | 462 | If you develop a new library, and you want it to be of the greatest 463 | possible use to the public, we recommend making it free software that 464 | everyone can redistribute and change. You can do so by permitting 465 | redistribution under these terms (or, alternatively, under the terms of the 466 | ordinary General Public License). 467 | 468 | To apply these terms, attach the following notices to the library. It is 469 | safest to attach them to the start of each source file to most effectively 470 | convey the exclusion of warranty; and each file should have at least the 471 | "copyright" line and a pointer to where the full notice is found. 472 | 473 | 474 | Copyright (C) 475 | 476 | This library is free software; you can redistribute it and/or 477 | modify it under the terms of the GNU Lesser General Public 478 | License as published by the Free Software Foundation; either 479 | version 2.1 of the License, or (at your option) any later version. 480 | 481 | This library is distributed in the hope that it will be useful, 482 | but WITHOUT ANY WARRANTY; without even the implied warranty of 483 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 484 | Lesser General Public License for more details. 485 | 486 | You should have received a copy of the GNU Lesser General Public 487 | License along with this library; if not, write to the Free Software 488 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 489 | USA 490 | 491 | Also add information on how to contact you by electronic and paper mail. 492 | 493 | You should also get your employer (if you work as a programmer) or your 494 | school, if any, to sign a "copyright disclaimer" for the library, if 495 | necessary. Here is a sample; alter the names: 496 | 497 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 498 | library `Frob' (a library for tweaking knobs) written by James Random 499 | Hacker. 500 | 501 | , 1 April 1990 502 | Ty Coon, President of Vice 503 | 504 | That's all there is to it! 505 | --------------------------------------------------------------------------------