From de6067f8ec7cce001aad2a34a4676f31fdc54754 Mon Sep 17 00:00:00 2001 From: william-dawson Date: Fri, 7 Apr 2023 09:33:46 +0900 Subject: [PATCH] Eigensolver Fallback Option (#187) * Dense infastructure * Dense versions of standard functions * Turn lambda into a function of one variable * Dense density matrix solver * Linting for a more consistent feel * Singular value decomposition * Separate singular values into a new module Avoids cyclic dependency * Example directions fixed * My theory is that the test has a race condition * Try reactivating just the diagonal check of the eigenvalues * Test vectors too * Reactivate SVD test * Dense FOE for reference purposes * Forgot to add files * Removed testing line * Apparantely, those default values cause trouble * Fix capitalization * Fix chemical potential calculation * Fix cmake * Fix typo * Merge with master - fix * Merge in partial electrons * Fix a bug where we checked an unallocated variable's properties * Increase optional parameters for eigenexa (#190) * TRS4 seems faster * Nvals option for serial * Set number of values for eigenexa * Fix for optional vectors * Forgot conjugate in test --- CMake/FindEigenExa.cmake | 15 + CMakeLists.txt | 8 + Examples/CMakeLinkage/CMakeLists.txt | 4 +- Examples/ComplexMatrix/ReadMe.md | 4 +- Examples/GraphTheory/ReadMe.md | 4 +- Examples/HydrogenAtom/ReadMe.md | 4 +- Examples/MatrixMaps/ReadMe.md | 4 +- Examples/OverlapMatrix/ReadMe.md | 2 +- Examples/PremadeMatrix/ReadMe.md | 4 +- ReadMe.md | 3 + Source/C/CMakeLists.txt | 1 + Source/C/DensityMatrixSolvers_c.h | 5 + Source/C/EigenSolvers_c.h | 13 + Source/C/ExponentialSolvers_c.h | 4 + Source/C/FermiOperator_c.h | 10 + Source/C/InverseSolvers_c.h | 2 + Source/C/SignSolvers_c.h | 2 + Source/C/SquareRootSolvers_c.h | 4 + Source/C/TrigonometrySolvers_c.h | 4 + Source/CPlusPlus/CMakeLists.txt | 4 + Source/CPlusPlus/DensityMatrixSolvers.cc | 10 + Source/CPlusPlus/DensityMatrixSolvers.h | 13 + Source/CPlusPlus/EigenSolvers.cc | 33 + Source/CPlusPlus/EigenSolvers.h | 45 + Source/CPlusPlus/ExponentialSolvers.cc | 14 + Source/CPlusPlus/ExponentialSolvers.h | 14 + Source/CPlusPlus/FermiOperator.cc | 24 + Source/CPlusPlus/FermiOperator.h | 30 + Source/CPlusPlus/InverseSolvers.cc | 6 + Source/CPlusPlus/InverseSolvers.h | 6 + Source/CPlusPlus/SignSolvers.cc | 6 + Source/CPlusPlus/SignSolvers.h | 6 + Source/CPlusPlus/SquareRootSolvers.cc | 13 + Source/CPlusPlus/SquareRootSolvers.h | 13 + Source/CPlusPlus/TrigonometrySolvers.cc | 11 + Source/CPlusPlus/TrigonometrySolvers.h | 12 + Source/Fortran/AnalysisModule.F90 | 4 +- Source/Fortran/CMakeLists.txt | 12 +- Source/Fortran/ChebyshevSolversModule.F90 | 102 ++- Source/Fortran/DMatrixModule.F90 | 132 +++ Source/Fortran/DensityMatrixSolversModule.F90 | 831 +++++++++--------- Source/Fortran/EigenBoundsModule.F90 | 54 +- Source/Fortran/EigenExaModule.F90 | 390 ++++++++ Source/Fortran/EigenSolversModule.F90 | 235 +++++ Source/Fortran/ExponentialSolversModule.F90 | 256 ++++-- Source/Fortran/FermiOperatorModule.F90 | 219 +++++ Source/Fortran/GeometryOptimizationModule.F90 | 1 + Source/Fortran/HermiteSolversModule.F90 | 38 +- Source/Fortran/InverseSolversModule.F90 | 227 +++-- Source/Fortran/LinearSolversModule.F90 | 67 +- Source/Fortran/PSMatrixModule.F90 | 8 +- Source/Fortran/PolynomialSolversModule.F90 | 87 +- Source/Fortran/RootSolversModule.F90 | 154 ++-- Source/Fortran/SignSolversModule.F90 | 149 ++-- Source/Fortran/SingularValueSolversModule.F90 | 69 ++ Source/Fortran/SquareRootSolversModule.F90 | 347 +++++--- Source/Fortran/TrigonometrySolversModule.F90 | 280 +++--- Source/Fortran/eigenexa_includes/Cleanup.f90 | 5 + Source/Fortran/eigenexa_includes/Compute.f90 | 7 + .../Fortran/eigenexa_includes/EigenExa_s.F90 | 59 ++ .../Fortran/eigenexa_includes/EigenSerial.f90 | 41 + .../Fortran/eigenexa_includes/EigenToNT.f90 | 39 + .../Fortran/eigenexa_includes/NTToEigen.f90 | 48 + .../Fortran/solver_includes/EigenSerial.f90 | 65 -- Source/Swig/CMakeLists.txt | 3 +- Source/Swig/NTPolySwig.i | 4 + Source/Wrapper/CMakeLists.txt | 2 + .../DensityMatrixSolversModule_wrp.F90 | 30 +- Source/Wrapper/EigenSolversModule_wrp.F90 | 87 ++ .../Wrapper/ExponentialSolversModule_wrp.F90 | 41 +- Source/Wrapper/FermiOperatorModule_wrp.F90 | 44 + Source/Wrapper/InverseSolversModule_wrp.F90 | 20 +- Source/Wrapper/SignSolversModule_wrp.F90 | 22 +- .../Wrapper/SquareRootSolversModule_wrp.F90 | 42 +- .../Wrapper/TrigonometrySolversModule_wrp.F90 | 38 +- Targets/Mac-conda.cmake | 3 +- UnitTests/test_chemistry.py | 52 +- UnitTests/test_solvers.py | 324 +++++++ 78 files changed, 3770 insertions(+), 1225 deletions(-) create mode 100644 CMake/FindEigenExa.cmake create mode 100644 Source/C/EigenSolvers_c.h create mode 100644 Source/C/FermiOperator_c.h create mode 100644 Source/CPlusPlus/EigenSolvers.cc create mode 100644 Source/CPlusPlus/EigenSolvers.h create mode 100644 Source/CPlusPlus/FermiOperator.cc create mode 100644 Source/CPlusPlus/FermiOperator.h create mode 100644 Source/Fortran/EigenExaModule.F90 create mode 100644 Source/Fortran/EigenSolversModule.F90 create mode 100644 Source/Fortran/FermiOperatorModule.F90 create mode 100644 Source/Fortran/SingularValueSolversModule.F90 create mode 100644 Source/Fortran/eigenexa_includes/Cleanup.f90 create mode 100644 Source/Fortran/eigenexa_includes/Compute.f90 create mode 100644 Source/Fortran/eigenexa_includes/EigenExa_s.F90 create mode 100644 Source/Fortran/eigenexa_includes/EigenSerial.f90 create mode 100644 Source/Fortran/eigenexa_includes/EigenToNT.f90 create mode 100644 Source/Fortran/eigenexa_includes/NTToEigen.f90 delete mode 100644 Source/Fortran/solver_includes/EigenSerial.f90 create mode 100644 Source/Wrapper/EigenSolversModule_wrp.F90 create mode 100644 Source/Wrapper/FermiOperatorModule_wrp.F90 diff --git a/CMake/FindEigenExa.cmake b/CMake/FindEigenExa.cmake new file mode 100644 index 00000000..8459b6cb --- /dev/null +++ b/CMake/FindEigenExa.cmake @@ -0,0 +1,15 @@ +# Find the EigenExa Module +# Variables set: +# - EigenExa_FOUND - system found EigenExa. +# - EigenExa_LIBRARIES - the linker line for EigenExa. +# - EigenExa_INCLUDE_DIRS - the path to EigenExa. + +# First we search for the libraries +find_library(EigenExa_LIBRARIES EigenExa) +find_path(EigenExa_INCLUDE_DIRS "eigen_libs_mod.mod") + +# Now check if that worked +include(FindPackageHandleStandardArgs) +find_package_handle_standard_args(EigenExa DEFAULT_MSG + EigenExa_LIBRARIES EigenExa_INCLUDE_DIRS) +mark_as_advanced(EigenExa_LIBRARIES EigenExa_INCLUDE_DIRS) diff --git a/CMakeLists.txt b/CMakeLists.txt index f669de31..c8db3eb7 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,6 +7,7 @@ enable_language(Fortran) ################################################################################ ## Packages +set(CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/CMake) if (NOT CMAKE_TOOLCHAIN_FILE) message(WARNING "Building without a toolchain file. " "If this does not work, please see the example toolchain files in " @@ -14,8 +15,15 @@ if (NOT CMAKE_TOOLCHAIN_FILE) "system.") find_package(MPI REQUIRED) find_package(BLAS) + find_package(LAPACK) endif() find_package(SWIG 3.0) +find_package(EigenExa) +if (EigenExa_FOUND) + add_definitions("-DEIGENEXA") + set(EigenSolver_LIBRARIES ${EigenExa_LIBRARIES}) + set(EigenSolver_INCLUDE_DIRS ${EigenExa_INCLUDE_DIRS}) +endif() ################################################################################ ## Options diff --git a/Examples/CMakeLinkage/CMakeLists.txt b/Examples/CMakeLinkage/CMakeLists.txt index 622c2bba..7645895c 100644 --- a/Examples/CMakeLinkage/CMakeLists.txt +++ b/Examples/CMakeLinkage/CMakeLists.txt @@ -13,6 +13,7 @@ find_package(NTPolyWrapper REQUIRED) find_package(NTPolyCPP REQUIRED) find_package(OpenMP) find_package(BLAS) +find_package(LAPACK) ################################################################################ ## Output Locations @@ -22,7 +23,8 @@ set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin) ## Fortran Version add_executable(example_fortran ${CMAKE_SOURCE_DIR}/../PremadeMatrix/main.f90) target_link_libraries(example_fortran NTPoly::NTPoly ${MPI_Fortran_LIBRARIES} - ${OpenMP_Fortran_LIBRARIES} ${BLAS_LIBRARIES}) + ${OpenMP_Fortran_LIBRARIES} ${LAPACK_LIBRARIES} + ${BLAS_LIBRARIES}) target_include_directories(example_fortran PRIVATE ${MPI_INCLUDE_PATH}) install(TARGETS example_fortran DESTINATION bin) diff --git a/Examples/ComplexMatrix/ReadMe.md b/Examples/ComplexMatrix/ReadMe.md index 45732316..161d61af 100644 --- a/Examples/ComplexMatrix/ReadMe.md +++ b/Examples/ComplexMatrix/ReadMe.md @@ -38,7 +38,7 @@ Fortran Build Instructions: ``` mpif90 main.f90 -o example \ -I../../Build/include \ - -L../../Build/lib -lNTPoly -fopenmp -lblas + -L../../Build/lib -lNTPoly -fopenmp -llapack -lblas ``` @@ -49,7 +49,7 @@ mpicxx main.cc -c \ mpif90 main.o -o example \ -L../../Build/lib -lNTPolyCPP -lNTPolyWrapper -lNTPoly -fopenmp -lstdc++ \ - -lblas -lmpi_cxx + -llapack -lblas -lmpi_cxx ``` diff --git a/Examples/GraphTheory/ReadMe.md b/Examples/GraphTheory/ReadMe.md index 2b523855..31991ad1 100644 --- a/Examples/GraphTheory/ReadMe.md +++ b/Examples/GraphTheory/ReadMe.md @@ -22,7 +22,7 @@ Fortran Build Instructions: ``` mpif90 main.f90 -o example \ -I../../Build/include \ - -L../../Build/lib -lNTPoly -fopenmp -lblas + -L../../Build/lib -lNTPoly -fopenmp -llapack -lblas ``` @@ -33,7 +33,7 @@ mpicxx main.cc -c \ mpif90 main.o -o example \ -L../../Build/lib -lNTPolyCPP -lNTPolyWrapper -lNTPoly -fopenmp -lstdc++ \ - -lblas -lmpi_cxx + -llapack -lblas -lmpi_cxx ``` diff --git a/Examples/HydrogenAtom/ReadMe.md b/Examples/HydrogenAtom/ReadMe.md index a359e326..7589b78d 100644 --- a/Examples/HydrogenAtom/ReadMe.md +++ b/Examples/HydrogenAtom/ReadMe.md @@ -49,7 +49,7 @@ Fortran Build Instructions: ``` mpif90 main.f90 -o example \ -I../../Build/include \ - -L../../Build/lib -lNTPoly -fopenmp -lblas + -L../../Build/lib -lNTPoly -fopenmp -llapack -lblas ``` C++ Build Instructions: @@ -59,7 +59,7 @@ mpicxx main.cc -c \ mpif90 main.o -o example \ -L../../Build/lib -lNTPolyCPP -lNTPolyWrapper -lNTPoly -fopenmp -lstdc++ \ - -lblas -lmpi_cxx + -llapack -lblas -lmpi_cxx ``` diff --git a/Examples/MatrixMaps/ReadMe.md b/Examples/MatrixMaps/ReadMe.md index 5551d952..ab63ccbd 100644 --- a/Examples/MatrixMaps/ReadMe.md +++ b/Examples/MatrixMaps/ReadMe.md @@ -28,7 +28,7 @@ Fortran Build Instructions: ``` mpif90 main.f90 -o example \ -I../../Build/include \ - -L../../Build/lib -lNTPoly -fopenmp -lblas + -L../../Build/lib -lNTPoly -fopenmp -llapack -lblas ``` @@ -39,7 +39,7 @@ mpicxx main.cc -c \ mpif90 main.o -o example \ -L../../Build/lib -lNTPolyCPP -lNTPolyWrapper -lNTPoly -fopenmp -lstdc++ \ - -lblas -lmpi_cxx + -llapack -lblas -lmpi_cxx ``` diff --git a/Examples/OverlapMatrix/ReadMe.md b/Examples/OverlapMatrix/ReadMe.md index 4dcb9606..0e801ca5 100644 --- a/Examples/OverlapMatrix/ReadMe.md +++ b/Examples/OverlapMatrix/ReadMe.md @@ -61,7 +61,7 @@ Build with: ``` mpif90 main.f90 -o example \ -I../../Build/include \ - -L../../Build/lib -lNTPoly -fopenmp -lblas + -L../../Build/lib -lNTPoly -fopenmp -llapack -lblas ``` diff --git a/Examples/PremadeMatrix/ReadMe.md b/Examples/PremadeMatrix/ReadMe.md index bbe6f915..52202fc4 100644 --- a/Examples/PremadeMatrix/ReadMe.md +++ b/Examples/PremadeMatrix/ReadMe.md @@ -47,7 +47,7 @@ Fortran Build Instructions: ``` mpif90 main.f90 -o example \ -I../../Build/include \ - -L../../Build/lib -lNTPoly -fopenmp -lblas + -L../../Build/lib -lNTPoly -fopenmp -llapack -lblas ``` @@ -58,7 +58,7 @@ mpicxx main.cc -c \ mpif90 main.o -o example \ -L../../Build/lib -lNTPolyCPP -lNTPolyWrapper -lNTPoly -fopenmp -lstdc++ \ - -lblas -lmpi_cxx + -llapack -lblas -lmpi_cxx ``` diff --git a/ReadMe.md b/ReadMe.md index 9414b9e6..49e086aa 100644 --- a/ReadMe.md +++ b/ReadMe.md @@ -21,6 +21,7 @@ Installing NTPoly requires the following software: * An MPI Installation (MPI-3 Standard+). * CMake (Version 3.2+). * BLAS: for multiplying dense matrices, if they emerge in the calculation. +* LAPACK: for dense solvers. The following optional software can greatly enhance the NTPoly experience: @@ -32,6 +33,7 @@ The following optional software can greatly enhance the NTPoly experience: * MPI4PY: for testing. * SciPy: for testing. * NumPy: for testing. +* EigenExa: for dense, parallel calculations. NTPoly uses CMake as a build system. First, take a look in the Targets directory. You'll find a list of `.cmake` files which have example @@ -132,6 +134,7 @@ The following features and methods have been implemented in NTPoly: * Other * Matrix Inverse/Moore-Penrose Pseudo Inverse * Sign Function/Polar Decomposition + * Interface to Dense Eigen/Singular Value Decomposition * Load Balancing Matrices * File I/O diff --git a/Source/C/CMakeLists.txt b/Source/C/CMakeLists.txt index b4c70c7c..1a7b2bcf 100644 --- a/Source/C/CMakeLists.txt +++ b/Source/C/CMakeLists.txt @@ -3,6 +3,7 @@ set(Csrc ChebyshevSolvers_c.h DensityMatrixSolvers_c.h EigenBounds_c.h + EigenSolvers_c.h ExponentialSolvers_c.h GeometryOptimization_c.h HermiteSolvers_c.h diff --git a/Source/C/DensityMatrixSolvers_c.h b/Source/C/DensityMatrixSolvers_c.h index 33243734..0df5ebc1 100644 --- a/Source/C/DensityMatrixSolvers_c.h +++ b/Source/C/DensityMatrixSolvers_c.h @@ -26,6 +26,11 @@ void ScaleAndFold_wrp(const int *ih_Hamiltonian, int *ih_Density, const double *homo, const double *lumo, const double *energy_value_out, const int *ih_solver_parameters); +void DenseDensity_wrp(const int *ih_Hamiltonian, + const int *ih_InverseSquareRoot, const double *trace, + int *ih_Density, const double *energy_value_out, + const double *chemical_potential_out, + const int *ih_solver_parameters); void EnergyDensityMatrix_wrp(const int *ih_Hamiltonian, const int *ih_Density, int *ih_EnergyDensity, const double *threshold); #endif diff --git a/Source/C/EigenSolvers_c.h b/Source/C/EigenSolvers_c.h new file mode 100644 index 00000000..8a81fc16 --- /dev/null +++ b/Source/C/EigenSolvers_c.h @@ -0,0 +1,13 @@ +#ifndef EIGENSOLVERS_ch +#define EIGENSOLVERS_ch + +void EigenDecomposition_wrp(const int *ih_this, int *ih_eigenvectors, + const int *nvals, int *ih_eigenvalues, + const int *ih_solver_parameters); +void EigenDecomposition_novec_wrp(const int *ih_this, int *ih_eigenvectors, + const int *nvals, + const int *ih_solver_parameters); +void SingularValueDecompostion_wrp(const int *ih_this, int *ih_leftvectors, + int *ih_rightvectors, int *ih_singularvalues, + const int *ih_solver_parameters); +#endif diff --git a/Source/C/ExponentialSolvers_c.h b/Source/C/ExponentialSolvers_c.h index e8682616..ba7b46f3 100644 --- a/Source/C/ExponentialSolvers_c.h +++ b/Source/C/ExponentialSolvers_c.h @@ -3,9 +3,13 @@ void ComputeExponential_wrp(const int *ih_Input, int *ih_Output, const int *ih_solver_parameters); +void ComputeDenseExponential_wrp(const int *ih_Input, int *ih_Output, + const int *ih_solver_parameters); void ComputeExponentialPade_wrp(const int *ih_Input, int *ih_Output, const int *ih_solver_parameters); void ComputeLogarithm_wrp(const int *ih_Input, int *ih_Output, const int *ih_solver_parameters); +void ComputeDenseLogarithm_wrp(const int *ih_Input, int *ih_Output, + const int *ih_solver_parameters); #endif diff --git a/Source/C/FermiOperator_c.h b/Source/C/FermiOperator_c.h new file mode 100644 index 00000000..b745fbc9 --- /dev/null +++ b/Source/C/FermiOperator_c.h @@ -0,0 +1,10 @@ +#ifndef DENSITYMATRIXSOLVERS_ch +#define DENSITYMATRIXSOLVERS_ch + +void ComputeDenseFOE_wrp(const int *ih_Hamiltonian, + const int *ih_InverseSquareRoot, const double *trace, + int *ih_Density, const double *inv_temp_in, + const double *energy_value_out, + const double *chemical_potential_out, + const int *ih_solver_parameters); +#endif diff --git a/Source/C/InverseSolvers_c.h b/Source/C/InverseSolvers_c.h index c10671e3..25948a0e 100644 --- a/Source/C/InverseSolvers_c.h +++ b/Source/C/InverseSolvers_c.h @@ -3,6 +3,8 @@ void Invert_wrp(const int *ih_Hamiltonian, int *ih_Inverse, const int *ih_solver_parameters); +void DenseInvert_wrp(const int *ih_Hamiltonian, int *ih_Inverse, + const int *ih_solver_parameters); void PseudoInverse_wrp(const int *ih_Hamiltonian, int *ih_Inverse, const int *ih_solver_parameters); #endif diff --git a/Source/C/SignSolvers_c.h b/Source/C/SignSolvers_c.h index 9ba7e1a9..c3c304f0 100644 --- a/Source/C/SignSolvers_c.h +++ b/Source/C/SignSolvers_c.h @@ -3,6 +3,8 @@ void SignFunction_wrp(const int *ih_mat1, int *ih_signmat, const int *ih_solver_parameters); +void DenseSignFunction_wrp(const int *ih_mat1, int *ih_signmat, + const int *ih_solver_parameters); void PolarDecomposition_wrp(const int *ih_mat1, int *ih_umat, int *ih_hmat, const int *ih_solver_parameters); #endif diff --git a/Source/C/SquareRootSolvers_c.h b/Source/C/SquareRootSolvers_c.h index 1fd4b8a3..06e856af 100644 --- a/Source/C/SquareRootSolvers_c.h +++ b/Source/C/SquareRootSolvers_c.h @@ -3,7 +3,11 @@ void SquareRoot_wrp(const int *ih_Input, int *ih_Output, const int *ih_solver_parameters); +void DenseSquareRoot_wrp(const int *ih_Input, int *ih_Output, + const int *ih_solver_parameters); void InverseSquareRoot_wrp(const int *ih_Input, int *ih_Output, const int *ih_solver_parameters); +void DenseInverseSquareRoot_wrp(const int *ih_Input, int *ih_Output, + const int *ih_solver_parameters); #endif diff --git a/Source/C/TrigonometrySolvers_c.h b/Source/C/TrigonometrySolvers_c.h index ec5dd8dd..3e7cf4e6 100644 --- a/Source/C/TrigonometrySolvers_c.h +++ b/Source/C/TrigonometrySolvers_c.h @@ -3,7 +3,11 @@ void Sine_wrp(const int *ih_Input, int *ih_Output, const int *ih_solver_parameters); +void DenseSine_wrp(const int *ih_Input, int *ih_Output, + const int *ih_solver_parameters); void Cosine_wrp(const int *ih_Input, int *ih_Output, const int *ih_solver_parameters); +void DenseCosine_wrp(const int *ih_Input, int *ih_Output, + const int *ih_solver_parameters); #endif diff --git a/Source/CPlusPlus/CMakeLists.txt b/Source/CPlusPlus/CMakeLists.txt index 7c78d84e..ceb0d04d 100644 --- a/Source/CPlusPlus/CMakeLists.txt +++ b/Source/CPlusPlus/CMakeLists.txt @@ -4,7 +4,9 @@ set(Csrc ChebyshevSolvers.cc DensityMatrixSolvers.cc EigenBounds.cc + EigenSolvers.cc ExponentialSolvers.cc + FermiOperator.cc GeometryOptimization.cc HermiteSolvers.cc InverseSolvers.cc @@ -34,7 +36,9 @@ set(Chead ChebyshevSolvers.h DensityMatrixSolvers.h EigenBounds.h + EigenSolvers.h ExponentialSolvers.h + FermiOperator.h GeometryOptimization.h HermiteSolvers.h InverseSolvers.h diff --git a/Source/CPlusPlus/DensityMatrixSolvers.cc b/Source/CPlusPlus/DensityMatrixSolvers.cc index ab792fe6..29222494 100644 --- a/Source/CPlusPlus/DensityMatrixSolvers.cc +++ b/Source/CPlusPlus/DensityMatrixSolvers.cc @@ -52,6 +52,16 @@ void DensityMatrixSolvers::HPCP(const Matrix_ps &Hamiltonian, GetIH(solver_parameters)); } +//////////////////////////////////////////////////////////////////////////////// +void DensityMatrixSolvers::DenseDensity( + const Matrix_ps &Hamiltonian, const Matrix_ps &Overlap, double trace, + Matrix_ps &Density, double &energy_value_out, + double &chemical_potential_out, const SolverParameters &solver_parameters) { + DenseDensity_wrp(GetIH(Hamiltonian), GetIH(Overlap), &trace, GetIH(Density), + &energy_value_out, &chemical_potential_out, + GetIH(solver_parameters)); +} + //////////////////////////////////////////////////////////////////////////////// void DensityMatrixSolvers::ScaleAndFold( const Matrix_ps &Hamiltonian, const Matrix_ps &Overlap, double trace, diff --git a/Source/CPlusPlus/DensityMatrixSolvers.h b/Source/CPlusPlus/DensityMatrixSolvers.h index 74d80a18..2d7009fa 100644 --- a/Source/CPlusPlus/DensityMatrixSolvers.h +++ b/Source/CPlusPlus/DensityMatrixSolvers.h @@ -84,6 +84,19 @@ class DensityMatrixSolvers : public SolverBase { Matrix_ps &Density, double homo, double lumo, double &energy_value_out, const SolverParameters &solver_parameters); + //! Compute the density matrix using a dense solver. + //!\param Hamiltonian the matrix to compute the corresponding density from. + //!\param InverseSquareRoot of the overlap matrix. + //!\param trace of the density matrix (usually the number of electrons). + //!\param Density the density matrix computed by this routine. + //!\param energy_value_out the energy of the system (optional). + //!\param chemical_potential_out the chemical potential calculated. + //!\param solver_parameters parameters for the solver + static void DenseDensity(const Matrix_ps &Hamiltonian, + const Matrix_ps &InverseSquareRoot, double trace, + Matrix_ps &Density, double &energy_value_out, + double &chemical_potential_out, + const SolverParameters &solver_parameters); //! Compute the energy-weighted density matrix. //!\param Hamiltonian the matrix to compute from. //!\param Density the density matrix. diff --git a/Source/CPlusPlus/EigenSolvers.cc b/Source/CPlusPlus/EigenSolvers.cc new file mode 100644 index 00000000..82283403 --- /dev/null +++ b/Source/CPlusPlus/EigenSolvers.cc @@ -0,0 +1,33 @@ +#include "EigenSolvers.h" +using namespace NTPoly; + +//////////////////////////////////////////////////////////////////////////////// +extern "C" { +#include "EigenSolvers_c.h" +} + +//////////////////////////////////////////////////////////////////////////////// +namespace NTPoly { +//////////////////////////////////////////////////////////////////////////////// +void EigenSolvers::EigenDecomposition( + const Matrix_ps &matrix, Matrix_ps &eigenvalues, int nvals, + Matrix_ps &eigenvectors, const SolverParameters &solver_parameters) { + EigenDecomposition_wrp(GetIH(matrix), GetIH(eigenvalues), &nvals, + GetIH(eigenvectors), GetIH(solver_parameters)); +} +//////////////////////////////////////////////////////////////////////////////// +void EigenSolvers::EigenValues(const Matrix_ps &matrix, Matrix_ps &eigenvalues, + int nvals, + const SolverParameters &solver_parameters) { + EigenDecomposition_novec_wrp(GetIH(matrix), GetIH(eigenvalues), &nvals, + GetIH(solver_parameters)); +} +//////////////////////////////////////////////////////////////////////////////// +void EigenSolvers::SingularValueDecomposition( + const Matrix_ps &matrix, Matrix_ps &leftvectors, Matrix_ps &rightvectors, + Matrix_ps &singularvalues, const SolverParameters &solver_parameters) { + SingularValueDecompostion_wrp(GetIH(matrix), GetIH(leftvectors), + GetIH(rightvectors), GetIH(singularvalues), + GetIH(solver_parameters)); +} +} // namespace NTPoly diff --git a/Source/CPlusPlus/EigenSolvers.h b/Source/CPlusPlus/EigenSolvers.h new file mode 100644 index 00000000..0d47b151 --- /dev/null +++ b/Source/CPlusPlus/EigenSolvers.h @@ -0,0 +1,45 @@ +#ifndef EIGENSOLVERS_h +#define EIGENSOLVERS_h + +#include "SolverBase.h" +//////////////////////////////////////////////////////////////////////////////// +namespace NTPoly { +class SolverParameters; +class Matrix_ps; +//////////////////////////////////////////////////////////////////////////////// +//! A class for computing eigen decompositions matrices. +class EigenSolvers : public SolverBase { +public: + //! Compute the eigendecomposition of a matrix. + //! Uses a dense routine. + //!\param matrix the matrix to decompose. + //!\param eigenvalues the eigenvalues of a matrix. + //!\param eigenvectors the eigenvectors of a matrix. + //!\param nvals the number of values to compute. + //!\param solver_parameters parameters for computing. + static void EigenDecomposition(const Matrix_ps &matrix, + Matrix_ps &eigenvalues, int nvals, + Matrix_ps &eigenvectors, + const SolverParameters &solver_parameters); + //! Compute the eigenvalues of a matrix. + //! Uses a dense routine. + //!\param matrix the matrix to decompose. + //!\param eigenvalues the eigenvalues of a matrix. + //!\param nvals the number of values to compute. + //!\param solver_parameters parameters for computing. + static void EigenValues(const Matrix_ps &matrix, Matrix_ps &eigenvalues, + int nvals, const SolverParameters &solver_parameters); + //! Compute the singular value decomposition of a matrix. + //! Uses a dense routine. + //!\param matrix the matrix to decompose. + //!\param leftvectors the left singular vectors. + //!\param rightvectors the right singular vectors + //!\param singularvalues a diagonal matrix containing the singular values. + //!\param solver_parameters parameters for computing. + static void + SingularValueDecomposition(const Matrix_ps &matrix, Matrix_ps &leftvectors, + Matrix_ps &rightvectors, Matrix_ps &singularvalues, + const SolverParameters &solver_parameters); +}; +} // namespace NTPoly +#endif diff --git a/Source/CPlusPlus/ExponentialSolvers.cc b/Source/CPlusPlus/ExponentialSolvers.cc index 9cd44b8b..25bf19d8 100644 --- a/Source/CPlusPlus/ExponentialSolvers.cc +++ b/Source/CPlusPlus/ExponentialSolvers.cc @@ -15,6 +15,13 @@ void ExponentialSolvers::ComputeExponential( ComputeExponential_wrp(GetIH(Input), GetIH(Output), GetIH(solver_parameters)); } //////////////////////////////////////////////////////////////////////////////// +void ExponentialSolvers::ComputeDenseExponential( + const Matrix_ps &Input, Matrix_ps &Output, + const SolverParameters &solver_parameters) { + ComputeDenseExponential_wrp(GetIH(Input), GetIH(Output), + GetIH(solver_parameters)); +} +//////////////////////////////////////////////////////////////////////////////// void ExponentialSolvers::ComputeExponentialPade( const Matrix_ps &Input, Matrix_ps &Output, const SolverParameters &solver_parameters) { @@ -27,4 +34,11 @@ void ExponentialSolvers::ComputeLogarithm( const SolverParameters &solver_parameters) { ComputeLogarithm_wrp(GetIH(Input), GetIH(Output), GetIH(solver_parameters)); } +//////////////////////////////////////////////////////////////////////////////// +void ExponentialSolvers::ComputeDenseLogarithm( + const Matrix_ps &Input, Matrix_ps &Output, + const SolverParameters &solver_parameters) { + ComputeDenseLogarithm_wrp(GetIH(Input), GetIH(Output), + GetIH(solver_parameters)); +} } // namespace NTPoly diff --git a/Source/CPlusPlus/ExponentialSolvers.h b/Source/CPlusPlus/ExponentialSolvers.h index 261fec36..fb1d50e1 100644 --- a/Source/CPlusPlus/ExponentialSolvers.h +++ b/Source/CPlusPlus/ExponentialSolvers.h @@ -18,6 +18,13 @@ class ExponentialSolvers : public SolverBase { static void ComputeExponential(const Matrix_ps &InputMat, Matrix_ps &OutputMat, const SolverParameters &solver_parameters); + //! Compute the matrix exponential (dense version). + //!\param InputMat matrix to compute the exponential of. + //!\param OutputMat = exp(InputMat) + //!\param solver_parameters parameters for the solver + static void + ComputeDenseExponential(const Matrix_ps &InputMat, Matrix_ps &OutputMat, + const SolverParameters &solver_parameters); //! Compute the matrix exponential using the Pade method. //!\param InputMat matrix to compute the exponential of. //!\param OutputMat = exp(InputMat) @@ -31,6 +38,13 @@ class ExponentialSolvers : public SolverBase { //!\param solver_parameters parameters for the solver static void ComputeLogarithm(const Matrix_ps &InputMat, Matrix_ps &OutputMat, const SolverParameters &solver_parameters); + //! Compute the matrix logarithm (dense version). + //!\param InputMat matrix to compute the exponential of. + //!\param OutputMat = log(InputMat) + //!\param solver_parameters parameters for the solver + static void ComputeDenseLogarithm(const Matrix_ps &InputMat, + Matrix_ps &OutputMat, + const SolverParameters &solver_parameters); }; } // namespace NTPoly #endif diff --git a/Source/CPlusPlus/FermiOperator.cc b/Source/CPlusPlus/FermiOperator.cc new file mode 100644 index 00000000..1cd7b42e --- /dev/null +++ b/Source/CPlusPlus/FermiOperator.cc @@ -0,0 +1,24 @@ +#include "FermiOperator.h" +#include "PSMatrix.h" +#include "SolverParameters.h" + +//////////////////////////////////////////////////////////////////////////////// +extern "C" { +#include "FermiOperator_c.h" +} + +//////////////////////////////////////////////////////////////////////////////// +namespace NTPoly { +//////////////////////////////////////////////////////////////////////////////// +void FermiOperator::ComputeDenseFOE(const Matrix_ps &Hamiltonian, + const Matrix_ps &Overlap, double trace, + Matrix_ps &Density, double inv_temp, + double &energy_value_out, + double &chemical_potential_out, + const SolverParameters &solver_parameters) { + ComputeDenseFOE_wrp(GetIH(Hamiltonian), GetIH(Overlap), &trace, + GetIH(Density), &inv_temp, &energy_value_out, + &chemical_potential_out, GetIH(solver_parameters)); +} + +} // namespace NTPoly diff --git a/Source/CPlusPlus/FermiOperator.h b/Source/CPlusPlus/FermiOperator.h new file mode 100644 index 00000000..873ab912 --- /dev/null +++ b/Source/CPlusPlus/FermiOperator.h @@ -0,0 +1,30 @@ +#ifndef FERMIOPERATOREXPANSION_h +#define FERMIOPERATOREXPANSION_h + +#include "SolverBase.h" + +//////////////////////////////////////////////////////////////////////////////// +namespace NTPoly { +class SolverParameters; +class Matrix_ps; +//! A Class For Solving Chemistry Systems Using the Fermi Operator Expansion. +class FermiOperator : public SolverBase { +public: + //! Compute the density matrix using a dense solver. + //!\param Hamiltonian the matrix to compute the corresponding density from. + //!\param InverseSquareRoot of the overlap matrix. + //!\param trace of the density matrix (usually the number of electrons). + //!\param Density the density matrix computed by this routine. + //!\param inv_temp the inverse temperature. + //!\param energy_value_out the energy of the system. + //!\param chemical_potential_out the chemical potential calculated. + //!\param solver_parameters parameters for the solver + static void ComputeDenseFOE(const Matrix_ps &Hamiltonian, + const Matrix_ps &InverseSquareRoot, double trace, + Matrix_ps &Density, double inv_temp, + double &energy_value_out, + double &chemical_potential_out, + const SolverParameters &solver_parameters); +}; +} // namespace NTPoly +#endif diff --git a/Source/CPlusPlus/InverseSolvers.cc b/Source/CPlusPlus/InverseSolvers.cc index 9372f1b9..632625ea 100644 --- a/Source/CPlusPlus/InverseSolvers.cc +++ b/Source/CPlusPlus/InverseSolvers.cc @@ -14,6 +14,12 @@ void InverseSolvers::Invert(const Matrix_ps &Overlap, Matrix_ps &InverseMat, Invert_wrp(GetIH(Overlap), GetIH(InverseMat), GetIH(solver_parameters)); } //////////////////////////////////////////////////////////////////////////////// +void InverseSolvers::DenseInvert(const Matrix_ps &Overlap, + Matrix_ps &InverseMat, + const SolverParameters &solver_parameters) { + DenseInvert_wrp(GetIH(Overlap), GetIH(InverseMat), GetIH(solver_parameters)); +} +//////////////////////////////////////////////////////////////////////////////// void InverseSolvers::PseudoInverse(const Matrix_ps &Overlap, Matrix_ps &InverseMat, const SolverParameters &solver_parameters) { diff --git a/Source/CPlusPlus/InverseSolvers.h b/Source/CPlusPlus/InverseSolvers.h index 8cf02cb6..19d241bd 100644 --- a/Source/CPlusPlus/InverseSolvers.h +++ b/Source/CPlusPlus/InverseSolvers.h @@ -17,6 +17,12 @@ class InverseSolvers : public SolverBase { //!\param solver_parameters parameters for the solver static void Invert(const Matrix_ps &Overlap, Matrix_ps &InverseMat, const SolverParameters &solver_parameters); + //! Compute the inverse of a matrix (dense version). + //!\param Overlap the matrix to invert. + //!\param InverseMat = Overlap^-1. + //!\param solver_parameters parameters for the solver + static void DenseInvert(const Matrix_ps &Overlap, Matrix_ps &InverseMat, + const SolverParameters &solver_parameters); //! Compute the pseudoinverse of a matrix. //! An implementation of Hotelling's method, with a different convergence //! criteria. diff --git a/Source/CPlusPlus/SignSolvers.cc b/Source/CPlusPlus/SignSolvers.cc index 5da25daa..852e804c 100644 --- a/Source/CPlusPlus/SignSolvers.cc +++ b/Source/CPlusPlus/SignSolvers.cc @@ -13,6 +13,12 @@ void SignSolvers::ComputeSign(const Matrix_ps &mat1, Matrix_ps &SignMat, const SolverParameters &solver_parameters) { SignFunction_wrp(GetIH(mat1), GetIH(SignMat), GetIH(solver_parameters)); } +////////////////////////////////////////////////////////////////////////////// +void SignSolvers::ComputeDenseSign(const Matrix_ps &mat1, Matrix_ps &SignMat, + const SolverParameters &solver_parameters) { + DenseSignFunction_wrp(GetIH(mat1), GetIH(SignMat), GetIH(solver_parameters)); +} +////////////////////////////////////////////////////////////////////////////// void SignSolvers::ComputePolarDecomposition( const Matrix_ps &mat1, Matrix_ps &Umat, Matrix_ps &Hmat, const SolverParameters &solver_parameters) { diff --git a/Source/CPlusPlus/SignSolvers.h b/Source/CPlusPlus/SignSolvers.h index 9b7fb5aa..8ffc9f9c 100644 --- a/Source/CPlusPlus/SignSolvers.h +++ b/Source/CPlusPlus/SignSolvers.h @@ -17,6 +17,12 @@ class SignSolvers : public SolverBase { //!\param solver_parameters parameters for the solver static void ComputeSign(const Matrix_ps &Mat1, Matrix_ps &SignMat, const SolverParameters &solver_parameters); + //! Compute the matrix sign function (dense version). + //!\param Mat1 input matrix. + //!\param SignMat = Sign(Mat1) + //!\param solver_parameters parameters for the solver + static void ComputeDenseSign(const Matrix_ps &Mat1, Matrix_ps &SignMat, + const SolverParameters &solver_parameters); //! Computes the polar decomposition of a matrix Mat1 = U*H. //!\param Mat1 input matrix. //!\param Umat the unitary polar factor. diff --git a/Source/CPlusPlus/SquareRootSolvers.cc b/Source/CPlusPlus/SquareRootSolvers.cc index 3965eaf0..11a2b2b0 100644 --- a/Source/CPlusPlus/SquareRootSolvers.cc +++ b/Source/CPlusPlus/SquareRootSolvers.cc @@ -14,9 +14,22 @@ void SquareRootSolvers::SquareRoot(const Matrix_ps &Input, Matrix_ps &Output, SquareRoot_wrp(GetIH(Input), GetIH(Output), GetIH(solver_parameters)); } //////////////////////////////////////////////////////////////////////////////// +void SquareRootSolvers::DenseSquareRoot( + const Matrix_ps &Input, Matrix_ps &Output, + const SolverParameters &solver_parameters) { + DenseSquareRoot_wrp(GetIH(Input), GetIH(Output), GetIH(solver_parameters)); +} +//////////////////////////////////////////////////////////////////////////////// void SquareRootSolvers::InverseSquareRoot( const Matrix_ps &Input, Matrix_ps &Output, const SolverParameters &solver_parameters) { InverseSquareRoot_wrp(GetIH(Input), GetIH(Output), GetIH(solver_parameters)); } +//////////////////////////////////////////////////////////////////////////////// +void SquareRootSolvers::DenseInverseSquareRoot( + const Matrix_ps &Input, Matrix_ps &Output, + const SolverParameters &solver_parameters) { + DenseInverseSquareRoot_wrp(GetIH(Input), GetIH(Output), + GetIH(solver_parameters)); +} } // namespace NTPoly diff --git a/Source/CPlusPlus/SquareRootSolvers.h b/Source/CPlusPlus/SquareRootSolvers.h index 2c03233f..c4104baa 100644 --- a/Source/CPlusPlus/SquareRootSolvers.h +++ b/Source/CPlusPlus/SquareRootSolvers.h @@ -17,12 +17,25 @@ class SquareRootSolvers : public SolverBase { //!\param solver_parameters parameters for the solver static void SquareRoot(const Matrix_ps &InputMat, Matrix_ps &OutputMat, const SolverParameters &solver_parameters); + //! Compute the square root of a matrix (dense version). + //!\param InputMat matrix to compute the inversesquareroot of. + //!\param OutputMat = InputMat^1/2. + //!\param solver_parameters parameters for the solver + static void DenseSquareRoot(const Matrix_ps &InputMat, Matrix_ps &OutputMat, + const SolverParameters &solver_parameters); //! Compute the inverse square root of a matrix. //!\param InputMat matrix to compute the inversesquareroot of. //!\param OutputMat = InputMat^-1/2. //!\param solver_parameters parameters for the solver static void InverseSquareRoot(const Matrix_ps &InputMat, Matrix_ps &OutputMat, const SolverParameters &solver_parameters); + //! Compute the inverse square root of a matrix (dense version). + //!\param InputMat matrix to compute the inversesquareroot of. + //!\param OutputMat = InputMat^-1/2. + //!\param solver_parameters parameters for the solver + static void DenseInverseSquareRoot(const Matrix_ps &InputMat, + Matrix_ps &OutputMat, + const SolverParameters &solver_parameters); }; } // namespace NTPoly #endif diff --git a/Source/CPlusPlus/TrigonometrySolvers.cc b/Source/CPlusPlus/TrigonometrySolvers.cc index fa845616..fb42a71b 100644 --- a/Source/CPlusPlus/TrigonometrySolvers.cc +++ b/Source/CPlusPlus/TrigonometrySolvers.cc @@ -14,8 +14,19 @@ void TrigonometrySolvers::Sine(const Matrix_ps &Input, Matrix_ps &Output, Sine_wrp(GetIH(Input), GetIH(Output), GetIH(solver_parameters)); } //////////////////////////////////////////////////////////////////////////////// +void TrigonometrySolvers::DenseSine(const Matrix_ps &Input, Matrix_ps &Output, + const SolverParameters &solver_parameters) { + DenseSine_wrp(GetIH(Input), GetIH(Output), GetIH(solver_parameters)); +} +//////////////////////////////////////////////////////////////////////////////// void TrigonometrySolvers::Cosine(const Matrix_ps &Input, Matrix_ps &Output, const SolverParameters &solver_parameters) { Cosine_wrp(GetIH(Input), GetIH(Output), GetIH(solver_parameters)); } +//////////////////////////////////////////////////////////////////////////////// +void TrigonometrySolvers::DenseCosine( + const Matrix_ps &Input, Matrix_ps &Output, + const SolverParameters &solver_parameters) { + DenseCosine_wrp(GetIH(Input), GetIH(Output), GetIH(solver_parameters)); +} } // namespace NTPoly diff --git a/Source/CPlusPlus/TrigonometrySolvers.h b/Source/CPlusPlus/TrigonometrySolvers.h index 7ef96413..9f1e7f18 100644 --- a/Source/CPlusPlus/TrigonometrySolvers.h +++ b/Source/CPlusPlus/TrigonometrySolvers.h @@ -17,12 +17,24 @@ class TrigonometrySolvers : public SolverBase { //!\param solver_parameters parameters for the solver static void Sine(const Matrix_ps &InputMat, Matrix_ps &OutputMat, const SolverParameters &solver_parameters); + //! Compute the sine of a matrix (dense version). + //!\param InputMat matrix to compute the sine of. + //!\param OutputMat = sin(InputMat) + //!\param solver_parameters parameters for the solver + static void DenseSine(const Matrix_ps &InputMat, Matrix_ps &OutputMat, + const SolverParameters &solver_parameters); //! Compute the cosine of a matrix. //!\param InputMat matrix to compute the cosine of. //!\param OutputMat = cos(InputMat) //!\param solver_parameters parameters for the solver static void Cosine(const Matrix_ps &InputMat, Matrix_ps &OutputMat, const SolverParameters &solver_parameters); + //! Compute the cosine of a matrix (dense version). + //!\param InputMat matrix to compute the cosine of. + //!\param OutputMat = cos(InputMat) + //!\param solver_parameters parameters for the solver + static void DenseCosine(const Matrix_ps &InputMat, Matrix_ps &OutputMat, + const SolverParameters &solver_parameters); }; } // namespace NTPoly #endif diff --git a/Source/Fortran/AnalysisModule.F90 b/Source/Fortran/AnalysisModule.F90 index 32f196cd..4c1ea7a0 100644 --- a/Source/Fortran/AnalysisModule.F90 +++ b/Source/Fortran/AnalysisModule.F90 @@ -5,7 +5,7 @@ MODULE AnalysisModule & BroadcastVector, ConstructDiag, DotAllHelper, DotAllPivoted, & & GatherMatrixColumn, GetPivot, UnpackCholesky USE DataTypesModule, ONLY : NTREAL, MPINTREAL - USE DensityMatrixSolversModule, ONLY : HPCP + USE DensityMatrixSolversModule, ONLY : TRS4 USE DMatrixModule, ONLY : Matrix_ldr, DestructMatrix, & & ConstructMatrixDFromS USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteElement, & @@ -248,7 +248,7 @@ SUBROUTINE ReduceDimension(this, dim, ReducedMat, solver_parameters_in) CALL FillMatrixIdentity(Identity) !! Purify - CALL HPCP(this, Identity, REAL(dim, KIND=NTREAL), PMat, & + CALL TRS4(this, Identity, REAL(dim, KIND=NTREAL), PMat, & & solver_parameters_in=params) !! Compute Eigenvectors of the Density Matrix diff --git a/Source/Fortran/CMakeLists.txt b/Source/Fortran/CMakeLists.txt index d6ddf943..11e002b0 100644 --- a/Source/Fortran/CMakeLists.txt +++ b/Source/Fortran/CMakeLists.txt @@ -7,8 +7,11 @@ set(Fsrc DensityMatrixSolversModule.F90 DMatrixModule.F90 EigenBoundsModule.F90 + EigenExaModule.F90 + EigenSolversModule.F90 ErrorModule.F90 ExponentialSolversModule.F90 + FermiOperatorModule.F90 GemmTasksModule.F90 GeometryOptimizationModule.F90 HermiteSolversModule.F90 @@ -32,6 +35,7 @@ set(Fsrc SignSolversModule.F90 SMatrixAlgebraModule.F90 SMatrixModule.F90 + SingularValueSolversModule.F90 SolverParametersModule.F90 SquareRootSolversModule.F90 SVectorModule.F90 @@ -46,9 +50,11 @@ add_library(NTPoly ${Fsrc}) if (NOT NOSWIG) set_target_properties(NTPoly PROPERTIES POSITION_INDEPENDENT_CODE True) endif() -target_link_libraries(NTPoly ${MPI_Fortran_LIBRARIES} - ${OpenMP_Fortran_LIBRARIES} ${BLAS_LIBRARIES}) -target_include_directories(NTPoly PUBLIC ${MPI_Fortran_INCLUDE_PATH}) +target_link_libraries(NTPoly ${MPI_Fortran_LIBRARIES} ${EigenSolver_LIBRARIES} + ${OpenMP_Fortran_LIBRARIES} ${LAPACK_LIBRARIES} + ${BLAS_LIBRARIES}) +target_include_directories(NTPoly PUBLIC ${EigenSolver_INCLUDE_DIRS} + ${MPI_Fortran_INCLUDE_PATH}) include(GNUInstallDirs) install(TARGETS NTPoly diff --git a/Source/Fortran/ChebyshevSolversModule.F90 b/Source/Fortran/ChebyshevSolversModule.F90 index 60177f3d..7d5d37b2 100644 --- a/Source/Fortran/ChebyshevSolversModule.F90 +++ b/Source/Fortran/ChebyshevSolversModule.F90 @@ -90,7 +90,7 @@ SUBROUTINE Compute_cheby(InputMat, OutputMat, poly, solver_parameters_in) !> Parameters for the solver. TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: param !! Local Matrices TYPE(Matrix_ps) :: Identity TYPE(Matrix_ps) :: BalancedInput @@ -104,19 +104,19 @@ SUBROUTINE Compute_cheby(InputMat, OutputMat, poly, solver_parameters_in) !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + param = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + param = SolverParameters_t() END IF degree = SIZE(poly%coefficients) - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Chebyshev Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="Standard") CALL WriteElement(key="Degree", VALUE=degree-1) - CALL PrintParameters(solver_parameters) + CALL PrintParameters(param) END IF !! Initial values for matrices @@ -125,57 +125,56 @@ SUBROUTINE Compute_cheby(InputMat, OutputMat, poly, solver_parameters_in) CALL CopyMatrix(InputMat,BalancedInput) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (param%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & param%BalancePermutation, memorypool_in=pool) CALL PermuteMatrix(BalancedInput, BalancedInput, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & param%BalancePermutation, memorypool_in=pool) END IF !! First Term - CALL CopyMatrix(Identity,Tkminus2) + CALL CopyMatrix(Identity, Tkminus2) IF (degree == 1) THEN - CALL CopyMatrix(Tkminus2,OutputMat) - CALL ScaleMatrix(OutputMat,poly%coefficients(1)) + CALL CopyMatrix(Tkminus2, OutputMat) + CALL ScaleMatrix(OutputMat, poly%coefficients(1)) ELSE - CALL CopyMatrix(BalancedInput,Tkminus1) - CALL CopyMatrix(Tkminus2,OutputMat) - CALL ScaleMatrix(OutputMat,poly%coefficients(1)) - CALL IncrementMatrix(Tkminus1,OutputMat, & + CALL CopyMatrix(BalancedInput, Tkminus1) + CALL CopyMatrix(Tkminus2, OutputMat) + CALL ScaleMatrix(OutputMat, poly%coefficients(1)) + CALL IncrementMatrix(Tkminus1, OutputMat, & & alpha_in=poly%coefficients(2)) IF (degree > 2) THEN CALL MatrixMultiply(BalancedInput, Tkminus1, Tk, & - & alpha_in=REAL(2.0,NTREAL), & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) - CALL IncrementMatrix(Tkminus2,Tk,REAL(-1.0,NTREAL)) + & alpha_in=REAL(2.0, NTREAL), & + & threshold_in=param%threshold, memory_pool_in=pool) + CALL IncrementMatrix(Tkminus2, Tk, REAL(-1.0,NTREAL)) CALL IncrementMatrix(Tk, OutputMat, & & alpha_in=poly%coefficients(3)) DO counter = 4, degree - CALL CopyMatrix(Tkminus1,Tkminus2) - CALL CopyMatrix(Tk,Tkminus1) + CALL CopyMatrix(Tkminus1, Tkminus2) + CALL CopyMatrix(Tk, Tkminus1) CALL MatrixMultiply(BalancedInput, Tkminus1, Tk, & & alpha_in=REAL(2.0,NTREAL), & - & threshold_in=solver_parameters%threshold, & + & threshold_in=param%threshold, & & memory_pool_in=pool) - CALL IncrementMatrix(Tkminus2,Tk, & - & REAL(-1.0,NTREAL)) + CALL IncrementMatrix(Tkminus2, Tk, REAL(-1.0,NTREAL)) CALL IncrementMatrix(Tk, OutputMat, & & alpha_in=poly%coefficients(counter)) END DO END IF END IF - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL PrintMatrixInformation(OutputMat) END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (param%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & param%BalancePermutation, memorypool_in=pool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL ExitSubLog END IF CALL DestructMatrix(Identity) @@ -184,7 +183,7 @@ SUBROUTINE Compute_cheby(InputMat, OutputMat, poly, solver_parameters_in) CALL DestructMatrix(Tkminus2) CALL DestructMatrix(BalancedInput) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(param) END SUBROUTINE Compute_cheby !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute The Chebyshev Polynomial of the matrix. @@ -202,7 +201,7 @@ SUBROUTINE FactorizedCompute_cheby(InputMat, OutputMat, poly, & !> Parameters for the solver. TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: param !! Local Matrices TYPE(Matrix_ps) :: Identity TYPE(Matrix_ps) :: BalancedInput @@ -215,32 +214,32 @@ SUBROUTINE FactorizedCompute_cheby(InputMat, OutputMat, poly, & !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + param = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + param = SolverParameters_t() END IF degree = SIZE(poly%coefficients) - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Chebyshev Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="Recursive") CALL WriteElement(key="Degree", VALUE=degree-1) - CALL PrintParameters(solver_parameters) + CALL PrintParameters(param) END IF !! Initial values for matrices CALL ConstructEmptyMatrix(Identity, InputMat) CALL FillMatrixIdentity(Identity) - CALL CopyMatrix(InputMat,BalancedInput) + CALL CopyMatrix(InputMat, BalancedInput) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (param%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & param%BalancePermutation, memorypool_in=pool) CALL PermuteMatrix(BalancedInput, BalancedInput, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & param%BalancePermutation, memorypool_in=pool) END IF !! Construct The X Powers Array @@ -256,31 +255,30 @@ SUBROUTINE FactorizedCompute_cheby(InputMat, OutputMat, poly, & IF (degree .EQ. 1) THEN CALL CopyMatrix(T_Powers(1), OutputMat) ELSE - CALL CopyMatrix(BalancedInput,T_Powers(2)) + CALL CopyMatrix(BalancedInput, T_Powers(2)) DO counter=3,log2degree CALL MatrixMultiply(T_Powers(counter-1), T_Powers(counter-1), & - & T_Powers(counter), threshold_in=solver_parameters%threshold, & + & T_Powers(counter), threshold_in=param%threshold, & & alpha_in=REAL(2.0,NTREAL), memory_pool_in=pool) CALL IncrementMatrix(Identity, T_Powers(counter), & & alpha_in=REAL(-1.0,NTREAL)) END DO !! Call Recursive - CALL ComputeRecursive(T_Powers, poly, OutputMat, & - & pool, 1, solver_parameters) + CALL ComputeRecursive(T_Powers, poly, OutputMat, pool, 1, param) END IF - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL PrintMatrixInformation(OutputMat) END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (param%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & param%BalancePermutation, memorypool_in=pool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL ExitSubLog END IF DO counter=1,log2degree @@ -290,12 +288,12 @@ SUBROUTINE FactorizedCompute_cheby(InputMat, OutputMat, poly, & CALL DestructMatrix(Identity) CALL DestructMatrix(BalancedInput) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(param) END SUBROUTINE FactorizedCompute_cheby !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> The workhorse routine for the factorized chebyshev computation function. RECURSIVE SUBROUTINE ComputeRecursive(T_Powers, poly, OutputMat, pool, & - & depth, solver_parameters) + & depth, param) !> The precomputed Chebyshev polynomials. TYPE(Matrix_ps), DIMENSION(:), INTENT(IN) :: T_Powers !> Polynomial coefficients. @@ -305,7 +303,7 @@ RECURSIVE SUBROUTINE ComputeRecursive(T_Powers, poly, OutputMat, pool, & !> The depth of recursion. INTEGER, INTENT(in) :: depth !> Parameters for the solver. - TYPE(SolverParameters_t), INTENT(IN) :: solver_parameters + TYPE(SolverParameters_t), INTENT(IN) :: param !> The memory pool. TYPE(MatrixMemoryPool_p), INTENT(INOUT) :: pool !! Local Data @@ -343,19 +341,19 @@ RECURSIVE SUBROUTINE ComputeRecursive(T_Powers, poly, OutputMat, pool, & !! Left recursion CALL ComputeRecursive(T_Powers, left_poly, LeftMat, pool, depth+1, & - & solver_parameters) + & param) !! Right recursion full_midpoint = SIZE(T_Powers) - depth + 1 CALL ComputeRecursive(T_Powers, right_poly, RightMat, pool, depth+1, & - & solver_parameters) + & param) !! Sum Together CALL MatrixMultiply(T_Powers(full_midpoint), RightMat, & - & OutputMat, threshold_in=solver_parameters%threshold, & + & OutputMat, threshold_in=param%threshold, & & alpha_in=REAL(2.0,NTREAL), memory_pool_in=pool) - CALL IncrementMatrix(LeftMat,OutputMat) + CALL IncrementMatrix(LeftMat, OutputMat) CALL IncrementMatrix(T_Powers(full_midpoint), & & OutputMat, alpha_in=-1.0*right_poly%coefficients(1)) diff --git a/Source/Fortran/DMatrixModule.F90 b/Source/Fortran/DMatrixModule.F90 index 455625c7..55bf66c9 100644 --- a/Source/Fortran/DMatrixModule.F90 +++ b/Source/Fortran/DMatrixModule.F90 @@ -41,6 +41,7 @@ MODULE DMatrixModule PUBLIC :: IncrementMatrix PUBLIC :: MultiplyMatrix PUBLIC :: TransposeMatrix + PUBLIC :: EigenDecomposition !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! INTERFACE Matrix_ldr MODULE PROCEDURE ConstructEmptyMatrix_ldr @@ -92,6 +93,10 @@ MODULE DMatrixModule MODULE PROCEDURE TransposeMatrix_ldr MODULE PROCEDURE TransposeMatrix_ldc END INTERFACE TransposeMatrix + INTERFACE EigenDecomposition + MODULE PROCEDURE EigenDecomposition_ldr + MODULE PROCEDURE EigenDecomposition_ldc + END INTERFACE EigenDecomposition CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> A subroutine wrapper for the empty constructor. PURE SUBROUTINE ConstructEmptyMatrixSup_ldr(this, rows, columns) @@ -329,6 +334,66 @@ SUBROUTINE MultiplyMatrix_ldr(MatA, MatB, MatC, IsATransposed_in, & & LDB, BETA, MatC%DATA, LDC) END SUBROUTINE MultiplyMatrix_ldr +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the eigenvectors of a dense matrix. + !> Wraps a standard dense linear algebra routine. + SUBROUTINE EigenDecomposition_ldr(MatA, MatV, MatW) + !> MatA the matrix to decompose. + TYPE(Matrix_ldr), INTENT(IN) :: MatA + !> The eigenvectors. + TYPE(Matrix_ldr), INTENT(INOUT) :: MatV + !> The eigenvalues. + TYPE(Matrix_ldr), INTENT(INOUT), OPTIONAL :: MatW + !! Local variables + CHARACTER, PARAMETER :: job = 'V', uplo = 'U' + INTEGER :: N, LDA + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: W + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: WORK + DOUBLE PRECISION, DIMENSION(1) :: WORKTEMP + INTEGER :: LWORK + INTEGER, DIMENSION(:), ALLOCATABLE :: IWORK + INTEGER, DIMENSION(1) :: IWORKTEMP + INTEGER :: LIWORK + INTEGER :: INFO + INTEGER :: II + + MatV = Matrix_ldr(MatA%rows,MatA%columns) + MatV%DATA = MatA%DATA + + N = SIZE(MatA%DATA,DIM=1) + LDA = N + + !! Allocations + ALLOCATE(W(N)) + + !! Determine the scratch space size + LWORK = -1 + CALL DSYEVD(JOB, UPLO, N, MatA%DATA, LDA, W, WORKTEMP, LWORK, IWORKTEMP, & + & LIWORK, INFO) + N = LDA + LWORK = INT(WORKTEMP(1)) + ALLOCATE(WORK(LWORK)) + LIWORK = INT(IWORKTEMP(1)) + ALLOCATE(IWORK(LIWORK)) + + !! Run Lapack For Real + CALL DSYEVD(JOB, UPLO, N, MatV%DATA, LDA, W, WORK, LWORK, IWORK, LIWORK, & + & INFO) + + !! Extract Eigenvalues + IF (PRESENT(MatW)) THEN + MatW = Matrix_ldr(MatA%rows, MatA%columns) + MatW%DATA = 0 + DO II = 1, N + MatW%DATA(II,II) = W(II) + END DO + END IF + + !! Cleanup + DEALLOCATE(W) + DEALLOCATE(Work) + + END SUBROUTINE EigenDecomposition_ldr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> A subroutine style wrapper for the constructor. PURE SUBROUTINE ConstructEmptyMatrixSup_ldc(this, rows, columns) @@ -569,5 +634,72 @@ SUBROUTINE MultiplyMatrix_ldc(MatA, MatB, MatC, IsATransposed_in, & & LDB, BETA, MatC%DATA, LDC) END SUBROUTINE MultiplyMatrix_ldc +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the eigenvectors of a dense matrix. + !> Wraps a standard dense linear algebra routine. + SUBROUTINE EigenDecomposition_ldc(MatA, MatV, MatW) + !> The matrix to decompose. + TYPE(Matrix_ldc), INTENT(IN) :: MatA + !> The eigenvectors. + TYPE(Matrix_ldc), INTENT(INOUT) :: MatV + !> The eigenvalues. + TYPE(Matrix_ldc), INTENT(INOUT), OPTIONAL :: MatW + !! Standard parameters + CHARACTER, PARAMETER :: job = 'V', uplo = 'U' + INTEGER :: N, LDA + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: W + COMPLEX*16, DIMENSION(:), ALLOCATABLE :: WORK + INTEGER :: LWORK + DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: RWORK + INTEGER :: LRWORK + INTEGER, DIMENSION(:), ALLOCATABLE :: IWORK + INTEGER :: LIWORK + INTEGER :: INFO + !! Temp + COMPLEX*16, DIMENSION(1) :: WORKTEMP + DOUBLE PRECISION, DIMENSION(1) :: RWORKTEMP + INTEGER, DIMENSION(1) :: IWORKTEMP + INTEGER :: II + + MatV = Matrix_ldc(MatA%rows,MatA%columns) + MatV%DATA = MatA%DATA + + N = SIZE(MatA%DATA,DIM=1) + LDA = N + + !! Allocations + ALLOCATE(W(N)) + + !! Determine the scratch space size + LWORK = -1 + CALL ZHEEVD(JOB, UPLO, N, MatA%DATA, LDA, W, WORKTEMP, LWORK, RWORKTEMP, & + & LRWORK, IWORKTEMP, LIWORK, INFO) + N = LDA + LWORK = INT(WORKTEMP(1)) + ALLOCATE(WORK(LWORK)) + LRWORK = INT(RWORKTEMP(1)) + ALLOCATE(RWORK(LRWORK)) + LIWORK = INT(IWORKTEMP(1)) + ALLOCATE(IWORK(LIWORK)) + + !! Run Lapack For Real + CALL ZHEEVD(JOB, UPLO, N, MatV%DATA, LDA, W, WORK, LWORK, RWORK, LRWORK, & + & IWORK, LIWORK, INFO) + + !! Extract Eigenvalues + IF (PRESENT(MatW)) THEN + MatW = Matrix_ldc(MatA%rows, MatA%columns) + MatW%DATA = 0 + DO II = 1, N + MatW%DATA(II,II) = W(II) + END DO + END IF + + !! Cleanup + DEALLOCATE(W) + DEALLOCATE(Work) + DEALLOCATE(RWork) + + END SUBROUTINE EigenDecomposition_ldc !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE DMatrixModule diff --git a/Source/Fortran/DensityMatrixSolversModule.F90 b/Source/Fortran/DensityMatrixSolversModule.F90 index 5c030c35..c1be31f9 100644 --- a/Source/Fortran/DensityMatrixSolversModule.F90 +++ b/Source/Fortran/DensityMatrixSolversModule.F90 @@ -1,11 +1,13 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> A Module For Solving Quantum Chemistry Systems using Purification. MODULE DensityMatrixSolversModule - USE DataTypesModule, ONLY : NTREAL + USE DataTypesModule, ONLY : NTREAL, MPINTREAL USE EigenBoundsModule, ONLY : GershgorinBounds + USE FermiOperatorModule, ONLY : ComputeDenseFOE USE LoadBalancerModule, ONLY : PermuteMatrix, UndoPermuteMatrix USE LoggingModule, ONLY : WriteElement, WriteListElement, WriteHeader, & & EnterSubLog, ExitSubLog + USE NTMPIModule USE PMatrixMemoryPoolModule, ONLY : MatrixMemoryPool_p, & & DestructMatrixMemoryPool USE PSMatrixAlgebraModule, ONLY : IncrementMatrix, MatrixMultiply, & @@ -23,21 +25,22 @@ MODULE DensityMatrixSolversModule PUBLIC :: TRS2 PUBLIC :: TRS4 PUBLIC :: HPCP + PUBLIC :: DenseDensity PUBLIC :: ScaleAndFold PUBLIC :: EnergyDensityMatrix CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the density matrix from a Hamiltonian using the PM method. !> Based on the PM algorithm presented in \cite palser1998canonical - SUBROUTINE PM(Hamiltonian, InverseSquareRoot, trace, Density, & + SUBROUTINE PM(H, ISQ, trace, K, & & energy_value_out, chemical_potential_out, solver_parameters_in) !> The matrix to compute the corresponding density from. - TYPE(Matrix_ps), INTENT(IN) :: Hamiltonian + TYPE(Matrix_ps), INTENT(IN) :: H !> The inverse square root of the overlap matrix. - TYPE(Matrix_ps), INTENT(IN) :: InverseSquareRoot + TYPE(Matrix_ps), INTENT(IN) :: ISQ !> The trace of the density matrix (usually the number of electrons) REAL(NTREAL), INTENT(IN) :: trace !> The density matrix computed by this routine. - TYPE(Matrix_ps), INTENT(INOUT) :: Density + TYPE(Matrix_ps), INTENT(INOUT) :: K !> The energy of the system (optional). REAL(NTREAL), INTENT(OUT), OPTIONAL :: energy_value_out !> The chemical potential (optional). @@ -45,12 +48,12 @@ SUBROUTINE PM(Hamiltonian, InverseSquareRoot, trace, Density, & !> Parameters for the solver (optional). TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: param !! Local Matrices - TYPE(Matrix_ps) :: WorkingHamiltonian - TYPE(Matrix_ps) :: Identity - TYPE(Matrix_ps) :: InverseSquareRoot_T - TYPE(Matrix_ps) :: X_k, X_k2, X_k3, TempMat + TYPE(Matrix_ps) :: WH + TYPE(Matrix_ps) :: IMat + TYPE(Matrix_ps) :: ISQT + TYPE(Matrix_ps) :: X_k, X_k2, X_k3, Temp !! Local Variables REAL(NTREAL) :: e_min, e_max REAL(NTREAL) :: factor @@ -65,17 +68,17 @@ SUBROUTINE PM(Hamiltonian, InverseSquareRoot, trace, Density, & REAL(NTREAL) :: zero_value, midpoint, interval_a, interval_b !! Temporary Variables TYPE(MatrixMemoryPool_p) :: pool - INTEGER :: outer_counter, inner_counter + INTEGER :: II, JJ INTEGER :: total_iterations !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + param = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + param = SolverParameters_t() END IF - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Density Matrix Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="PM") @@ -83,40 +86,39 @@ SUBROUTINE PM(Hamiltonian, InverseSquareRoot, trace, Density, & CALL EnterSubLog CALL WriteListElement("palser1998canonical") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(param) END IF - ALLOCATE(sigma_array(solver_parameters%max_iterations)) + ALLOCATE(sigma_array(param%max_iterations)) !! Construct All The Necessary Matrices - CALL ConstructEmptyMatrix(Density, Hamiltonian) - CALL ConstructEmptyMatrix(WorkingHamiltonian, Hamiltonian) - CALL ConstructEmptyMatrix(X_k, Hamiltonian) - CALL ConstructEmptyMatrix(X_k2, Hamiltonian) - CALL ConstructEmptyMatrix(X_k3, Hamiltonian) - CALL ConstructEmptyMatrix(TempMat, Hamiltonian) - CALL ConstructEmptyMatrix(Identity, Hamiltonian) - CALL FillMatrixIdentity(Identity) + CALL ConstructEmptyMatrix(K, H) + CALL ConstructEmptyMatrix(WH, H) + CALL ConstructEmptyMatrix(X_k, H) + CALL ConstructEmptyMatrix(X_k2, H) + CALL ConstructEmptyMatrix(X_k3, H) + CALL ConstructEmptyMatrix(Temp, H) + CALL ConstructEmptyMatrix(IMat, H) + CALL FillMatrixIdentity(IMat) !! Compute the working hamiltonian. - CALL TransposeMatrix(InverseSquareRoot, InverseSquareRoot_T) - CALL SimilarityTransform(Hamiltonian, InverseSquareRoot, & - & InverseSquareRoot_T, WorkingHamiltonian, pool, & - & threshold_in=solver_parameters%threshold) + CALL TransposeMatrix(ISQ, ISQT) + CALL SimilarityTransform(H, ISQ, ISQT, WH, pool, & + & threshold_in=param%threshold) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN - CALL PermuteMatrix(WorkingHamiltonian, WorkingHamiltonian, & - & solver_parameters%BalancePermutation, memorypool_in=pool) - CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + IF (param%do_load_balancing) THEN + CALL PermuteMatrix(WH, WH, & + & param%BalancePermutation, memorypool_in=pool) + CALL PermuteMatrix(IMat, IMat, & + & param%BalancePermutation, memorypool_in=pool) END IF !! Compute the lambda scaling value. - CALL GershgorinBounds(WorkingHamiltonian,e_min,e_max) + CALL GershgorinBounds(WH, e_min, e_max) !! Initialize - CALL CopyMatrix(WorkingHamiltonian,X_k) + CALL CopyMatrix(WH, X_k) !! Compute lambda CALL MatrixTrace(X_k, trace_value) @@ -129,89 +131,82 @@ SUBROUTINE PM(Hamiltonian, InverseSquareRoot, trace, Density, & factor = -alpha/X_k%actual_matrix_dimension - CALL ScaleMatrix(X_k,factor) - + CALL ScaleMatrix(X_k, factor) factor = (alpha*lambda+trace)/X_k%actual_matrix_dimension - - CALL IncrementMatrix(Identity,X_k,alpha_in=factor) + CALL IncrementMatrix(IMat, X_k, alpha_in=factor) !! Iterate - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - outer_counter = 1 - norm_value = solver_parameters%converge_diff + 1.0_NTREAL + II = 1 + norm_value = param%converge_diff + 1.0_NTREAL energy_value = 0.0_NTREAL - DO outer_counter = 1,solver_parameters%max_iterations + DO II = 1, param%max_iterations !! Compute X_k2 - CALL MatrixMultiply(X_k,X_k,X_k2, & - & threshold_in=solver_parameters%threshold, & - & memory_pool_in=pool) + CALL MatrixMultiply(X_k, X_k, X_k2, & + & threshold_in=param%threshold, memory_pool_in=pool) !! Compute X_k3 - CALL MatrixMultiply(X_k,X_k2,X_k3, & - & threshold_in=solver_parameters%threshold, & - & memory_pool_in=pool) + CALL MatrixMultiply(X_k, X_k2, X_k3, & + & threshold_in=param%threshold, memory_pool_in=pool) !! Compute X_k - X_k2 - CALL CopyMatrix(X_k,TempMat) - CALL IncrementMatrix(X_k2,TempMat, & - & alpha_in=-1.0_NTREAL, & - & threshold_in=solver_parameters%threshold) + CALL CopyMatrix(X_k, Temp) + CALL IncrementMatrix(X_k2, Temp, & + & alpha_in=-1.0_NTREAL, threshold_in=param%threshold) !! Compute Sigma - CALL MatrixTrace(TempMat, trace_value) - CALL DotMatrix(TempMat,X_k,trace_value2) + CALL MatrixTrace(Temp, trace_value) + CALL DotMatrix(Temp, X_k, trace_value2) !! If we hit 0 exact convergence, avoid a division by zero. IF (trace_value .LE. TINY(trace_value)) THEN - sigma_array(outer_counter) = 1.0_NTREAL + sigma_array(II) = 1.0_NTREAL ELSE - sigma_array(outer_counter) = trace_value2/trace_value + sigma_array(II) = trace_value2/trace_value END IF - IF (sigma_array(outer_counter) .GT. 0.5_NTREAL) THEN + IF (sigma_array(II) .GT. 0.5_NTREAL) THEN a1 = 0.0_NTREAL - a2 = 1.0_NTREAL+1.0_NTREAL/sigma_array(outer_counter) - a3 = -1.0_NTREAL/sigma_array(outer_counter) + a2 = 1.0_NTREAL + 1.0_NTREAL/sigma_array(II) + a3 = -1.0_NTREAL/sigma_array(II) ELSE - a1 = (1.0_NTREAL-2.0_NTREAL*sigma_array(outer_counter)) & - & / (1.0_NTREAL-sigma_array(outer_counter)) - a2 = (1.0_NTREAL+sigma_array(outer_counter)) & - & / (1.0_NTREAL-sigma_array(outer_counter)) - a3 = -1.0_NTREAL/(1.0_NTREAL-sigma_array(outer_counter)) + a1 = (1.0_NTREAL - 2.0_NTREAL*sigma_array(II)) & + & / (1.0_NTREAL - sigma_array(II)) + a2 = (1.0_NTREAL + sigma_array(II)) & + & / (1.0_NTREAL - sigma_array(II)) + a3 = -1.0_NTREAL/(1.0_NTREAL - sigma_array(II)) END IF !! Update X_k - CALL ScaleMatrix(X_k,a1) - CALL IncrementMatrix(X_k2,X_k, & - & alpha_in=a2, & - & threshold_in=solver_parameters%threshold) - CALL IncrementMatrix(X_k3,X_k, & - & alpha_in=a3, & - & threshold_in=solver_parameters%threshold) + CALL ScaleMatrix(X_k, a1) + CALL IncrementMatrix(X_k2, X_k, & + & alpha_in=a2, threshold_in=param%threshold) + CALL IncrementMatrix(X_k3, X_k, & + & alpha_in=a3, threshold_in=param%threshold) !! Energy value based convergence energy_value2 = energy_value - CALL DotMatrix(X_k, WorkingHamiltonian, energy_value) + CALL DotMatrix(X_k, WH, energy_value) energy_value = 2.0_NTREAL*energy_value norm_value = ABS(energy_value - energy_value2) - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) CALL EnterSubLog CALL WriteElement("Energy_Value", VALUE=energy_value) CALL ExitSubLog END IF - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. param%converge_diff) THEN EXIT END IF END DO - total_iterations = outer_counter-1 - IF (solver_parameters%be_verbose) THEN + total_iterations = II-1 + IF (param%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=outer_counter) + CALL WriteElement(key="Total_Iterations", VALUE=II) CALL PrintMatrixInformation(X_k) END IF @@ -220,23 +215,23 @@ SUBROUTINE PM(Hamiltonian, InverseSquareRoot, trace, Density, & END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (param%do_load_balancing) THEN CALL UndoPermuteMatrix(X_k, X_k, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & param%BalancePermutation, memorypool_in=pool) END IF !! Compute the density matrix in the non-orthogonalized basis - CALL SimilarityTransform(X_k, InverseSquareRoot_T, InverseSquareRoot, & - & Density, pool, threshold_in=solver_parameters%threshold) + CALL SimilarityTransform(X_k, ISQT, ISQ, K, pool, & + & threshold_in=param%threshold) !! Cleanup - CALL DestructMatrix(WorkingHamiltonian) - CALL DestructMatrix(InverseSquareRoot_T) + CALL DestructMatrix(WH) + CALL DestructMatrix(ISQT) CALL DestructMatrix(X_k) CALL DestructMatrix(X_k2) CALL DestructMatrix(X_k3) - CALL DestructMatrix(TempMat) - CALL DestructMatrix(Identity) + CALL DestructMatrix(Temp) + CALL DestructMatrix(IMat) CALL DestructMatrixMemoryPool(pool) !! Compute The Chemical Potential @@ -244,21 +239,21 @@ SUBROUTINE PM(Hamiltonian, InverseSquareRoot, trace, Density, & interval_a = 0.0_NTREAL interval_b = 1.0_NTREAL midpoint = 0.0_NTREAL - midpoints: DO outer_counter = 1,solver_parameters%max_iterations + midpoints: DO II = 1, param%max_iterations midpoint = (interval_b - interval_a)/2.0_NTREAL + interval_a zero_value = midpoint !! Compute polynomial function at the guess point. - polynomial:DO inner_counter=1,total_iterations - IF (sigma_array(inner_counter) .GT. 0.5_NTREAL) THEN - zero_value = ((1.0_NTREAL+sigma_array(inner_counter)) & + polynomial: DO JJ = 1, total_iterations + IF (sigma_array(JJ) .GT. 0.5_NTREAL) THEN + zero_value = ((1.0_NTREAL + sigma_array(JJ)) & & *zero_value**2) - (zero_value**3) - zero_value = zero_value/sigma_array(inner_counter) + zero_value = zero_value/sigma_array(JJ) ELSE zero_value = ((1.0_NTREAL - 2.0_NTREAL* & - & sigma_array(inner_counter))*zero_value) & - & + ((1.0_NTREAL+sigma_array(inner_counter))* & + & sigma_array(JJ))*zero_value) & + & + ((1.0_NTREAL + sigma_array(JJ))* & & zero_value**2) - (zero_value**3) - zero_value = zero_value/(1.0_NTREAL-sigma_array(inner_counter)) + zero_value = zero_value/(1.0_NTREAL - sigma_array(JJ)) END IF END DO polynomial !! Change bracketing. @@ -268,38 +263,37 @@ SUBROUTINE PM(Hamiltonian, InverseSquareRoot, trace, Density, & interval_b = midpoint END IF !! Check convergence. - IF (ABS(zero_value-0.5_NTREAL) .LT. & - & solver_parameters%converge_diff) THEN + IF (ABS(zero_value - 0.5_NTREAL) .LT. param%converge_diff) THEN EXIT END IF END DO midpoints !! Undo scaling. chemical_potential_out = lambda - & - & (Hamiltonian%actual_matrix_dimension*midpoint - trace) & + & (H%actual_matrix_dimension*midpoint - trace) & & /alpha END IF - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL ExitSubLog END IF !! Cleanup DEALLOCATE(sigma_array) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(param) END SUBROUTINE PM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the density matrix from a Hamiltonian using the TRS2 method. !> Based on the TRS2 algorithm presented in \cite niklasson2002. - SUBROUTINE TRS2(Hamiltonian, InverseSquareRoot, trace, Density, & + SUBROUTINE TRS2(H, ISQ, trace, K, & & energy_value_out, chemical_potential_out, solver_parameters_in) !> The matrix to compute the corresponding density from - TYPE(Matrix_ps), INTENT(IN) :: Hamiltonian + TYPE(Matrix_ps), INTENT(IN) :: H !> The inverse square root of the overlap matrix. - TYPE(Matrix_ps), INTENT(IN) :: InverseSquareRoot + TYPE(Matrix_ps), INTENT(IN) :: ISQ !> The trace of the density matrix (usually the number of electrons) REAL(NTREAL), INTENT(IN) :: trace !> The density matrix computed by this routine. - TYPE(Matrix_ps), INTENT(INOUT) :: Density + TYPE(Matrix_ps), INTENT(INOUT) :: K !> The energy of the system (optional). REAL(NTREAL), INTENT(OUT), OPTIONAL :: energy_value_out !> The chemical potential (optional). @@ -307,12 +301,12 @@ SUBROUTINE TRS2(Hamiltonian, InverseSquareRoot, trace, Density, & !> Parameters for the solver (optional). TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: param !! Local Matrices - TYPE(Matrix_ps) :: WorkingHamiltonian - TYPE(Matrix_ps) :: Identity - TYPE(Matrix_ps) :: InverseSquareRoot_T - TYPE(Matrix_ps) :: X_k, X_k2, TempMat + TYPE(Matrix_ps) :: WH + TYPE(Matrix_ps) :: IMat + TYPE(Matrix_ps) :: ISQT + TYPE(Matrix_ps) :: X_k, X_k2, Temp !! Local Variables REAL(NTREAL) :: e_min, e_max REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: sigma_array @@ -323,17 +317,17 @@ SUBROUTINE TRS2(Hamiltonian, InverseSquareRoot, trace, Density, & REAL(NTREAL) :: zero_value, midpoint, interval_a, interval_b !! Temporary Variables TYPE(MatrixMemoryPool_p) :: pool - INTEGER :: outer_counter, inner_counter + INTEGER :: II, JJ INTEGER :: total_iterations !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + param = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + param = SolverParameters_t() END IF - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Density Matrix Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="TRS2") @@ -341,96 +335,93 @@ SUBROUTINE TRS2(Hamiltonian, InverseSquareRoot, trace, Density, & CALL EnterSubLog CALL WriteListElement("niklasson2002expansion") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(param) END IF - ALLOCATE(sigma_array(solver_parameters%max_iterations)) + ALLOCATE(sigma_array(param%max_iterations)) !! Construct All The Necessary Matrices - CALL ConstructEmptyMatrix(Density, Hamiltonian) - CALL ConstructEmptyMatrix(WorkingHamiltonian, Hamiltonian) - CALL ConstructEmptyMatrix(X_k, Hamiltonian) - CALL ConstructEmptyMatrix(X_k2, Hamiltonian) - CALL ConstructEmptyMatrix(TempMat, Hamiltonian) - CALL ConstructEmptyMatrix(Identity, Hamiltonian) - CALL FillMatrixIdentity(Identity) + CALL ConstructEmptyMatrix(K, H) + CALL ConstructEmptyMatrix(WH, H) + CALL ConstructEmptyMatrix(X_k, H) + CALL ConstructEmptyMatrix(X_k2, H) + CALL ConstructEmptyMatrix(Temp, H) + CALL ConstructEmptyMatrix(IMat, H) + CALL FillMatrixIdentity(IMat) !! Compute the working hamiltonian. - CALL TransposeMatrix(InverseSquareRoot, InverseSquareRoot_T) - CALL SimilarityTransform(Hamiltonian, InverseSquareRoot, & - & InverseSquareRoot_T, WorkingHamiltonian, pool, & - & threshold_in=solver_parameters%threshold) + CALL TransposeMatrix(ISQ, ISQT) + CALL SimilarityTransform(H, ISQ, ISQT, WH, pool, & + & threshold_in=param%threshold) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN - CALL PermuteMatrix(WorkingHamiltonian, WorkingHamiltonian, & - & solver_parameters%BalancePermutation, memorypool_in=pool) - CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + IF (param%do_load_balancing) THEN + CALL PermuteMatrix(WH, WH, & + & param%BalancePermutation, memorypool_in=pool) + CALL PermuteMatrix(IMat, IMat, & + & param%BalancePermutation, memorypool_in=pool) END IF !! Compute the lambda scaling value. - CALL GershgorinBounds(WorkingHamiltonian,e_min,e_max) + CALL GershgorinBounds(WH, e_min, e_max) !! Initialize - CALL CopyMatrix(WorkingHamiltonian,X_k) - CALL ScaleMatrix(X_k,-1.0_NTREAL) - CALL IncrementMatrix(Identity,X_k,alpha_in=e_max) - CALL ScaleMatrix(X_k,1.0_NTREAL/(e_max-e_min)) + CALL CopyMatrix(WH, X_k) + CALL ScaleMatrix(X_k, -1.0_NTREAL) + CALL IncrementMatrix(IMat, X_k, alpha_in=e_max) + CALL ScaleMatrix(X_k, 1.0_NTREAL/(e_max - e_min)) !! Iterate - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - outer_counter = 1 - norm_value = solver_parameters%converge_diff + 1.0_NTREAL + II = 1 + norm_value = param%converge_diff + 1.0_NTREAL energy_value = 0.0_NTREAL - DO outer_counter = 1,solver_parameters%max_iterations + DO II = 1, param%max_iterations !! Compute Sigma CALL MatrixTrace(X_k, trace_value) IF (trace - trace_value .LT. 0.0_NTREAL) THEN - sigma_array(outer_counter) = -1.0_NTREAL + sigma_array(II) = -1.0_NTREAL ELSE - sigma_array(outer_counter) = 1.0_NTREAL + sigma_array(II) = 1.0_NTREAL END IF !! Compute X_k2 - CALL MatrixMultiply(X_k,X_k,X_k2, & - & threshold_in=solver_parameters%threshold, & - & memory_pool_in=pool) + CALL MatrixMultiply(X_k, X_k, X_k2, & + & threshold_in=param%threshold, memory_pool_in=pool) !! Update X_k - IF (sigma_array(outer_counter) .GT. 0.0_NTREAL) THEN - CALL ScaleMatrix(X_k,2.0_NTREAL) - CALL IncrementMatrix(X_k2,X_k, & - & alpha_in=-1.0_NTREAL, & - & threshold_in=solver_parameters%threshold) + IF (sigma_array(II) .GT. 0.0_NTREAL) THEN + CALL ScaleMatrix(X_k, 2.0_NTREAL) + CALL IncrementMatrix(X_k2, X_k, & + & alpha_in=-1.0_NTREAL, threshold_in=param%threshold) ELSE CALL CopyMatrix(X_k2,X_k) END IF !! Energy value based convergence energy_value2 = energy_value - CALL DotMatrix(X_k, WorkingHamiltonian, energy_value) + CALL DotMatrix(X_k, WH, energy_value) energy_value = 2.0_NTREAL*energy_value norm_value = ABS(energy_value - energy_value2) - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) CALL EnterSubLog CALL WriteElement("Energy_Value", VALUE=energy_value) CALL ExitSubLog END IF - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. param%converge_diff) THEN EXIT END IF END DO - total_iterations = outer_counter-1 - IF (solver_parameters%be_verbose) THEN + total_iterations = II - 1 + IF (param%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=outer_counter) + CALL WriteElement(key="Total_Iterations", VALUE=II) CALL PrintMatrixInformation(X_k) END IF @@ -439,22 +430,22 @@ SUBROUTINE TRS2(Hamiltonian, InverseSquareRoot, trace, Density, & END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (param%do_load_balancing) THEN CALL UndoPermuteMatrix(X_k, X_k, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & param%BalancePermutation, memorypool_in=pool) END IF !! Compute the density matrix in the non-orthogonalized basis - CALL SimilarityTransform(X_k, InverseSquareRoot_T, InverseSquareRoot, & - & Density, pool, threshold_in=solver_parameters%threshold) + CALL SimilarityTransform(X_k, ISQT, ISQ, K, pool, & + & threshold_in=param%threshold) !! Cleanup - CALL DestructMatrix(WorkingHamiltonian) - CALL DestructMatrix(InverseSquareRoot_T) + CALL DestructMatrix(WH) + CALL DestructMatrix(ISQT) CALL DestructMatrix(X_k) CALL DestructMatrix(X_k2) - CALL DestructMatrix(TempMat) - CALL DestructMatrix(Identity) + CALL DestructMatrix(Temp) + CALL DestructMatrix(IMat) CALL DestructMatrixMemoryPool(pool) !! Compute The Chemical Potential @@ -462,12 +453,12 @@ SUBROUTINE TRS2(Hamiltonian, InverseSquareRoot, trace, Density, & interval_a = 0.0_NTREAL interval_b = 1.0_NTREAL midpoint = 0.0_NTREAL - midpoints: DO outer_counter = 1,solver_parameters%max_iterations + midpoints: DO II = 1, param%max_iterations midpoint = (interval_b - interval_a)/2.0_NTREAL + interval_a zero_value = midpoint !! Compute polynomial function at the guess point. - polynomial:DO inner_counter=1,total_iterations - IF (sigma_array(inner_counter) .LT. 0.0_NTREAL) THEN + polynomial: DO JJ = 1, total_iterations + IF (sigma_array(JJ) .LT. 0.0_NTREAL) THEN zero_value = zero_value*zero_value ELSE zero_value = 2.0_NTREAL*zero_value - zero_value*zero_value @@ -480,8 +471,7 @@ SUBROUTINE TRS2(Hamiltonian, InverseSquareRoot, trace, Density, & interval_b = midpoint END IF !! Check convergence. - IF (ABS(zero_value-0.5_NTREAL) .LT. & - & solver_parameters%converge_diff) THEN + IF (ABS(zero_value-0.5_NTREAL) .LT. param%converge_diff) THEN EXIT END IF END DO midpoints @@ -489,27 +479,27 @@ SUBROUTINE TRS2(Hamiltonian, InverseSquareRoot, trace, Density, & chemical_potential_out = e_max + (e_min - e_max)*midpoint END IF - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL ExitSubLog END IF !! Cleanup DEALLOCATE(sigma_array) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(param) END SUBROUTINE TRS2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the density matrix from a Hamiltonian using the TRS4 method. !> Based on the TRS4 algorithm presented in \cite niklasson2002 - SUBROUTINE TRS4(Hamiltonian, InverseSquareRoot, trace, Density, & + SUBROUTINE TRS4(H, ISQ, trace, K, & & energy_value_out, chemical_potential_out, solver_parameters_in) !> The matrix to compute the corresponding density from. - TYPE(Matrix_ps), INTENT(IN) :: Hamiltonian + TYPE(Matrix_ps), INTENT(IN) :: H !> The inverse square root of the overlap matrix. - TYPE(Matrix_ps), INTENT(IN) :: InverseSquareRoot + TYPE(Matrix_ps), INTENT(IN) :: ISQ !> The trace of the density matrix (usually the number of electrons) REAL(NTREAL), INTENT(IN) :: trace !> The density matrix computed by this routine. - TYPE(Matrix_ps), INTENT(INOUT) :: Density + TYPE(Matrix_ps), INTENT(INOUT) :: K !> The energy of the system (optional). REAL(NTREAL), INTENT(OUT), OPTIONAL :: energy_value_out !> The chemical potential (optional). @@ -519,11 +509,11 @@ SUBROUTINE TRS4(Hamiltonian, InverseSquareRoot, trace, Density, & REAL(NTREAL), PARAMETER :: sigma_min = 0.0_NTREAL REAL(NTREAL), PARAMETER :: sigma_max = 6.0_NTREAL !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: param !! Local Matrices - TYPE(Matrix_ps) :: WorkingHamiltonian - TYPE(Matrix_ps) :: Identity - TYPE(Matrix_ps) :: InverseSquareRoot_T + TYPE(Matrix_ps) :: WH + TYPE(Matrix_ps) :: IMat + TYPE(Matrix_ps) :: ISQT TYPE(Matrix_ps) :: X_k, X_k2, Fx_right, GX_right, TempMat !! Local Variables REAL(NTREAL) :: e_min, e_max @@ -535,18 +525,18 @@ SUBROUTINE TRS4(Hamiltonian, InverseSquareRoot, trace, Density, & REAL(NTREAL) :: tempfx,tempgx !! Temporary Variables TYPE(MatrixMemoryPool_p) :: pool - INTEGER :: outer_counter, inner_counter + INTEGER :: II, JJ INTEGER :: total_iterations REAL(NTREAL) :: trace_fx, trace_gx !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + param = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + param = SolverParameters_t() END IF - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Density Matrix Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="TRS4") @@ -554,69 +544,68 @@ SUBROUTINE TRS4(Hamiltonian, InverseSquareRoot, trace, Density, & CALL EnterSubLog CALL WriteListElement("niklasson2002expansion") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(param) END IF - ALLOCATE(sigma_array(solver_parameters%max_iterations)) + ALLOCATE(sigma_array(param%max_iterations)) !! Construct All The Necessary Matrices - CALL ConstructEmptyMatrix(Density, Hamiltonian) - CALL ConstructEmptyMatrix(WorkingHamiltonian, Hamiltonian) - CALL ConstructEmptyMatrix(X_k, Hamiltonian) - CALL ConstructEmptyMatrix(X_k2, Hamiltonian) - CALL ConstructEmptyMatrix(TempMat, Hamiltonian) - CALL ConstructEmptyMatrix(Fx_right, Hamiltonian) - CALL ConstructEmptyMatrix(Gx_right, Hamiltonian) - CALL ConstructEmptyMatrix(Identity, Hamiltonian) - CALL FillMatrixIdentity(Identity) + CALL ConstructEmptyMatrix(K, H) + CALL ConstructEmptyMatrix(WH, H) + CALL ConstructEmptyMatrix(X_k, H) + CALL ConstructEmptyMatrix(X_k2, H) + CALL ConstructEmptyMatrix(TempMat, H) + CALL ConstructEmptyMatrix(Fx_right, H) + CALL ConstructEmptyMatrix(Gx_right, H) + CALL ConstructEmptyMatrix(IMat, H) + CALL FillMatrixIdentity(IMat) !! Compute the working hamiltonian. - CALL TransposeMatrix(InverseSquareRoot, InverseSquareRoot_T) - CALL SimilarityTransform(Hamiltonian, InverseSquareRoot, & - & InverseSquareRoot_T, WorkingHamiltonian, pool, & - & threshold_in=solver_parameters%threshold) + CALL TransposeMatrix(ISQ, ISQT) + CALL SimilarityTransform(H, ISQ, ISQT, WH, pool, & + & threshold_in=param%threshold) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN - CALL PermuteMatrix(WorkingHamiltonian, WorkingHamiltonian, & - & solver_parameters%BalancePermutation, memorypool_in=pool) - CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + IF (param%do_load_balancing) THEN + CALL PermuteMatrix(WH, WH, & + & param%BalancePermutation, memorypool_in=pool) + CALL PermuteMatrix(IMat, IMat, & + & param%BalancePermutation, memorypool_in=pool) END IF !! Compute the lambda scaling value. - CALL GershgorinBounds(WorkingHamiltonian,e_min,e_max) + CALL GershgorinBounds(WH,e_min,e_max) !! Initialize - CALL CopyMatrix(WorkingHamiltonian,X_k) - CALL ScaleMatrix(X_k,-1.0_NTREAL) - CALL IncrementMatrix(Identity,X_k,alpha_in=e_max) - CALL ScaleMatrix(X_k,1.0_NTREAL/(e_max-e_min)) + CALL CopyMatrix(WH,X_k) + CALL ScaleMatrix(X_k, -1.0_NTREAL) + CALL IncrementMatrix(IMat, X_k, alpha_in=e_max) + CALL ScaleMatrix(X_k, 1.0_NTREAL/(e_max - e_min)) !! Iterate - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - outer_counter = 1 - norm_value = solver_parameters%converge_diff + 1.0_NTREAL + II = 1 + norm_value = param%converge_diff + 1.0_NTREAL energy_value = 0.0_NTREAL - DO outer_counter = 1,solver_parameters%max_iterations + DO II = 1, param%max_iterations !! Compute X_k2 CALL MatrixMultiply(X_k, X_k, X_k2, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=param%threshold, memory_pool_in=pool) !! Compute Fx_right - CALL CopyMatrix(X_k2,Fx_right) - CALL ScaleMatrix(Fx_right,-3.0_NTREAL) - CALL IncrementMatrix(X_k,Fx_right,alpha_in=4.0_NTREAL) + CALL CopyMatrix(X_k2, Fx_right) + CALL ScaleMatrix(Fx_right, -3.0_NTREAL) + CALL IncrementMatrix(X_k, Fx_right, alpha_in=4.0_NTREAL) !! Compute Gx_right - CALL CopyMatrix(Identity,Gx_right) - CALL IncrementMatrix(X_k,Gx_right,alpha_in=-2.0_NTREAL) - CALL IncrementMatrix(X_k2,Gx_right) + CALL CopyMatrix(IMat, Gx_right) + CALL IncrementMatrix(X_k, Gx_right, alpha_in=-2.0_NTREAL) + CALL IncrementMatrix(X_k2, Gx_right) !! Compute Traces - CALL DotMatrix(X_k2,Fx_right,trace_fx) - CALL DotMatrix(X_k2,Gx_right,trace_gx) + CALL DotMatrix(X_k2, Fx_right, trace_fx) + CALL DotMatrix(X_k2, Gx_right, trace_gx) !! Avoid Overflow IF (ABS(trace_gx) .LT. 1.0e-14_NTREAL) THEN @@ -624,46 +613,46 @@ SUBROUTINE TRS4(Hamiltonian, InverseSquareRoot, trace, Density, & END IF !! Compute Sigma - sigma_array(outer_counter) = (trace - trace_fx)/trace_gx + sigma_array(II) = (trace - trace_fx)/trace_gx !! Update The Matrix - IF (sigma_array(outer_counter) .GT. sigma_max) THEN + IF (sigma_array(II) .GT. sigma_max) THEN CALL CopyMatrix(X_k, TempMat) CALL ScaleMatrix(TempMat, 2.0_NTREAL) CALL IncrementMatrix(X_k2, TempMat, alpha_in=-1.0_NTREAL) - ELSE IF (sigma_array(outer_counter) .LT. sigma_min) THEN + ELSE IF (sigma_array(II) .LT. sigma_min) THEN CALL CopyMatrix(X_k2, TempMat) ELSE - CALL ScaleMatrix(Gx_right,sigma_array(outer_counter)) - CALL IncrementMatrix(Fx_right,Gx_right) + CALL ScaleMatrix(Gx_right, sigma_array(II)) + CALL IncrementMatrix(Fx_right, Gx_right) CALL MatrixMultiply(X_k2, Gx_right, TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=param%threshold, memory_pool_in=pool) END IF - CALL IncrementMatrix(TempMat,X_k,alpha_in=-1.0_NTREAL) - CALL CopyMatrix(TempMat,X_k) + CALL IncrementMatrix(TempMat, X_k, alpha_in=-1.0_NTREAL) + CALL CopyMatrix(TempMat, X_k) !! Energy value based convergence energy_value2 = energy_value - CALL DotMatrix(X_k,WorkingHamiltonian,energy_value) + CALL DotMatrix(X_k, WH, energy_value) energy_value = 2.0_NTREAL*energy_value norm_value = ABS(energy_value - energy_value2) - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) CALL EnterSubLog CALL WriteElement("Energy_Value", VALUE=energy_value) CALL ExitSubLog END IF - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. param%converge_diff) THEN EXIT END IF END DO - total_iterations = outer_counter-1 - IF (solver_parameters%be_verbose) THEN + total_iterations = II - 1 + IF (param%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=outer_counter) + CALL WriteElement(key="Total_Iterations", VALUE=II) CALL PrintMatrixInformation(X_k) END IF @@ -672,24 +661,24 @@ SUBROUTINE TRS4(Hamiltonian, InverseSquareRoot, trace, Density, & END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (param%do_load_balancing) THEN CALL UndoPermuteMatrix(X_k, X_k, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & param%BalancePermutation, memorypool_in=pool) END IF !! Compute the density matrix in the non-orthogonalized basis - CALL SimilarityTransform(X_k, InverseSquareRoot_T, InverseSquareRoot, & - & Density, pool, threshold_in=solver_parameters%threshold) + CALL SimilarityTransform(X_k, ISQT, ISQ, K, pool, & + & threshold_in=param%threshold) !! Cleanup - CALL DestructMatrix(WorkingHamiltonian) - CALL DestructMatrix(InverseSquareRoot_T) + CALL DestructMatrix(WH) + CALL DestructMatrix(ISQT) CALL DestructMatrix(X_k) CALL DestructMatrix(X_k2) CALL DestructMatrix(Fx_right) CALL DestructMatrix(Gx_right) CALL DestructMatrix(TempMat) - CALL DestructMatrix(Identity) + CALL DestructMatrix(IMat) CALL DestructMatrixMemoryPool(pool) !! Compute The Chemical Potential @@ -697,22 +686,22 @@ SUBROUTINE TRS4(Hamiltonian, InverseSquareRoot, trace, Density, & interval_a = 0.0_NTREAL interval_b = 1.0_NTREAL midpoint = 0.0_NTREAL - midpoints: DO outer_counter = 1,solver_parameters%max_iterations + midpoints: DO II = 1, param%max_iterations midpoint = (interval_b - interval_a)/2.0_NTREAL + interval_a zero_value = midpoint !! Compute polynomial function at the guess point. - polynomial:DO inner_counter=1,total_iterations - IF (sigma_array(inner_counter) .GT. sigma_max) THEN + polynomial: DO JJ = 1, total_iterations + IF (sigma_array(JJ) .GT. sigma_max) THEN zero_value = 2.0_NTREAL*zero_value - zero_value*zero_value - ELSE IF (sigma_array(inner_counter) .LT. sigma_min) THEN + ELSE IF (sigma_array(JJ) .LT. sigma_min) THEN zero_value = zero_value*zero_value ELSE tempfx = (zero_value*zero_value) * & & (4.0_NTREAL*zero_value - & - & 3.0_NTREAL*zero_value*zero_value) - tempgx = (zero_value*zero_value) * (1.0_NTREAL-zero_value) & - & * (1.0_NTREAL-zero_value) - zero_value = tempfx + sigma_array(inner_counter)*tempgx + & 3.0_NTREAL*zero_value*zero_value) + tempgx = (zero_value*zero_value) * (1.0_NTREAL - zero_value) & + & * (1.0_NTREAL - zero_value) + zero_value = tempfx + sigma_array(JJ)*tempgx END IF END DO polynomial !! Change bracketing. @@ -722,8 +711,7 @@ SUBROUTINE TRS4(Hamiltonian, InverseSquareRoot, trace, Density, & interval_b = midpoint END IF !! Check convergence. - IF (ABS(zero_value-0.5_NTREAL) .LT. & - & solver_parameters%converge_diff) THEN + IF (ABS(zero_value-0.5_NTREAL) .LT. param%converge_diff) THEN EXIT END IF END DO midpoints @@ -732,26 +720,26 @@ SUBROUTINE TRS4(Hamiltonian, InverseSquareRoot, trace, Density, & END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL ExitSubLog END IF DEALLOCATE(sigma_array) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(param) END SUBROUTINE TRS4 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the density matrix from a Hamiltonian using the HPCP method. !> Based on the algorithm presented in \cite truflandier2016communication. - SUBROUTINE HPCP(Hamiltonian, InverseSquareRoot, trace, Density, & + SUBROUTINE HPCP(H, ISQ, trace, K, & & energy_value_out, chemical_potential_out, solver_parameters_in) !> The matrix to compute the corresponding density from. - TYPE(Matrix_ps), INTENT(IN) :: Hamiltonian + TYPE(Matrix_ps), INTENT(IN) :: H !> The inverse square root of the overlap matrix. - TYPE(Matrix_ps), INTENT(IN) :: InverseSquareRoot + TYPE(Matrix_ps), INTENT(IN) :: ISQ !> The trace of the density matrix (usually the number of electrons) REAL(NTREAL), INTENT(IN) :: trace !> The density matrix computed by this routine. - TYPE(Matrix_ps), INTENT(INOUT) :: Density + TYPE(Matrix_ps), INTENT(INOUT) :: K !> The energy of the system (optional). REAL(NTREAL), INTENT(OUT), OPTIONAL :: energy_value_out !> The chemical potential (optional). @@ -759,12 +747,12 @@ SUBROUTINE HPCP(Hamiltonian, InverseSquareRoot, trace, Density, & !> Parameters for the solver (optional). TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: param !! Local Matrices - TYPE(Matrix_ps) :: WorkingHamiltonian + TYPE(Matrix_ps) :: WH TYPE(Matrix_ps) :: TempMat - TYPE(Matrix_ps) :: Identity - TYPE(Matrix_ps) :: InverseSquareRoot_T + TYPE(Matrix_ps) :: IMat + TYPE(Matrix_ps) :: ISQT TYPE(Matrix_ps) :: D1, DH, DDH, D2DH !! Local Variables REAL(NTREAL) :: e_min, e_max @@ -780,18 +768,18 @@ SUBROUTINE HPCP(Hamiltonian, InverseSquareRoot, trace, Density, & REAL(NTREAL) :: zero_value, midpoint, interval_a, interval_b !! Temporary Variables TYPE(MatrixMemoryPool_p) :: pool - INTEGER :: outer_counter, inner_counter + INTEGER :: II, JJ INTEGER :: total_iterations INTEGER :: matrix_dimension !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + param = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + param = SolverParameters_t() END IF - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Density Matrix Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="HPCP") @@ -799,41 +787,40 @@ SUBROUTINE HPCP(Hamiltonian, InverseSquareRoot, trace, Density, & CALL EnterSubLog CALL WriteListElement("truflandier2016communication") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(param) END IF - ALLOCATE(sigma_array(solver_parameters%max_iterations)) + ALLOCATE(sigma_array(param%max_iterations)) - matrix_dimension = Hamiltonian%actual_matrix_dimension + matrix_dimension = H%actual_matrix_dimension !! Construct All The Necessary Matrices - CALL ConstructEmptyMatrix(Density, Hamiltonian) - CALL ConstructEmptyMatrix(WorkingHamiltonian, Hamiltonian) - CALL ConstructEmptyMatrix(TempMat, Hamiltonian) - CALL ConstructEmptyMatrix(D1, Hamiltonian) - CALL ConstructEmptyMatrix(DH, Hamiltonian) - CALL ConstructEmptyMatrix(DDH, Hamiltonian) - CALL ConstructEmptyMatrix(D2DH, Hamiltonian) - CALL ConstructEmptyMatrix(Identity, Hamiltonian) - CALL FillMatrixIdentity(Identity) + CALL ConstructEmptyMatrix(K, H) + CALL ConstructEmptyMatrix(WH, H) + CALL ConstructEmptyMatrix(TempMat, H) + CALL ConstructEmptyMatrix(D1, H) + CALL ConstructEmptyMatrix(DH, H) + CALL ConstructEmptyMatrix(DDH, H) + CALL ConstructEmptyMatrix(D2DH, H) + CALL ConstructEmptyMatrix(IMat, H) + CALL FillMatrixIdentity(IMat) !! Compute the working hamiltonian. - CALL TransposeMatrix(InverseSquareRoot, InverseSquareRoot_T) - CALL SimilarityTransform(Hamiltonian, InverseSquareRoot, & - & InverseSquareRoot_T, WorkingHamiltonian, pool, & - & threshold_in=solver_parameters%threshold) + CALL TransposeMatrix(ISQ, ISQT) + CALL SimilarityTransform(H, ISQ, ISQT, WH, pool, & + & threshold_in=param%threshold) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN - CALL PermuteMatrix(WorkingHamiltonian, WorkingHamiltonian, & - & solver_parameters%BalancePermutation, memorypool_in=pool) - CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + IF (param%do_load_balancing) THEN + CALL PermuteMatrix(WH, WH, & + & param%BalancePermutation, memorypool_in=pool) + CALL PermuteMatrix(IMat, IMat, & + & param%BalancePermutation, memorypool_in=pool) END IF !! Compute the initial matrix. - CALL GershgorinBounds(WorkingHamiltonian,e_min,e_max) - CALL MatrixTrace(WorkingHamiltonian, mu) + CALL GershgorinBounds(WH, e_min, e_max) + CALL MatrixTrace(WH, mu) mu = mu/matrix_dimension sigma_bar = (matrix_dimension - trace)/matrix_dimension sigma = 1.0_NTREAL - sigma_bar @@ -843,76 +830,75 @@ SUBROUTINE HPCP(Hamiltonian, InverseSquareRoot, trace, Density, & beta_2 = MIN(beta,beta_bar) !! Initialize - CALL CopyMatrix(Identity,D1) - CALL ScaleMatrix(D1,beta_1) - CALL CopyMatrix(Identity,TempMat) - CALL ScaleMatrix(TempMat,mu) - CALL IncrementMatrix(WorkingHamiltonian, TempMat, -1.0_NTREAL) - CALL ScaleMatrix(TempMat,beta_2) - CALL IncrementMatrix(TempMat,D1) + CALL CopyMatrix(IMat, D1) + CALL ScaleMatrix(D1, beta_1) + CALL CopyMatrix(IMat, TempMat) + CALL ScaleMatrix(TempMat, mu) + CALL IncrementMatrix(WH, TempMat, -1.0_NTREAL) + CALL ScaleMatrix(TempMat, beta_2) + CALL IncrementMatrix(TempMat, D1) trace_value = 0.0_NTREAL !! Iterate - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - outer_counter = 1 - norm_value = solver_parameters%converge_diff + 1.0_NTREAL + + II = 1 + norm_value = param%converge_diff + 1.0_NTREAL norm_value2 = norm_value energy_value = 0.0_NTREAL - - DO outer_counter = 1,solver_parameters%max_iterations + DO II = 1, param%max_iterations !! Compute the hole matrix DH - CALL CopyMatrix(D1,DH) - CALL IncrementMatrix(Identity,DH,alpha_in=-1.0_NTREAL) - CALL ScaleMatrix(DH,-1.0_NTREAL) + CALL CopyMatrix(D1, DH) + CALL IncrementMatrix(IMat, DH, alpha_in=-1.0_NTREAL) + CALL ScaleMatrix(DH, -1.0_NTREAL) !! Compute DDH, as well as convergence check - CALL MatrixMultiply(D1,DH,DDH,threshold_in=solver_parameters%threshold,& - & memory_pool_in=pool) + CALL MatrixMultiply(D1, DH, DDH, & + & threshold_in=param%threshold, memory_pool_in=pool) CALL MatrixTrace(DDH, trace_value) norm_value = ABS(trace_value) !! Compute D2DH - CALL MatrixMultiply(D1,DDH,D2DH, & - & threshold_in=solver_parameters%threshold, & - & memory_pool_in=pool) + CALL MatrixMultiply(D1, DDH, D2DH, & + & threshold_in=param%threshold, memory_pool_in=pool) !! Compute Sigma - CALL MatrixTrace(D2DH, sigma_array(outer_counter)) - sigma_array(outer_counter) = sigma_array(outer_counter)/trace_value + CALL MatrixTrace(D2DH, sigma_array(II)) + sigma_array(II) = sigma_array(II)/trace_value - CALL CopyMatrix(D1,TempMat) + CALL CopyMatrix(D1, TempMat) !! Compute D1 + 2*D2DH - CALL IncrementMatrix(D2DH,D1,alpha_in=2.0_NTREAL) + CALL IncrementMatrix(D2DH, D1, alpha_in=2.0_NTREAL) !! Compute D1 + 2*D2DH -2*Sigma*DDH CALL IncrementMatrix(DDH, D1, & - & alpha_in=-1.0_NTREAL*2.0_NTREAL*sigma_array(outer_counter)) + & alpha_in=-1.0_NTREAL*2.0_NTREAL*sigma_array(II)) !! Energy value based convergence energy_value2 = energy_value - CALL DotMatrix(D1,WorkingHamiltonian,energy_value) + CALL DotMatrix(D1, WH, energy_value) energy_value = 2.0_NTREAL*energy_value norm_value = ABS(energy_value - energy_value2) - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) CALL EnterSubLog CALL WriteElement("Energy_Value", VALUE=energy_value) CALL ExitSubLog END IF - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. param%converge_diff) THEN EXIT END IF END DO - total_iterations = outer_counter-1 - IF (solver_parameters%be_verbose) THEN + total_iterations = II - 1 + IF (param%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=outer_counter) + CALL WriteElement(key="Total_Iterations", VALUE=II) CALL PrintMatrixInformation(D1) END IF @@ -921,23 +907,24 @@ SUBROUTINE HPCP(Hamiltonian, InverseSquareRoot, trace, Density, & END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (param%do_load_balancing) THEN CALL UndoPermuteMatrix(D1, D1, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & param%BalancePermutation, memorypool_in=pool) END IF !! Compute the density matrix in the non-orthogonalized basis - CALL SimilarityTransform(D1, InverseSquareRoot_T, InverseSquareRoot, & - & Density, pool, threshold_in=solver_parameters%threshold) + CALL SimilarityTransform(D1, ISQT, ISQ, K, pool, & + & threshold_in=param%threshold) + !! Cleanup - CALL DestructMatrix(WorkingHamiltonian) - CALL DestructMatrix(InverseSquareRoot_T) + CALL DestructMatrix(WH) + CALL DestructMatrix(ISQT) CALL DestructMatrix(TempMat) CALL DestructMatrix(D1) CALL DestructMatrix(DH) CALL DestructMatrix(DDH) CALL DestructMatrix(D2DH) - CALL DestructMatrix(Identity) + CALL DestructMatrix(IMat) CALL DestructMatrixMemoryPool(pool) !! Compute The Chemical Potential @@ -945,14 +932,14 @@ SUBROUTINE HPCP(Hamiltonian, InverseSquareRoot, trace, Density, & interval_a = 0.0_NTREAL interval_b = 1.0_NTREAL midpoint = 0.0_NTREAL - midpoints: DO outer_counter = 1,solver_parameters%max_iterations + midpoints: DO II = 1, param%max_iterations midpoint = (interval_b - interval_a)/2.0_NTREAL + interval_a zero_value = midpoint !! Compute polynomial function at the guess point. - polynomial:DO inner_counter=1,total_iterations + polynomial: DO JJ = 1, total_iterations zero_value = zero_value + & & 2.0_NTREAL*((zero_value**2)*(1.0_NTREAL-zero_value) & - & - sigma_array(inner_counter)* & + & - sigma_array(JJ)* & & zero_value*(1.0_NTREAL-zero_value)) END DO polynomial !! Change bracketing. @@ -962,8 +949,7 @@ SUBROUTINE HPCP(Hamiltonian, InverseSquareRoot, trace, Density, & interval_b = midpoint END IF !! Check convergence. - IF (ABS(zero_value-0.5_NTREAL) .LT. & - & solver_parameters%converge_diff) THEN + IF (ABS(zero_value-0.5_NTREAL) .LT. param%converge_diff) THEN EXIT END IF END DO midpoints @@ -971,11 +957,11 @@ SUBROUTINE HPCP(Hamiltonian, InverseSquareRoot, trace, Density, & chemical_potential_out = mu + (beta_1 - midpoint)/beta_2 END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL ExitSubLog END IF DEALLOCATE(sigma_array) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(param) END SUBROUTINE HPCP !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the density matrix from a Hamiltonian using the Scale and Fold @@ -983,16 +969,16 @@ END SUBROUTINE HPCP !> Note that for this method, you must provide the value of the homo and !> lumo gap. It is not necessary for these to be accurate, but give a !> conservative value. - SUBROUTINE ScaleAndFold(Hamiltonian, InverseSquareRoot, trace, Density, & + SUBROUTINE ScaleAndFold(H, ISQ, trace, K, & & homo, lumo, energy_value_out, solver_parameters_in) !> The matrix to compute the corresponding density from - TYPE(Matrix_ps), INTENT(IN) :: Hamiltonian + TYPE(Matrix_ps), INTENT(IN) :: H !> The inverse square root of the overlap matrix. - TYPE(Matrix_ps), INTENT(IN) :: InverseSquareRoot + TYPE(Matrix_ps), INTENT(IN) :: ISQ !> The trace of the density matrix (usually the number of electrons) REAL(NTREAL), INTENT(IN) :: trace !> The density matrix computed by this routine. - TYPE(Matrix_ps), INTENT(INOUT) :: Density + TYPE(Matrix_ps), INTENT(INOUT) :: K !> The energy of the system (optional). REAL(NTREAL), INTENT(OUT), OPTIONAL :: energy_value_out !> A conservative estimate of the highest occupied eigenvalue. @@ -1002,11 +988,11 @@ SUBROUTINE ScaleAndFold(Hamiltonian, InverseSquareRoot, trace, Density, & !> Parameters for the solver (optional). TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: param !! Local Matrices - TYPE(Matrix_ps) :: WorkingHamiltonian - TYPE(Matrix_ps) :: Identity - TYPE(Matrix_ps) :: InverseSquareRoot_T + TYPE(Matrix_ps) :: WH + TYPE(Matrix_ps) :: IMat + TYPE(Matrix_ps) :: ISQT TYPE(Matrix_ps) :: X_k, X_k2, TempMat !! Local Variables REAL(NTREAL) :: e_min, e_max @@ -1016,17 +1002,16 @@ SUBROUTINE ScaleAndFold(Hamiltonian, InverseSquareRoot, trace, Density, & REAL(NTREAL) :: energy_value, energy_value2 !! Temporary Variables TYPE(MatrixMemoryPool_p) :: pool - INTEGER :: outer_counter - INTEGER :: total_iterations + INTEGER :: II !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + param = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + param = SolverParameters_t() END IF - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Density Matrix Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="Scale and Fold") @@ -1034,69 +1019,66 @@ SUBROUTINE ScaleAndFold(Hamiltonian, InverseSquareRoot, trace, Density, & CALL EnterSubLog CALL WriteListElement("rubensson2011nonmonotonic") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(param) END IF !! Construct All The Necessary Matrices - CALL ConstructEmptyMatrix(Density, Hamiltonian) - CALL ConstructEmptyMatrix(WorkingHamiltonian, Hamiltonian) - CALL ConstructEmptyMatrix(X_k, Hamiltonian) - CALL ConstructEmptyMatrix(X_k2, Hamiltonian) - CALL ConstructEmptyMatrix(TempMat, Hamiltonian) - CALL ConstructEmptyMatrix(Identity, Hamiltonian) - CALL FillMatrixIdentity(Identity) + CALL ConstructEmptyMatrix(K, H) + CALL ConstructEmptyMatrix(WH, H) + CALL ConstructEmptyMatrix(X_k, H) + CALL ConstructEmptyMatrix(X_k2, H) + CALL ConstructEmptyMatrix(TempMat, H) + CALL ConstructEmptyMatrix(IMat, H) + CALL FillMatrixIdentity(IMat) !! Compute the working hamiltonian. - CALL TransposeMatrix(InverseSquareRoot, InverseSquareRoot_T) - CALL SimilarityTransform(Hamiltonian, InverseSquareRoot, & - & InverseSquareRoot_T, WorkingHamiltonian, pool, & - & threshold_in=solver_parameters%threshold) + CALL TransposeMatrix(ISQ, ISQT) + CALL SimilarityTransform(H, ISQ, ISQT, WH, pool, & + & threshold_in=param%threshold) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN - CALL PermuteMatrix(WorkingHamiltonian, WorkingHamiltonian, & - & solver_parameters%BalancePermutation, memorypool_in=pool) - CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + IF (param%do_load_balancing) THEN + CALL PermuteMatrix(WH, WH, & + & param%BalancePermutation, memorypool_in=pool) + CALL PermuteMatrix(IMat, IMat, & + & param%BalancePermutation, memorypool_in=pool) END IF !! Compute the lambda scaling value. - CALL GershgorinBounds(WorkingHamiltonian,e_min,e_max) + CALL GershgorinBounds(WH, e_min, e_max) !! Initialize - CALL CopyMatrix(WorkingHamiltonian,X_k) - CALL ScaleMatrix(X_k,-1.0_NTREAL) - CALL IncrementMatrix(Identity,X_k,alpha_in=e_max) - CALL ScaleMatrix(X_k,1.0_NTREAL/(e_max-e_min)) + CALL CopyMatrix(WH, X_k) + CALL ScaleMatrix(X_k, -1.0_NTREAL) + CALL IncrementMatrix(IMat, X_k, alpha_in=e_max) + CALL ScaleMatrix(X_k, 1.0_NTREAL/(e_max - e_min)) Beta = (e_max - lumo) / (e_max - e_min) BetaBar = (e_max - homo) / (e_max - e_min) !! Iterate - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - outer_counter = 1 - norm_value = solver_parameters%converge_diff + 1.0_NTREAL + II = 1 + norm_value = param%converge_diff + 1.0_NTREAL energy_value = 0.0_NTREAL - DO outer_counter = 1,solver_parameters%max_iterations + DO II = 1, param%max_iterations !! Determine the path CALL MatrixTrace(X_k, trace_value) IF (trace_value .GT. trace) THEN alpha = 2.0/(2.0 - Beta) CALL ScaleMatrix(X_k, alpha) - CALL IncrementMatrix(Identity, X_k, alpha_in=(1.0_NTREAL-alpha)) - CALL MatrixMultiply(X_k,X_k,X_k2, & - & threshold_in=solver_parameters%threshold, & - & memory_pool_in=pool) + CALL IncrementMatrix(IMat, X_k, alpha_in=(1.0_NTREAL-alpha)) + CALL MatrixMultiply(X_k, X_k, X_k2, & + & threshold_in=param%threshold, memory_pool_in=pool) CALL CopyMatrix(X_k2, X_k) Beta = (alpha * Beta + 1 - alpha)**2 BetaBar = (alpha * BetaBar + 1 - alpha)**2 ELSE alpha = 2.0/(1.0 + BetaBar) - CALL MatrixMultiply(X_k,X_k,X_k2, & - & threshold_in=solver_parameters%threshold, & - & memory_pool_in=pool) + CALL MatrixMultiply(X_k, X_k, X_k2, & + & threshold_in=param%threshold, memory_pool_in=pool) CALL ScaleMatrix(X_k, 2*alpha) CALL IncrementMatrix(X_k2, X_k, alpha_in=-1.0_NTREAL*alpha**2) Beta = 2.0 * alpha * Beta - alpha**2 * Beta**2 @@ -1105,25 +1087,24 @@ SUBROUTINE ScaleAndFold(Hamiltonian, InverseSquareRoot, trace, Density, & !! Energy value based convergence energy_value2 = energy_value - CALL DotMatrix(X_k, WorkingHamiltonian, energy_value) + CALL DotMatrix(X_k, WH, energy_value) energy_value = 2.0_NTREAL*energy_value norm_value = ABS(energy_value - energy_value2) - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) CALL EnterSubLog CALL WriteElement("Energy_Value", VALUE=energy_value) CALL ExitSubLog END IF - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. param%converge_diff) THEN EXIT END IF END DO - total_iterations = outer_counter-1 - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=outer_counter) + CALL WriteElement(key="Total_Iterations", VALUE=II) CALL PrintMatrixInformation(X_k) END IF @@ -1132,47 +1113,88 @@ SUBROUTINE ScaleAndFold(Hamiltonian, InverseSquareRoot, trace, Density, & END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (param%do_load_balancing) THEN CALL UndoPermuteMatrix(X_k, X_k, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & param%BalancePermutation, memorypool_in=pool) END IF !! Compute the density matrix in the non-orthogonalized basis - CALL SimilarityTransform(X_k, InverseSquareRoot_T, InverseSquareRoot, & - & Density, pool, threshold_in=solver_parameters%threshold) + CALL SimilarityTransform(X_k, ISQT, ISQ, K, pool, & + & threshold_in=param%threshold) !! Cleanup - CALL DestructMatrix(WorkingHamiltonian) - CALL DestructMatrix(InverseSquareRoot_T) + CALL DestructMatrix(WH) + CALL DestructMatrix(ISQT) CALL DestructMatrix(X_k) CALL DestructMatrix(X_k2) CALL DestructMatrix(TempMat) - CALL DestructMatrix(Identity) + CALL DestructMatrix(IMat) CALL DestructMatrixMemoryPool(pool) - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL ExitSubLog END IF - !! Cleanup - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(param) END SUBROUTINE ScaleAndFold +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the density matrix using a dense routine. + SUBROUTINE DenseDensity(H, ISQ, trace, K, & + & energy_value_out, chemical_potential_out, solver_parameters_in) + !> The matrix to compute the corresponding density from. + TYPE(Matrix_ps), INTENT(IN) :: H + !> The inverse square root of the overlap matrix. + TYPE(Matrix_ps), INTENT(IN) :: ISQ + !> The trace of the density matrix (usually the number of electrons) + REAL(NTREAL), INTENT(IN) :: trace + !> The density matrix computed by this routine. + TYPE(Matrix_ps), INTENT(INOUT) :: K + !> The energy of the system (optional). + REAL(NTREAL), INTENT(OUT), OPTIONAL :: energy_value_out + !> The chemical potential (optional). + REAL(NTREAL), INTENT(OUT), OPTIONAL :: chemical_potential_out + !> Parameters for the solver (optional). + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Handling Optional Parameters + TYPE(SolverParameters_t) :: params + REAL(NTREAL) :: chemical_potential, energy_value + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + + !! Call the unified routine. + CALL ComputeDenseFOE(H, ISQ, trace, K, energy_value_out=energy_value, & + & chemical_potential_out=chemical_potential, & + & solver_parameters_in=params) + + !! Optional out variables. + IF (PRESENT(energy_value_out)) THEN + energy_value_out = energy_value + END IF + IF (PRESENT(chemical_potential_out)) THEN + chemical_potential_out = chemical_potential + END IF + + !! Cleanup + CALL DestructSolverParameters(params) + END SUBROUTINE DenseDensity !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the energy-weighted density matrix. - SUBROUTINE EnergyDensityMatrix(Hamiltonian, Density, EnergyDensity, & - & threshold_in) + SUBROUTINE EnergyDensityMatrix(H, D, ED, threshold_in) !> The matrix to compute from. - TYPE(Matrix_ps), INTENT(IN) :: Hamiltonian + TYPE(Matrix_ps), INTENT(IN) :: H !> The density matrix. - TYPE(Matrix_ps), INTENT(IN) :: Density + TYPE(Matrix_ps), INTENT(IN) :: D !> The energy-weighted density matrix. - TYPE(Matrix_ps), INTENT(INOUT) :: EnergyDensity + TYPE(Matrix_ps), INTENT(INOUT) :: ED !> Threshold for flushing small values (default = 0). REAL(NTREAL), INTENT(IN), OPTIONAL :: threshold_in !! Handling Optional Parameters REAL(NTREAL) :: threshold - !! Temporary Variables - TYPE(MatrixMemoryPool_p) :: pool !! Optional Parameters IF (PRESENT(threshold_in)) THEN @@ -1182,11 +1204,8 @@ SUBROUTINE EnergyDensityMatrix(Hamiltonian, Density, EnergyDensity, & END IF !! EDM = DM * H * DM - CALL SimilarityTransform(Hamiltonian, Density, & - & Density, EnergyDensity, pool, threshold_in=threshold) + CALL SimilarityTransform(H, D, D, ED, threshold_in=threshold) - !! Cleanup - CALL DestructMatrixMemoryPool(pool) END SUBROUTINE EnergyDensityMatrix !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE DensityMatrixSolversModule diff --git a/Source/Fortran/EigenBoundsModule.F90 b/Source/Fortran/EigenBoundsModule.F90 index b6d4d59f..013bb1fd 100644 --- a/Source/Fortran/EigenBoundsModule.F90 +++ b/Source/Fortran/EigenBoundsModule.F90 @@ -10,7 +10,8 @@ MODULE EigenBoundsModule & IncrementMatrix, ScaleMatrix USE PSMatrixModule, ONLY : Matrix_ps, ConstructEmptyMatrix, CopyMatrix, & & DestructMatrix, GetMatrixTripletList, FillMatrixFromTripletList - USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters + USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & + & DestructSolverParameters USE TripletListModule, ONLY : TripletList_r, TripletList_c, & & AppendToTripletList, DestructTripletList USE TripletModule, ONLY : Triplet_r @@ -23,7 +24,7 @@ MODULE EigenBoundsModule CONTAINS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute a bounds on the minimum and maximum eigenvalue of a matrix. !> Uses the Gershgorin theorem. - SUBROUTINE GershgorinBounds(this,min_value,max_value) + SUBROUTINE GershgorinBounds(this, min_value, max_value) !> The matrix to compute the min/max of. TYPE(Matrix_ps), INTENT(IN) :: this !> A lower bound on the eigenspectrum. @@ -54,7 +55,7 @@ END SUBROUTINE GershgorinBounds !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute a bounds on the maximum eigenvalue of a matrix. !> Uses The Power Method. - SUBROUTINE PowerBounds(this,max_value,solver_parameters_in) + SUBROUTINE PowerBounds(this, max_value, solver_parameters_in) !> The matrix to compute the min/max of. TYPE(Matrix_ps), INTENT(IN) :: this !> An upper bound on the eigenspectrum. @@ -62,28 +63,28 @@ SUBROUTINE PowerBounds(this,max_value,solver_parameters_in) !> The parameters for this calculation. TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: param !! Local Data TYPE(Matrix_ps) :: vector, vector2, TempMat REAL(NTREAL) :: scale_value REAL(NTREAL) :: norm_value TYPE(TripletList_r) :: temp_list TYPE(Triplet_r) :: temp_triplet - INTEGER :: outer_counter + INTEGER :: II TYPE(MatrixMemoryPool_p) :: pool !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + param = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() - solver_parameters%max_iterations = 10 + param = SolverParameters_t() + param%max_iterations = 10 END IF - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Power Bounds Solver") CALL EnterSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(param) END IF !! Diagonal matrices serve as vectors. @@ -101,47 +102,47 @@ SUBROUTINE PowerBounds(this,max_value,solver_parameters_in) CALL FillMatrixFromTripletList(vector,temp_list) !! Iterate - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - outer_counter = 1 - norm_value = solver_parameters%converge_diff + 1.0_NTREAL - DO outer_counter = 1,solver_parameters%max_iterations - IF (solver_parameters%be_verbose .AND. outer_counter .GT. 1) THEN + II = 1 + norm_value = param%converge_diff + 1.0_NTREAL + DO II = 1, param%max_iterations + IF (param%be_verbose .AND. II .GT. 1) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) END IF !! x = Ax - CALL MatrixMultiply(this,vector,vector2, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + CALL MatrixMultiply(this, vector, vector2, & + & threshold_in=param%threshold, memory_pool_in=pool) !! x = x/||x|| scale_value = 1.0/MatrixNorm(vector2) - CALL ScaleMatrix(vector2,scale_value) + CALL ScaleMatrix(vector2, scale_value) !! Check if Converged - CALL IncrementMatrix(vector2,vector,-1.0_NTREAL) + CALL IncrementMatrix(vector2, vector, -1.0_NTREAL) norm_value = MatrixNorm(vector) - CALL CopyMatrix(vector2,vector) + CALL CopyMatrix(vector2, vector) - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. param%converge_diff) THEN EXIT END IF END DO - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations",VALUE=outer_counter-1) + CALL WriteElement(key="Total_Iterations", VALUE=II - 1) END IF !! Compute The Largest Eigenvalue CALL DotMatrix(vector, vector, scale_value) - CALL MatrixMultiply(this,vector,vector2, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + CALL MatrixMultiply(this, vector, vector2, & + & threshold_in=param%threshold, memory_pool_in=pool) CALL DotMatrix(vector, vector2, max_value) max_value = max_value / scale_value - IF (solver_parameters%be_verbose) THEN + IF (param%be_verbose) THEN CALL WriteElement(key="Max_Eigen_Value",VALUE=max_value) CALL ExitSubLog END IF @@ -151,6 +152,7 @@ SUBROUTINE PowerBounds(this,max_value,solver_parameters_in) CALL DestructMatrix(vector2) CALL DestructMatrix(TempMat) CALL DestructMatrixMemoryPool(pool) + CALL DestructSolverParameters(param) END SUBROUTINE PowerBounds !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE EigenBoundsModule diff --git a/Source/Fortran/EigenExaModule.F90 b/Source/Fortran/EigenExaModule.F90 new file mode 100644 index 00000000..77c49ee6 --- /dev/null +++ b/Source/Fortran/EigenExaModule.F90 @@ -0,0 +1,390 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> A module for calling eigenexa +MODULE EigenExaModule +#if EIGENEXA + USE DataTypesModule, ONLY : NTREAL, NTCOMPLEX + USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteElement, & + & WriteHeader, WriteListElement + USE PSMatrixModule, ONLY : Matrix_ps, ConstructEmptyMatrix, & + & FillMatrixFromTripletList, GetMatrixTripletList, PrintMatrixInformation + USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & + & DestructSolverParameters + USE TimerModule, ONLY : StartTimer, StopTimer + USE TripletModule, ONLY : Triplet_r, Triplet_c, SetTriplet + USE TripletListModule, ONLY : TripletList_r, TripletList_c, & + & AppendToTripletList, GetTripletAt, ConstructTripletList, & + & DestructTripletList, RedistributeTripletLists + USE eigen_libs_mod + USE NTMPIModule + IMPLICIT NONE + PRIVATE +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + PUBLIC :: EigenExa_s +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + TYPE, PRIVATE :: ExaHelper_t + !> The number of processors involved. + INTEGER :: num_procs + !> The number of rows for the eigenexa comm. + INTEGER :: proc_rows + !> The number of columns for the eigenexa comm. + INTEGER :: proc_cols + !> Which process this is. + INTEGER :: procid + !> The global rank + INTEGER :: global_rank + !> Which row is this process in. + INTEGER :: rowid + !> Which column is this process in. + INTEGER :: colid + !> The number of rows for the local matrix. + INTEGER :: local_rows + !> The number of columns for the local matrix. + INTEGER :: local_cols + !> The dimension fo the matrix. + INTEGER :: mat_dim + !> The communicator for this calculation. + INTEGER :: comm + !> Householder transform block size + INTEGER :: MB + !> Householder backward transformation block size + INTEGER :: M + !> Mode of the solver + CHARACTER :: MODE + !> For block cyclic indexing. + INTEGER :: offset + !> Number of values to compute. + INTEGER :: nvals + END TYPE ExaHelper_t +CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the eigenvectors of a matrix using EigenExa. + SUBROUTINE EigenExa_s(A, eigenvalues, nvals, & + & eigenvectors_in, solver_parameters_in) + !> The matrix to decompose. + TYPE(Matrix_ps), INTENT(IN) :: A + !> The eigenvalues computed. + TYPE(Matrix_ps), INTENT(INOUT) :: eigenvalues + !> The number of eigenvalues to compute. + INTEGER, INTENT(IN) :: nvals + !> The eigenvectors computed. + TYPE(Matrix_ps), INTENT(INOUT), OPTIONAL :: eigenvectors_in + !> The parameters for this solver. + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Optional Parameters + TYPE(SolverParameters_t) :: params + + !! Process Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + + !! Write info about the solver + IF (params%be_verbose) THEN + CALL WriteHeader("Eigen Solver") + CALL EnterSubLog + CALL WriteElement(key="Method", VALUE="EigenExa") + CALL WriteElement(key="NVALS", VALUE=nvals) + CALL WriteHeader("Citations") + CALL EnterSubLog + CALL WriteListElement("imamura2011development") + CALL ExitSubLog + CALL PrintParameters(params) + END IF + + !! Select Based on Type + IF (A%is_complex) THEN + IF (PRESENT(eigenvectors_in)) THEN + CALL EigenExa_c(A, eigenvalues, nvals, params, & + & eigenvectors_in) + ELSE + CALL EigenExa_c(A, eigenvalues, nvals, params) + END IF + ELSE + IF (PRESENT(eigenvectors_in)) THEN + CALL EigenExa_r(A, eigenvalues, nvals, params, & + & eigenvectors_in) + ELSE + CALL EigenExa_r(A, eigenvalues, nvals, params) + END IF + END IF + + !! Cleanup + CALL DestructSolverParameters(params) + + END SUBROUTINE EigenExa_s +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the eigenvectors of a matrix using EigenExa (real). + SUBROUTINE EigenExa_r(A, eigenvalues, nvals, params, eigenvectors_in) + !> The matrix to decompose. + TYPE(Matrix_ps), INTENT(IN) :: A + !> The eigenvalues computed. + TYPE(Matrix_ps), INTENT(INOUT) :: eigenvalues + !> The number of eigenvalues to compute. + INTEGER, INTENT(IN) :: nvals + !> The parameters for this solver. + TYPE(SolverParameters_t), INTENT(IN) :: params + !> The eigenvectors computed. + TYPE(Matrix_ps), INTENT(INOUT), OPTIONAL :: eigenvectors_in + !! Helper + TYPE(ExaHelper_t) :: exa + !! Dense Matrices + REAL(NTREAL), DIMENSION(:,:), ALLOCATABLE :: AD + REAL(NTREAL), DIMENSION(:,:), ALLOCATABLE :: VD + REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: WD + +#include "eigenexa_includes/EigenExa_s.F90" + + END SUBROUTINE EigenExa_r +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the eigenvectors of a matrix using EigenExa (complex). + SUBROUTINE EigenExa_c(A, eigenvalues, nvals, params, eigenvectors_in) + !> The matrix to decompose. + TYPE(Matrix_ps), INTENT(IN) :: A + !> The eigenvalues computed. + TYPE(Matrix_ps), INTENT(INOUT) :: eigenvalues + !> The number of eigenvalues to compute. + INTEGER, INTENT(IN) :: nvals + !> The parameters for this solver. + TYPE(SolverParameters_t), INTENT(IN) :: params + !> The eigenvectors computed. + TYPE(Matrix_ps), INTENT(INOUT), OPTIONAL :: eigenvectors_in + !! Helper + TYPE(ExaHelper_t) :: exa + !! Dense Matrices + COMPLEX(NTCOMPLEX), DIMENSION(:,:), ALLOCATABLE :: AD + COMPLEX(NTCOMPLEX), DIMENSION(:,:), ALLOCATABLE :: VD + REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: WD + +#define ISCOMPLEX +#include "eigenexa_includes/EigenExa_s.F90" +#undef ISCOMPLEX + + END SUBROUTINE EigenExa_c +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Setup the eigen exa data structures. + SUBROUTINE InitializeEigenExa(A, nvals, eigenvectors, exa) + !> The matrix we're working on. + TYPE(Matrix_ps), INTENT(IN) :: A + !> Number of eigenvalues to compute. + INTEGER, INTENT(IN) :: nvals + !> Whether to compute eigenvectors. + LOGICAL, INTENT(IN) :: eigenvectors + !> Stores info about the calculation. + TYPE(ExaHelper_t), INTENT(INOUT) :: exa + !! Local Variables + INTEGER :: ICTXT, INFO + INTEGER, DIMENSION(9) :: DESCA + INTEGER :: ierr + + !! Number of values to compute. + exa%nvals = nvals + + !! Setup the MPI Communicator + CALL MPI_Comm_dup(A%process_grid%global_comm, exa%comm, ierr) + CALL MPI_Comm_rank(exa%comm, exa%global_rank, ierr) + + !! Build EigenExa Process Grid + CALL eigen_init(exa%comm) + CALL eigen_get_procs(exa%num_procs, exa%proc_rows, exa%proc_cols ) + CALL eigen_get_id(exa%procid, exa%rowid, exa%colid) + + !! Allocate Dense Matrices + exa%mat_dim = A%actual_matrix_dimension + CALL eigen_get_matdims(exa%mat_dim, exa%local_rows, exa%local_cols) + + !> Default blocking parameters + exa%MB = 128 + exa%M = 48 + IF (eigenvectors) THEN + exa%MODE = 'A' + ELSE + exa%MODE = 'N' + END IF + + !! Blacs gives us the blocking info. + ICTXT = eigen_get_blacs_context() + CALL DESCINIT(DESCA, exa%mat_dim, exa%mat_dim, 1, 1, 0, 0, ICTXT, & + & exa%local_rows, INFO ) + exa%offset = DESCA(9) + + END SUBROUTINE InitializeEigenExa +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Converts the distributed sparse matrix to a dense matrix in block-cyclic + !> distribution (real). + SUBROUTINE NTToEigen_r(A, AD, exa) + !> The matrix to convert. + TYPE(Matrix_ps), INTENT(IN) :: A + !> The dense, block-cyclic version. + REAL(NTREAL), DIMENSION(:,:), INTENT(INOUT) :: AD + !> Info about the calculation. + TYPE(ExaHelper_t), INTENT(INOUT) :: exa + !! Local Variables + TYPE(TripletList_r) :: triplet_a + TYPE(TripletList_r), DIMENSION(:), ALLOCATABLE :: send_list + TYPE(TripletList_r) :: recv_list + TYPE(Triplet_r) :: trip, shifted_trip + +#include "eigenexa_includes/NTToEigen.f90" + + END SUBROUTINE NTToEigen_r +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Converts the distributed sparse matrix to a dense matrix in block-cyclic + !> distribution (complex). + SUBROUTINE NTToEigen_c(A, AD, exa) + !> The matrix to convert. + TYPE(Matrix_ps), INTENT(IN) :: A + !> The dense, block-cyclic version. + COMPLEX(NTCOMPLEX), DIMENSION(:,:), INTENT(INOUT) :: AD + !> Info about the calculation. + TYPE(ExaHelper_t), INTENT(INOUT) :: exa + !! Local Variables + TYPE(TripletList_c) :: triplet_a + TYPE(TripletList_c), DIMENSION(:), ALLOCATABLE :: send_list + TYPE(TripletList_c) :: recv_list + TYPE(Triplet_c) :: trip, shifted_trip + +#include "eigenexa_includes/NTToEigen.f90" + + END SUBROUTINE NTToEigen_c +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Converts the dense eigenvector matrix stored block-cyclicly back to + !> a distributed sparse matrix (real). + SUBROUTINE EigenToNT_r(VD, V, params, exa) + !> The dense eigenvector matrix. + REAL(NTREAL), DIMENSION(:,:), INTENT(IN) :: VD + !> The distributed sparse matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: V + !> Parameters for thresholding small values. + TYPE(SolverParameters_t) :: params + !> Info about the calculation. + TYPE(ExaHelper_t) :: exa + !! Local Variables + TYPE(TripletList_r) :: triplet_v + TYPE(Triplet_r) :: trip + REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: VD1 + +#include "eigenexa_includes/EigenToNT.f90" + + END SUBROUTINE EigenToNT_r +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Converts the dense eigenvector matrix stored block-cyclicly back to + !> a distributed sparse matrix (complex). + SUBROUTINE EigenToNT_c(VD, V, params, exa) + !> The dense eigenvector matrix. + COMPLEX(NTCOMPLEX), DIMENSION(:,:), INTENT(IN) :: VD + !> The distributed sparse matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: V + !> Parameters for thresholding small values. + TYPE(SolverParameters_t) :: params + !> Info about the calculation. + TYPE(ExaHelper_t) :: exa + !! Local Variables + TYPE(TripletList_c) :: triplet_v + TYPE(Triplet_c) :: trip + COMPLEX(NTCOMPLEX), DIMENSION(:), ALLOCATABLE :: VD1 + +#include "eigenexa_includes/EigenToNT.f90" + + END SUBROUTINE EigenToNT_c +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Converts the dense eigenvalue matrix stored duplicated across processes. + SUBROUTINE ExtractEigenvalues(WD, W, exa) + !> The dense eigenvalue matrix. + REAL(NTREAL), DIMENSION(:), INTENT(IN) :: WD + !> The distributed sparse matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: W + !> Info about the calculation. + TYPE(ExaHelper_t) :: exa + !! Local Variables + TYPE(TripletList_r) :: triplet_w + TYPE(Triplet_r) :: trip + INTEGER :: wstart, wend, wsize + INTEGER :: II + + !! Copy To Triplet List + wsize = MAX(CEILING((1.0*exa%mat_dim)/exa%num_procs), 1) + wstart = wsize*exa%global_rank + 1 + wend = MIN(wsize*(exa%global_rank+1), exa%mat_dim) + + CALL ConstructTripletList(triplet_w) + DO II = wstart, wend + IF (II .GT. exa%nvals) THEN + EXIT + END IF + CALL SetTriplet(trip, II, II, WD(II)) + CALL AppendToTripletList(triplet_w, trip) + END DO + + !! Go to global matrix + CALL FillMatrixFromTripletList(W, triplet_w) + + !! Cleanup + CALL DestructTripletList(triplet_w) + + END SUBROUTINE ExtractEigenvalues +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> The routine which calls the eigenexa driver. + SUBROUTINE Compute_r(A, V, W, exa) + !> The matrix to decompose. + REAL(NTREAL), DIMENSION(:,:), INTENT(INOUT) :: A + !> The eigenvectors. + REAL(NTREAL), DIMENSION(:,:), INTENT(INOUT) :: V + !> The eigenvalues. + REAL(NTREAL), DIMENSION(:), INTENT(INOUT) :: W + !> Calculation parameters. + TYPE(ExaHelper_t), INTENT(IN) :: exa + +#include "eigenexa_includes/Compute.f90" + + !! Call + CALL eigen_sx(N, exa%nvals, A, LDA, W, V, LDZ, mode=exa%MODE) + + END SUBROUTINE Compute_r +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> The routine which calls the eigenexa driver. + SUBROUTINE Compute_c(A, V, W, exa) + !> The matrix to decompose. + COMPLEX(NTCOMPLEX), DIMENSION(:,:), INTENT(INOUT) :: A + !> The eigenvectors. + COMPLEX(NTCOMPLEX), DIMENSION(:,:), INTENT(INOUT) :: V + !> The eigenvalues. + REAL(NTREAL), DIMENSION(:), INTENT(INOUT) :: W + !> Calculation parameters. + TYPE(ExaHelper_t), INTENT(IN) :: exa + +#include "eigenexa_includes/Compute.f90" + + !! Call + CALL eigen_h(N, exa%nvals, A, LDA, W, V, LDZ, mode=exa%MODE) + + END SUBROUTINE Compute_c +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Deallocates and shuts down eigenexa (real) + SUBROUTINE CleanUp_r(AD, VD, WD) + !> The matrix._r + REAL(NTREAL), DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: AD + !> The eigenvectors. + REAL(NTREAL), DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: VD + !> The eigenvalues. + REAL(NTREAL), DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: WD + +#include "eigenexa_includes/Cleanup.f90" + + END SUBROUTINE CleanUp_r +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Deallocates and shuts down eigenexa (complex) + SUBROUTINE CleanUp_c(AD, VD, WD) + !> The matrix. + COMPLEX(NTCOMPLEX), DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: AD + !> The eigenvectors. + COMPLEX(NTCOMPLEX), DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: VD + !> The eigenvalues. + REAL(NTREAL), DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: WD + +#include "eigenexa_includes/Cleanup.f90" + + END SUBROUTINE CleanUp_c +#endif +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +END MODULE EigenExaModule diff --git a/Source/Fortran/EigenSolversModule.F90 b/Source/Fortran/EigenSolversModule.F90 new file mode 100644 index 00000000..755aff51 --- /dev/null +++ b/Source/Fortran/EigenSolversModule.F90 @@ -0,0 +1,235 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> A module for computing the eigenvalues of a matrix. +MODULE EigenSolversModule + USE DataTypesModule, ONLY : NTREAL + USE DMatrixModule, ONLY : Matrix_ldr, Matrix_ldc, ConstructMatrixDFromS, & + & ConstructMatrixSFromD, DestructMatrix +#if EIGENEXA + USE EigenExaModule, ONLY : EigenExa_s +#endif + USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteHeader, WriteElement + USE PSMatrixAlgebraModule, ONLY : MatrixMultiply + USE PSMatrixModule, ONLY : Matrix_ps, GatherMatrixToProcess, & + & FillMatrixFromTripletList, ConstructEmptyMatrix, ConvertMatrixToReal, & + & DestructMatrix, CopyMatrix, GetMatrixTripletList, TransposeMatrix, & + & ConjugateMatrix + USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & + & DestructSolverParameters + USE SMatrixModule, ONLY : Matrix_lsr, Matrix_lsc, MatrixToTripletList, & + & DestructMatrix + USE TripletListModule, ONLY : TripletList_r, TripletList_c, & + & ConstructTripletList, DestructTripletList + USE NTMPIModule + IMPLICIT NONE + PRIVATE +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + PUBLIC :: EigenDecomposition + PUBLIC :: DenseMatrixFunction +CONTAINS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the eigendecomposition of a matrix. + !! Uses a dense routine. + SUBROUTINE EigenDecomposition(this, eigenvalues, eigenvectors_in, nvals_in, & + & solver_parameters_in) + !> The matrix to decompose. + TYPE(Matrix_ps), INTENT(IN) :: this + !> Diagonal matrix of eigenvalues. + TYPE(Matrix_ps), INTENT(INOUT) :: eigenvalues + !> The eigenvectors of a matrix. + TYPE(Matrix_ps), INTENT(INOUT), OPTIONAL :: eigenvectors_in + !> The number of desired eigenvalues. + INTEGER, INTENT(IN), OPTIONAL :: nvals_in + !> Parameters for computing + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! For Handling Optional Parameters + TYPE(SolverParameters_t) :: params + INTEGER :: nvals + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + IF (PRESENT(nvals_in)) THEN + nvals = nvals_in + ELSE + nvals = this%actual_matrix_dimension + END IF + +#if EIGENEXA + IF (PRESENT(eigenvectors_in)) THEN + CALL EigenExa_s(this, eigenvalues, nvals, eigenvectors_in, & + & solver_parameters_in=params) + ELSE + CALL EigenExa_s(this, eigenvalues, nvals, & + & solver_parameters_in=params) + END IF +#else + IF (PRESENT(eigenvectors_in)) THEN + CALL EigenSerial(this, eigenvalues, nvals, params, eigenvectors_in) + ELSE + CALL EigenSerial(this, eigenvalues, nvals, params) + END IF +#endif + + !! Cleanup + CALL DestructSolverParameters(params) + END SUBROUTINE EigenDecomposition +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Apply an arbitrary matrix function defined by a matrix map as a + !! transformation of the eigenvalues. + SUBROUTINE DenseMatrixFunction(this, ResultMat, func, solver_parameters_in) + !> The matrix to apply the function to. + TYPE(Matrix_ps), INTENT(IN) :: this + !> The transformed matrix + TYPE(Matrix_ps), INTENT(INOUT) :: ResultMat + INTERFACE + !> The procedure to apply to each eigenvalue. + FUNCTION func(val) RESULT(outval) + USE DataTypesModule, ONLY : NTREAL + !> The actual value of an element. + REAL(KIND=NTREAL), INTENT(IN) :: val + !> The transformed value. + REAL(KIND=NTREAL) :: outval + END FUNCTION func + END INTERFACE + !> Parameters for computing + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! For Handling Optional Parameters + TYPE(SolverParameters_t) :: params + !! Local Variables + TYPE(Matrix_ps) :: vecs, vecsT, vals, temp + TYPE(TripletList_r) :: tlist + INTEGER :: II + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + + !! Perform the eigendecomposition + CALL EigenDecomposition(this, vals, solver_parameters_in=params, & + & eigenvectors_in=vecs) + + !! Convert to a triplet list, map the triplet list, fill. + CALL GetMatrixTripletList(vals, tlist) + DO II = 1, tlist%CurrentSize + tlist%DATA(II)%point_value = func(tlist%DATA(II)%point_value) + END DO + + !! Fill + CALL ConstructEmptyMatrix(ResultMat, this) + CALL FillMatrixFromTripletList(ResultMat, tlist, preduplicated_in=.TRUE.) + + !! Multiply Back Together + CALL MatrixMultiply(vecs, ResultMat, temp, threshold_in=params%threshold) + CALL TransposeMatrix(vecs, vecsT) + CALL ConjugateMatrix(vecsT) + CALL MatrixMultiply(temp, vecsT, ResultMat, threshold_in=params%threshold) + + !! Cleanup + CALL DestructMatrix(vecs) + CALL DestructMatrix(temp) + CALL DestructMatrix(vals) + CALL DestructTripletList(tlist) + CALL DestructSolverParameters(params) + + END SUBROUTINE DenseMatrixFunction +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> The base case: use lapack to solve. + SUBROUTINE EigenSerial(this, eigenvalues, nvals, solver_params, & + & eigenvectors_in) + !> The matrix to compute. + TYPE(Matrix_ps), INTENT(IN) :: this + !> The eigenvalues of the matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: eigenvalues + !> The number of vals to compute. + INTEGER, INTENT(IN) :: nvals + !> The solve parameters. + TYPE(SolverParameters_t), INTENT(IN) :: solver_params + !> The eigenvectors of the matrix. + TYPE(Matrix_ps), INTENT(INOUT), OPTIONAL :: eigenvectors_in + + !! Write info about the solver + IF (solver_params%be_verbose) THEN + CALL WriteHeader("Eigen Solver") + CALL EnterSubLog + CALL WriteElement(key="Method", VALUE="LAPACK") + CALL WriteElement(key="NVALS", VALUE=nvals) + CALL ExitSubLog + CALL PrintParameters(solver_params) + END IF + + IF (this%is_complex) THEN + IF (PRESENT(eigenvectors_in)) THEN + CALL EigenSerial_c(this, eigenvalues, nvals, & + & solver_params%threshold, eigenvectors_in) + ELSE + CALL EigenSerial_c(this, eigenvalues, nvals, & + & solver_params%threshold) + END IF + ELSE + IF (PRESENT(eigenvectors_in)) THEN + CALL EigenSerial_r(this, eigenvalues, nvals, & + & solver_params%threshold, eigenvectors_in) + ELSE + CALL EigenSerial_r(this, eigenvalues, nvals, & + & solver_params%threshold) + END IF + END IF + END SUBROUTINE EigenSerial +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> The base case: use lapack to solve (REAL). + SUBROUTINE EigenSerial_r(this, eigenvalues, nvals, threshold, & + & eigenvectors_in) + USE DMatrixModule, ONLY : EigenDecomposition + !> The matrix to compute. + TYPE(Matrix_ps), INTENT(IN) :: this + !> The eigenvalues of the matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: eigenvalues + !> Number of values to compute. + INTEGER, INTENT(IN) :: nvals + !> Threshold + REAL(NTREAL), INTENT(IN) :: threshold + !> Matrix eigenvectors. + TYPE(Matrix_ps), INTENT(INOUT), OPTIONAL :: eigenvectors_in + !! Local variables + TYPE(Matrix_lsr) :: local_s, V_s, W_s + TYPE(Matrix_ldr) :: local_d, V, W + TYPE(TripletList_r) :: V_t, W_t + +#include "eigenexa_includes/EigenSerial.f90" + + END SUBROUTINE EigenSerial_r +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> The base case: use lapack to solve (COMPLEX). + SUBROUTINE EigenSerial_c(this, eigenvalues, nvals, threshold, & + & eigenvectors_in) + USE DMatrixModule, ONLY : EigenDecomposition + !> The matrix to compute. + TYPE(Matrix_ps), INTENT(IN) :: this + !> The eigenvalues of the matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: eigenvalues + !> Number of values to compute. + INTEGER, INTENT(IN) :: nvals + !> Threshold + REAL(NTREAL), INTENT(IN) :: threshold + !> Matrix eigenvectors. + TYPE(Matrix_ps), INTENT(INOUT), OPTIONAL :: eigenvectors_in + !! Local variables + TYPE(Matrix_lsc) :: local_s, V_s, W_s + TYPE(Matrix_ldc) :: local_d, V, W + TYPE(TripletList_c) :: V_t, W_t + TYPE(Matrix_ps) :: eigenvalues_r + +#include "eigenexa_includes/EigenSerial.f90" + + CALL ConvertMatrixToReal(eigenvalues, eigenvalues_r) + CALL CopyMatrix(eigenvalues_r, eigenvalues) + CALL DestructMatrix(eigenvalues_r) + + END SUBROUTINE EigenSerial_c +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +END MODULE EigenSolversModule diff --git a/Source/Fortran/ExponentialSolversModule.F90 b/Source/Fortran/ExponentialSolversModule.F90 index a19a92c6..26664517 100644 --- a/Source/Fortran/ExponentialSolversModule.F90 +++ b/Source/Fortran/ExponentialSolversModule.F90 @@ -6,6 +6,7 @@ MODULE ExponentialSolversModule & SetCoefficient USE DataTypesModule, ONLY : NTREAL USE EigenBoundsModule, ONLY : GershgorinBounds, PowerBounds + USE EigenSolversModule, ONLY : DenseMatrixFunction USE LinearSolversModule, ONLY : CGSolver USE LoadBalancerModule, ONLY : PermuteMatrix, UndoPermuteMatrix USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteHeader, & @@ -27,8 +28,10 @@ MODULE ExponentialSolversModule PUBLIC :: ComputeExponential PUBLIC :: ComputeExponentialPade PUBLIC :: ComputeExponentialTaylor + PUBLIC :: ComputeDenseExponential PUBLIC :: ComputeLogarithm PUBLIC :: ComputeLogarithmTaylor + PUBLIC :: ComputeDenseLogarithm CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the exponential of a matrix. SUBROUTINE ComputeExponential(InputMat, OutputMat, solver_parameters_in) @@ -75,7 +78,7 @@ SUBROUTINE ComputeExponential(InputMat, OutputMat, solver_parameters_in) CALL ConstructEmptyMatrix(OutputMat, InputMat) !! Scale the matrix - CALL PowerBounds(InputMat,spectral_radius,psub_solver_parameters) + CALL PowerBounds(InputMat, spectral_radius, psub_solver_parameters) sigma_val = 1.0 sigma_counter = 1 DO WHILE (spectral_radius/sigma_val .GT. 1.0) @@ -83,7 +86,7 @@ SUBROUTINE ComputeExponential(InputMat, OutputMat, solver_parameters_in) sigma_counter = sigma_counter + 1 END DO CALL CopyMatrix(InputMat, ScaledMat) - CALL ScaleMatrix(ScaledMat,1.0/sigma_val) + CALL ScaleMatrix(ScaledMat, 1.0/sigma_val) sub_solver_parameters%threshold = sub_solver_parameters%threshold/sigma_val IF (solver_parameters%be_verbose) THEN @@ -92,26 +95,24 @@ SUBROUTINE ComputeExponential(InputMat, OutputMat, solver_parameters_in) !! Expand Chebyshev Series CALL ConstructPolynomial(polynomial,16) - CALL SetCoefficient(polynomial,1,1.266065877752007e+00_NTREAL) - CALL SetCoefficient(polynomial,2,1.130318207984970e+00_NTREAL) - CALL SetCoefficient(polynomial,3,2.714953395340771e-01_NTREAL) - CALL SetCoefficient(polynomial,4,4.433684984866504e-02_NTREAL) - CALL SetCoefficient(polynomial,5,5.474240442092110e-03_NTREAL) - CALL SetCoefficient(polynomial,6,5.429263119148932e-04_NTREAL) - CALL SetCoefficient(polynomial,7,4.497732295351912e-05_NTREAL) - CALL SetCoefficient(polynomial,8,3.198436462630565e-06_NTREAL) - CALL SetCoefficient(polynomial,9,1.992124801999838e-07_NTREAL) - CALL SetCoefficient(polynomial,10,1.103677287249654e-08_NTREAL) - CALL SetCoefficient(polynomial,11,5.505891628277851e-10_NTREAL) - CALL SetCoefficient(polynomial,12,2.498021534339559e-11_NTREAL) - CALL SetCoefficient(polynomial,13,1.038827668772902e-12_NTREAL) - CALL SetCoefficient(polynomial,14,4.032447357431817e-14_NTREAL) - CALL SetCoefficient(polynomial,15,2.127980007794583e-15_NTREAL) - CALL SetCoefficient(polynomial,16,-1.629151584468762e-16_NTREAL) - - CALL Compute(ScaledMat,OutputMat,polynomial,sub_solver_parameters) - !CALL FactorizedChebyshevCompute(ScaledMat,OutputMat,polynomial, & - ! & sub_solver_parameters) + CALL SetCoefficient(polynomial, 1, 1.266065877752007e+00_NTREAL) + CALL SetCoefficient(polynomial, 2, 1.130318207984970e+00_NTREAL) + CALL SetCoefficient(polynomial, 3, 2.714953395340771e-01_NTREAL) + CALL SetCoefficient(polynomial, 4, 4.433684984866504e-02_NTREAL) + CALL SetCoefficient(polynomial, 5, 5.474240442092110e-03_NTREAL) + CALL SetCoefficient(polynomial, 6, 5.429263119148932e-04_NTREAL) + CALL SetCoefficient(polynomial, 7, 4.497732295351912e-05_NTREAL) + CALL SetCoefficient(polynomial, 8, 3.198436462630565e-06_NTREAL) + CALL SetCoefficient(polynomial, 9, 1.992124801999838e-07_NTREAL) + CALL SetCoefficient(polynomial, 10, 1.103677287249654e-08_NTREAL) + CALL SetCoefficient(polynomial, 11, 5.505891628277851e-10_NTREAL) + CALL SetCoefficient(polynomial, 12, 2.498021534339559e-11_NTREAL) + CALL SetCoefficient(polynomial, 13, 1.038827668772902e-12_NTREAL) + CALL SetCoefficient(polynomial, 14, 4.032447357431817e-14_NTREAL) + CALL SetCoefficient(polynomial, 15, 2.127980007794583e-15_NTREAL) + CALL SetCoefficient(polynomial, 16, -1.629151584468762e-16_NTREAL) + + CALL Compute(ScaledMat, OutputMat, polynomial, sub_solver_parameters) !! Undo the scaling by squaring at the end. !! Load Balancing Step @@ -121,7 +122,7 @@ SUBROUTINE ComputeExponential(InputMat, OutputMat, solver_parameters_in) END IF DO counter=1,sigma_counter-1 - CALL MatrixMultiply(OutputMat,OutputMat,TempMat, & + CALL MatrixMultiply(OutputMat, OutputMat, TempMat, & & threshold_in=solver_parameters%threshold, memory_pool_in=pool) CALL CopyMatrix(TempMat,OutputMat) END DO @@ -143,6 +144,8 @@ SUBROUTINE ComputeExponential(InputMat, OutputMat, solver_parameters_in) CALL DestructMatrix(ScaledMat) CALL DestructMatrix(TempMat) CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(psub_solver_parameters) + CALL DestructSolverParameters(sub_solver_parameters) END SUBROUTINE ComputeExponential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the exponential of a matrix using a pade approximation. @@ -169,7 +172,7 @@ SUBROUTINE ComputeExponentialPade(InputMat, OutputMat, solver_parameters_in) REAL(NTREAL) :: spectral_radius REAL(NTREAL) :: sigma_val INTEGER :: sigma_counter - INTEGER :: counter + INTEGER :: II !! Handle The Optional Parameters !! Optional Parameters @@ -241,8 +244,8 @@ SUBROUTINE ComputeExponentialPade(InputMat, OutputMat, solver_parameters_in) CALL CGSolver(LeftMat, OutputMat, RightMat, sub_solver_parameters) !! Undo the scaling by squaring at the end. - DO counter=1,sigma_counter-1 - CALL MatrixMultiply(OutputMat,OutputMat,TempMat, & + DO II = 1, sigma_counter - 1 + CALL MatrixMultiply(OutputMat, OutputMat, TempMat, & & threshold_in=solver_parameters%threshold, memory_pool_in=pool) CALL CopyMatrix(TempMat,OutputMat) END DO @@ -266,6 +269,7 @@ SUBROUTINE ComputeExponentialPade(InputMat, OutputMat, solver_parameters_in) CALL DestructMatrix(RightMat) CALL DestructMatrixMemoryPool(pool) CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(sub_solver_parameters) END SUBROUTINE ComputeExponentialPade !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the exponential of a matrix using a taylor series expansion. @@ -291,9 +295,8 @@ SUBROUTINE ComputeExponentialTaylor(InputMat, OutputMat, solver_parameters_in) REAL(NTREAL) :: sigma_val REAL(NTREAL) :: taylor_denom INTEGER :: sigma_counter - INTEGER :: counter + INTEGER :: II - !! Handle The Optional Parameters !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN solver_parameters = solver_parameters_in @@ -311,7 +314,7 @@ SUBROUTINE ComputeExponentialTaylor(InputMat, OutputMat, solver_parameters_in) END IF !! Compute The Scaling Factor - CALL PowerBounds(InputMat,spectral_radius,psub_solver_parameters) + CALL PowerBounds(InputMat, spectral_radius, psub_solver_parameters) !! Figure out how much to scale the matrix. sigma_val = 1.0 @@ -322,7 +325,7 @@ SUBROUTINE ComputeExponentialTaylor(InputMat, OutputMat, solver_parameters_in) END DO CALL CopyMatrix(InputMat, ScaledMat) - CALL ScaleMatrix(ScaledMat,1.0/sigma_val) + CALL ScaleMatrix(ScaledMat, 1.0/sigma_val) CALL ConstructEmptyMatrix(OutputMat, InputMat) CALL FillMatrixIdentity(OutputMat) @@ -338,16 +341,16 @@ SUBROUTINE ComputeExponentialTaylor(InputMat, OutputMat, solver_parameters_in) !! Expand Taylor Series taylor_denom = 1.0 CALL CopyMatrix(OutputMat, Ak) - DO counter=1,10 - taylor_denom = taylor_denom * counter - CALL MatrixMultiply(Ak,ScaledMat,TempMat, & + DO II = 1, 10 + taylor_denom = taylor_denom * II + CALL MatrixMultiply(Ak, ScaledMat, TempMat, & & threshold_in=solver_parameters%threshold, memory_pool_in=pool) - CALL CopyMatrix(TempMat,Ak) - CALL IncrementMatrix(Ak,OutputMat) + CALL CopyMatrix(TempMat, Ak) + CALL IncrementMatrix(Ak, OutputMat) END DO - DO counter=1,sigma_counter-1 - CALL MatrixMultiply(OutputMat,OutputMat,TempMat, & + DO II = 1, sigma_counter-1 + CALL MatrixMultiply(OutputMat, OutputMat, TempMat, & & threshold_in=solver_parameters%threshold, memory_pool_in=pool) CALL CopyMatrix(TempMat,OutputMat) END DO @@ -366,7 +369,42 @@ SUBROUTINE ComputeExponentialTaylor(InputMat, OutputMat, solver_parameters_in) CALL DestructMatrix(TempMat) CALL DestructMatrixMemoryPool(pool) CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(psub_solver_parameters) END SUBROUTINE ComputeExponentialTaylor +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE ComputeDenseExponential(InputMat, OutputMat, solver_parameters_in) + !> The input matrix + TYPE(Matrix_ps), INTENT(IN) :: InputMat + !> OutputMat = exp(InputMat) + TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat + !> Parameters for the solver + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Handling Solver Parameters + TYPE(SolverParameters_t) :: param + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + param = solver_parameters_in + ELSE + param = SolverParameters_t() + END IF + + IF (param%be_verbose) THEN + CALL WriteHeader("Exponential Solver") + CALL EnterSubLog + END IF + + !! Apply + CALL DenseMatrixFunction(InputMat, OutputMat, ExpLambda, param) + + IF (param%be_verbose) THEN + CALL ExitSubLog + END IF + + !! Cleanup + CALL DestructSolverParameters(param) + + END SUBROUTINE ComputeDenseExponential !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the logarithm of a matrix. SUBROUTINE ComputeLogarithm(InputMat, OutputMat, solver_parameters_in) @@ -421,7 +459,7 @@ SUBROUTINE ComputeLogarithm(InputMat, OutputMat, solver_parameters_in) !! Compute The Scaling Factor sigma_val = 1 sigma_counter = 1 - CALL PowerBounds(InputMat,spectral_radius,p_sub_solver_parameters) + CALL PowerBounds(InputMat, spectral_radius, p_sub_solver_parameters) DO WHILE (spectral_radius .GT. SQRT(2.0)) spectral_radius = SQRT(spectral_radius) sigma_val = sigma_val * 2 @@ -435,43 +473,43 @@ SUBROUTINE ComputeLogarithm(InputMat, OutputMat, solver_parameters_in) CALL ComputeRoot(InputMat, ScaledMat, sigma_val, i_sub_solver_parameters) !! Shift Scaled Matrix - CALL IncrementMatrix(IdentityMat,ScaledMat, & + CALL IncrementMatrix(IdentityMat, ScaledMat, & & alpha_in=REAL(-1.0,NTREAL)) !! Expand Chebyshev Series - CALL ConstructPolynomial(polynomial,32) - CALL SetCoefficient(polynomial,1,-0.485101351704_NTREAL) - CALL SetCoefficient(polynomial,2,1.58828112379_NTREAL) - CALL SetCoefficient(polynomial,3,-0.600947731795_NTREAL) - CALL SetCoefficient(polynomial,4,0.287304748177_NTREAL) - CALL SetCoefficient(polynomial,5,-0.145496447103_NTREAL) - CALL SetCoefficient(polynomial,6,0.0734013668818_NTREAL) - CALL SetCoefficient(polynomial,7,-0.0356277942958_NTREAL) - CALL SetCoefficient(polynomial,8,0.0161605505166_NTREAL) - CALL SetCoefficient(polynomial,9,-0.0066133591188_NTREAL) - CALL SetCoefficient(polynomial,10,0.00229833505456_NTREAL) - CALL SetCoefficient(polynomial,11,-0.000577804103964_NTREAL) - CALL SetCoefficient(polynomial,12,2.2849332964e-05_NTREAL) - CALL SetCoefficient(polynomial,13,8.37426826403e-05_NTREAL) - CALL SetCoefficient(polynomial,14,-6.10822859027e-05_NTREAL) - CALL SetCoefficient(polynomial,15,2.58132364523e-05_NTREAL) - CALL SetCoefficient(polynomial,16,-5.87577322647e-06_NTREAL) - CALL SetCoefficient(polynomial,17,-8.56711062722e-07_NTREAL) - CALL SetCoefficient(polynomial,18,1.52066488969e-06_NTREAL) - CALL SetCoefficient(polynomial,19,-7.12760496253e-07_NTREAL) - CALL SetCoefficient(polynomial,20,1.23102245249e-07_NTREAL) - CALL SetCoefficient(polynomial,21,6.03168259043e-08_NTREAL) - CALL SetCoefficient(polynomial,22,-5.1865499826e-08_NTREAL) - CALL SetCoefficient(polynomial,23,1.43185107512e-08_NTREAL) - CALL SetCoefficient(polynomial,24,2.58449717089e-09_NTREAL) - CALL SetCoefficient(polynomial,25,-3.73189861771e-09_NTREAL) - CALL SetCoefficient(polynomial,26,1.18469334815e-09_NTREAL) - CALL SetCoefficient(polynomial,27,1.51569931066e-10_NTREAL) - CALL SetCoefficient(polynomial,28,-2.89595999673e-10_NTREAL) - CALL SetCoefficient(polynomial,29,1.26720668874e-10_NTREAL) - CALL SetCoefficient(polynomial,30,-3.00079067694e-11_NTREAL) - CALL SetCoefficient(polynomial,31,3.91175568865e-12_NTREAL) - CALL SetCoefficient(polynomial,32,-2.21155654398e-13_NTREAL) + CALL ConstructPolynomial(polynomial, 32) + CALL SetCoefficient(polynomial, 1, -0.485101351704_NTREAL) + CALL SetCoefficient(polynomial, 2, 1.58828112379_NTREAL) + CALL SetCoefficient(polynomial, 3, -0.600947731795_NTREAL) + CALL SetCoefficient(polynomial, 4, 0.287304748177_NTREAL) + CALL SetCoefficient(polynomial, 5, -0.145496447103_NTREAL) + CALL SetCoefficient(polynomial, 6, 0.0734013668818_NTREAL) + CALL SetCoefficient(polynomial, 7, -0.0356277942958_NTREAL) + CALL SetCoefficient(polynomial, 8, 0.0161605505166_NTREAL) + CALL SetCoefficient(polynomial, 9, -0.0066133591188_NTREAL) + CALL SetCoefficient(polynomial, 10, 0.00229833505456_NTREAL) + CALL SetCoefficient(polynomial, 11, -0.000577804103964_NTREAL) + CALL SetCoefficient(polynomial, 12, 2.2849332964e-05_NTREAL) + CALL SetCoefficient(polynomial, 13, 8.37426826403e-05_NTREAL) + CALL SetCoefficient(polynomial, 14, -6.10822859027e-05_NTREAL) + CALL SetCoefficient(polynomial, 15, 2.58132364523e-05_NTREAL) + CALL SetCoefficient(polynomial, 16, -5.87577322647e-06_NTREAL) + CALL SetCoefficient(polynomial, 17, -8.56711062722e-07_NTREAL) + CALL SetCoefficient(polynomial, 18, 1.52066488969e-06_NTREAL) + CALL SetCoefficient(polynomial, 19, -7.12760496253e-07_NTREAL) + CALL SetCoefficient(polynomial, 20, 1.23102245249e-07_NTREAL) + CALL SetCoefficient(polynomial, 21, 6.03168259043e-08_NTREAL) + CALL SetCoefficient(polynomial, 22, -5.1865499826e-08_NTREAL) + CALL SetCoefficient(polynomial, 23, 1.43185107512e-08_NTREAL) + CALL SetCoefficient(polynomial, 24, 2.58449717089e-09_NTREAL) + CALL SetCoefficient(polynomial, 25, -3.73189861771e-09_NTREAL) + CALL SetCoefficient(polynomial, 26, 1.18469334815e-09_NTREAL) + CALL SetCoefficient(polynomial, 27, 1.51569931066e-10_NTREAL) + CALL SetCoefficient(polynomial, 28, -2.89595999673e-10_NTREAL) + CALL SetCoefficient(polynomial, 29, 1.26720668874e-10_NTREAL) + CALL SetCoefficient(polynomial, 30, -3.00079067694e-11_NTREAL) + CALL SetCoefficient(polynomial, 31, 3.91175568865e-12_NTREAL) + CALL SetCoefficient(polynomial, 32, -2.21155654398e-13_NTREAL) CALL FactorizedCompute(ScaledMat, OutputMat, polynomial, & & f_sub_solver_parameters) @@ -489,6 +527,9 @@ SUBROUTINE ComputeLogarithm(InputMat, OutputMat, solver_parameters_in) CALL DestructMatrix(IdentityMat) CALL DestructMatrix(TempMat) CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(i_sub_solver_parameters) + CALL DestructSolverParameters(f_sub_solver_parameters) + CALL DestructSolverParameters(p_sub_solver_parameters) END SUBROUTINE ComputeLogarithm !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the logarithm of a matrix using a taylor series expansion. @@ -513,7 +554,7 @@ SUBROUTINE ComputeLogarithmTaylor(InputMat, OutputMat, solver_parameters_in) REAL(NTREAL) :: sigma_val REAL(NTREAL) :: taylor_denom INTEGER :: sigma_counter - INTEGER :: counter + INTEGER :: II !! Handle The Optional Parameters !! Optional Parameters @@ -553,9 +594,9 @@ SUBROUTINE ComputeLogarithmTaylor(InputMat, OutputMat, solver_parameters_in) CALL FillMatrixIdentity(IdentityMat) !! Setup Matrices - CALL IncrementMatrix(IdentityMat,ScaledMat, & + CALL IncrementMatrix(IdentityMat, ScaledMat, & & alpha_in=REAL(-1.0,NTREAL)) - CALL CopyMatrix(IdentityMat,Ak) + CALL CopyMatrix(IdentityMat, Ak) !! Load Balancing Step IF (solver_parameters%do_load_balancing) THEN @@ -567,21 +608,21 @@ SUBROUTINE ComputeLogarithmTaylor(InputMat, OutputMat, solver_parameters_in) !! Expand taylor series. CALL CopyMatrix(ScaledMat,OutputMat) - DO counter=2,10 - IF (MOD(counter,2) .EQ. 0) THEN - taylor_denom = -1 * counter + DO II = 2, 10 + IF (MOD(II,2) .EQ. 0) THEN + taylor_denom = -1 * II ELSE - taylor_denom = counter + taylor_denom = II END IF - CALL MatrixMultiply(Ak,ScaledMat,TempMat, & + CALL MatrixMultiply(Ak, ScaledMat, TempMat, & & threshold_in=solver_parameters%threshold, memory_pool_in=pool) - CALL CopyMatrix(TempMat,Ak) + CALL CopyMatrix(TempMat, Ak) CALL IncrementMatrix(Ak, OutputMat, & & alpha_in=1.0/taylor_denom) END DO !! Undo scaling. - CALL ScaleMatrix(OutputMat,REAL(2**sigma_counter,NTREAL)) + CALL ScaleMatrix(OutputMat, REAL(2**sigma_counter,NTREAL)) !! Undo load balancing. IF (solver_parameters%do_load_balancing) THEN @@ -599,6 +640,57 @@ SUBROUTINE ComputeLogarithmTaylor(InputMat, OutputMat, solver_parameters_in) CALL DestructMatrix(Ak) CALL DestructMatrixMemoryPool(pool) CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(sub_solver_parameters) END SUBROUTINE ComputeLogarithmTaylor +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE ComputeDenseLogarithm(InputMat, OutputMat, solver_parameters_in) + !> The input matrix + TYPE(Matrix_ps), INTENT(IN) :: InputMat + !> OutputMat = exp(InputMat) + TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat + !> Parameters for the solver + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Handling Solver Parameters + TYPE(SolverParameters_t) :: params + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + + IF (params%be_verbose) THEN + CALL WriteHeader("Logarithm Solver") + CALL EnterSubLog + END IF + + !! Apply + CALL DenseMatrixFunction(InputMat, OutputMat, LogLambda, params) + + IF (params%be_verbose) THEN + CALL ExitSubLog + END IF + + !! Cleanup + CALL DestructSolverParameters(params) + + END SUBROUTINE ComputeDenseLogarithm +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Prototypical exponential for mapping. + FUNCTION ExpLambda(val) RESULT(outval) + REAL(KIND=NTREAL), INTENT(IN) :: val + REAL(KIND=NTREAL) :: outval + + outval = EXP(val) + END FUNCTION ExpLambda +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Prototypical exponential for mapping. + FUNCTION LogLambda(val) RESULT(outval) + REAL(KIND=NTREAL), INTENT(IN) :: val + REAL(KIND=NTREAL) :: outval + + outval = LOG(val) + END FUNCTION LogLambda !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE ExponentialSolversModule diff --git a/Source/Fortran/FermiOperatorModule.F90 b/Source/Fortran/FermiOperatorModule.F90 new file mode 100644 index 00000000..1b5952d1 --- /dev/null +++ b/Source/Fortran/FermiOperatorModule.F90 @@ -0,0 +1,219 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> A Module For Computing The Density Matrix Using the Fermi Operator Expansion +MODULE FermiOperatorModule + USE DataTypesModule, ONLY : NTREAL, MPINTREAL + USE EigenSolversModule, ONLY : EigenDecomposition + USE LoadBalancerModule, ONLY : PermuteMatrix, UndoPermuteMatrix + USE LoggingModule, ONLY : WriteElement, WriteHeader, & + & EnterSubLog, ExitSubLog + USE PSMatrixAlgebraModule, ONLY : MatrixMultiply + USE PSMatrixModule, ONLY : Matrix_ps, ConstructEmptyMatrix, & + & FillMatrixFromTripletList, GetMatrixTripletList, & + & TransposeMatrix, ConjugateMatrix, DestructMatrix + USE PMatrixMemoryPoolModule, ONLY : MatrixMemoryPool_p, & + & DestructMatrixMemoryPool + USE SolverParametersModule, ONLY : SolverParameters_t, & + & PrintParameters, DestructSolverParameters + USE TripletListModule, ONLY : TripletList_r, DestructTripletList + USE NTMPIModule + IMPLICIT NONE + PRIVATE +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + PUBLIC :: ComputeDenseFOE +CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the density matrix using a dense routine. + SUBROUTINE ComputeDenseFOE(H, ISQ, trace, K, inv_temp_in, & + & energy_value_out, chemical_potential_out, solver_parameters_in) + !> The matrix to compute the corresponding density from. + TYPE(Matrix_ps), INTENT(IN) :: H + !> The inverse square root of the overlap matrix. + TYPE(Matrix_ps), INTENT(IN) :: ISQ + !> The trace of the density matrix (usually the number of electrons) + REAL(NTREAL), INTENT(IN) :: trace + !> The density matrix computed by this routine. + TYPE(Matrix_ps), INTENT(INOUT) :: K + !> The inverse temperature for smearing (optional). + REAL(NTREAL), INTENT(IN), OPTIONAL :: inv_temp_in + !> The energy of the system (optional). + REAL(NTREAL), INTENT(OUT), OPTIONAL :: energy_value_out + !> The chemical potential (optional). + REAL(NTREAL), INTENT(OUT), OPTIONAL :: chemical_potential_out + !> Parameters for the solver (optional). + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Handling Optional Parameters + TYPE(SolverParameters_t) :: params + REAL(NTREAL) :: inv_temp + LOGICAL :: do_smearing + !! Local Variables + TYPE(Matrix_ps) :: ISQT, WH + TYPE(Matrix_ps) :: WD + TYPE(Matrix_ps) :: vecs, vecsT, vals, Temp + TYPE(MatrixMemoryPool_p) :: pool + TYPE(TripletList_r) :: tlist + REAL(NTREAL) :: chemical_potential, energy_value + REAL(NTREAL), DIMENSION(:), ALLOCATABLE :: eigs, occ + REAL(NTREAL) :: sval, sv, occ_temp + REAL(NTREAL) :: left, right, homo, lumo + INTEGER :: num_eigs + INTEGER :: II, JJ + INTEGER :: ierr + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + IF (PRESENT(inv_temp_in)) THEN + inv_temp = inv_temp_in + do_smearing = .TRUE. + ELSE + do_smearing = .FALSE. + END IF + + IF (params%be_verbose) THEN + CALL WriteHeader("Density Matrix Solver") + CALL EnterSubLog + IF (do_smearing) THEN + CALL WriteElement(key="Method", VALUE="Dense FOE") + CALL WriteElement(key="InverseTemperature", VALUE=inv_temp) + ELSE + CALL WriteElement(key="Method", VALUE="Dense Step Function") + END IF + CALL PrintParameters(params) + END IF + + !! Compute the working hamiltonian. + CALL TransposeMatrix(ISQ, ISQT) + CALL MatrixMultiply(ISQ, H, Temp, & + & threshold_in=params%threshold, memory_pool_in=pool) + CALL MatrixMultiply(Temp, ISQT, WH, & + & threshold_in=params%threshold, memory_pool_in=pool) + + !! Perform the eigendecomposition + CALL EigenDecomposition(WH, vals, & + & eigenvectors_in=vecs, solver_parameters_in=params) + + !! Gather the eigenvalues on to every process + CALL GetMatrixTripletList(vals, tlist) + num_eigs = H%actual_matrix_dimension + ALLOCATE(eigs(num_eigs)) + eigs = 0 + DO II = 1, tlist%CurrentSize + eigs(tlist%DATA(II)%index_column) = tlist%DATA(II)%point_value + END DO + CALL MPI_ALLREDUCE(MPI_IN_PLACE, eigs, num_eigs, MPINTREAL, & + & MPI_SUM, H%process_grid%within_slice_comm, ierr) + + !! Compute MU By Bisection + IF (do_smearing) THEN + ALLOCATE(occ(num_eigs)) + left = MINVAL(eigs) + right = MAXVAL(eigs) + DO JJ = 1, 10*params%max_iterations + chemical_potential = left + (right - left)/2 + DO II = 1, num_eigs + sval = eigs(II) - chemical_potential + occ(II) = 0.5_NTREAL * (1.0_NTREAL - ERF(inv_temp * sval)) + END DO + sv = SUM(occ) + IF (ABS(trace - sv) .LT. 1E-8_NTREAL) THEN + EXIT + ELSE IF (SV > trace) THEN + right = chemical_potential + ELSE + left = chemical_potential + END IF + END DO + ELSE + JJ = 1 + homo = eigs(FLOOR(trace)) + lumo = eigs(FLOOR(trace) + 1) + occ_temp = FLOOR(TRACE) + 1 - trace + chemical_potential = homo + occ_temp * 0.5_NTREAL * (lumo - homo) + END IF + + !! Write out result of chemical potential search + IF (params%be_verbose) THEN + CALL WriteHeader("Chemical Potential Search") + CALL EnterSubLog + CALL WriteElement(key="Potential", VALUE=chemical_potential) + CALL WriteElement(key="Iterations", VALUE=JJ) + CALL ExitSubLog + END IF + + !! Map + energy_value = 0.0_NTREAL + DO II = 1, tlist%CurrentSize + IF (.NOT. do_smearing) THEN + IF (tlist%DATA(II)%index_column .LE. FLOOR(trace)) THEN + energy_value = energy_value + tlist%DATA(II)%point_value + tlist%DATA(II)%point_value = 1.0_NTREAL + ELSE IF (tlist%DATA(II)%index_column .EQ. CEILING(trace)) THEN + occ_temp = CEILING(trace) - trace + energy_value = energy_value + & + & occ_temp * tlist%DATA(II)%point_value + tlist%DATA(II)%point_value = occ_temp + ELSE + tlist%DATA(II)%point_value = 0.0_NTREAL + ENDIF + ELSE + sval = tlist%DATA(II)%point_value - chemical_potential + occ_temp = 0.5_NTREAL * (1.0_NTREAL - ERF(inv_temp * sval)) + energy_value = energy_value + occ_temp * tlist%DATA(II)%point_value + tlist%DATA(II)%point_value = occ_temp + END IF + END DO + CALL MPI_ALLREDUCE(MPI_IN_PLACE, energy_value, 1, MPINTREAL, MPI_SUM, & + & H%process_grid%within_slice_comm, ierr) + + !! Fill + CALL ConstructEmptyMatrix(vals, H) + CALL FillMatrixFromTripletList(vals, tlist, preduplicated_in=.TRUE.) + + !! Multiply Back Together + CALL MatrixMultiply(vecs, vals, temp, threshold_in=params%threshold) + CALL TransposeMatrix(vecs, vecsT) + CALL ConjugateMatrix(vecsT) + CALL MatrixMultiply(temp, vecsT, WD, & + & threshold_in=params%threshold) + + !! Compute the density matrix in the non-orthogonalized basis + CALL MatrixMultiply(ISQT, WD, Temp, & + & threshold_in=params%threshold, memory_pool_in=pool) + CALL MatrixMultiply(Temp, ISQ, K, & + & threshold_in=params%threshold, memory_pool_in=pool) + + !! Optional out variables. + IF (PRESENT(energy_value_out)) THEN + energy_value_out = 2.0_NTREAL * energy_value + END IF + IF (PRESENT(chemical_potential_out)) THEN + chemical_potential_out = chemical_potential + END IF + + !! Cleanup + CALL DestructMatrix(WH) + CALL DestructMatrix(WD) + CALL DestructMatrix(ISQT) + CALL DestructMatrix(vecs) + CALL DestructMatrix(vecst) + CALL DestructMatrix(vals) + CALL DestructMatrix(temp) + CALL DestructTripletList(tlist) + CALL DestructMatrixMemoryPool(pool) + IF (ALLOCATED(occ)) THEN + DEALLOCATE(occ) + END IF + IF (ALLOCATED(eigs)) THEN + DEALLOCATE(eigs) + END IF + + IF (params%be_verbose) THEN + CALL ExitSubLog + END IF + + CALL DestructSolverParameters(params) + END SUBROUTINE ComputeDenseFOE +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +END MODULE FermiOperatorModule diff --git a/Source/Fortran/GeometryOptimizationModule.F90 b/Source/Fortran/GeometryOptimizationModule.F90 index 69fc95c3..3167a246 100644 --- a/Source/Fortran/GeometryOptimizationModule.F90 +++ b/Source/Fortran/GeometryOptimizationModule.F90 @@ -208,6 +208,7 @@ SUBROUTINE LowdinExtrapolate(PreviousDensity, OldOverlap, NewOverlap, & CALL DestructMatrix(ISQMat) CALL DestructMatrix(TempMat) CALL DestructSolverParameters(params) + CALL DestructMatrixMemoryPool(pool) END SUBROUTINE LowdinExtrapolate !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/Source/Fortran/HermiteSolversModule.F90 b/Source/Fortran/HermiteSolversModule.F90 index b4c7f601..7cbd86b2 100644 --- a/Source/Fortran/HermiteSolversModule.F90 +++ b/Source/Fortran/HermiteSolversModule.F90 @@ -87,7 +87,7 @@ SUBROUTINE Compute_horner(InputMat, OutputMat, poly, solver_parameters_in) !> Parameters for the solver TYPE(SolverParameters_t), INTENT(in), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Local Matrices TYPE(Matrix_ps) :: Identity TYPE(Matrix_ps) :: BalancedInput @@ -98,36 +98,36 @@ SUBROUTINE Compute_horner(InputMat, OutputMat, poly, solver_parameters_in) TYPE(MatrixMemoryPool_p) :: pool !! Local Variables INTEGER :: degree - INTEGER :: counter + INTEGER :: II !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF degree = SIZE(poly%coefficients) - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Hermite Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="Standard") CALL WriteElement(key="Degree", VALUE=degree-1) - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF !! Initial values for matrices CALL ConstructEmptyMatrix(Identity, InputMat) CALL FillMatrixIdentity(Identity) - CALL CopyMatrix(InputMat,BalancedInput) + CALL CopyMatrix(InputMat, BalancedInput) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) CALL PermuteMatrix(BalancedInput, BalancedInput, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF !! Recursive expansion @@ -142,35 +142,35 @@ SUBROUTINE Compute_horner(InputMat, OutputMat, poly, solver_parameters_in) IF (degree .GT. 2) THEN CALL CopyMatrix(Hkminus1, Hkprime) CALL ScaleMatrix(Hkprime, REAL(2.0,NTREAL)) - DO counter = 3, degree + DO II = 3, degree CALL MatrixMultiply(BalancedInput, Hk, Hkplus1, & & alpha_in=REAL(2.0,NTREAL), & - & threshold_in=solver_parameters%threshold, & + & threshold_in=params%threshold, & & memory_pool_in=pool) CALL IncrementMatrix(Hkprime, Hkplus1, & & alpha_in=REAL(-1.0,NTREAL)) CALL CopyMatrix(Hk, Hkprime) CALL ScaleMatrix(Hkprime, & - & REAL(2*(counter-1),KIND=NTREAL)) + & REAL(2*(II-1),KIND=NTREAL)) CALL CopyMatrix(Hk, Hkminus1) CALL CopyMatrix(Hkplus1, Hk) CALL IncrementMatrix(Hk, OutputMat, & - & alpha_in=poly%coefficients(counter)) + & alpha_in=poly%coefficients(II)) END DO END IF END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL PrintMatrixInformation(OutputMat) END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructMatrix(Identity) @@ -180,7 +180,7 @@ SUBROUTINE Compute_horner(InputMat, OutputMat, poly, solver_parameters_in) CALL DestructMatrix(Hkprime) CALL DestructMatrix(BalancedInput) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(params) END SUBROUTINE Compute_horner !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE HermiteSolversModule diff --git a/Source/Fortran/InverseSolversModule.F90 b/Source/Fortran/InverseSolversModule.F90 index b6a19ba8..434da26c 100644 --- a/Source/Fortran/InverseSolversModule.F90 +++ b/Source/Fortran/InverseSolversModule.F90 @@ -2,6 +2,7 @@ !> A Module For Computing The Inverse of a Matrix. MODULE InverseSolversModule USE DataTypesModule, ONLY : NTREAL + USE EigenSolversModule, ONLY : DenseMatrixFunction USE LoadBalancerModule, ONLY : PermuteMatrix, UndoPermuteMatrix USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteHeader, & & WriteElement, WriteListElement @@ -18,119 +19,120 @@ MODULE InverseSolversModule !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Solvers PUBLIC :: Invert + PUBLIC :: DenseInvert PUBLIC :: PseudoInverse CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the inverse of a matrix. !> An implementation of the method of Hotelling \cite palser1998canonical. - SUBROUTINE Invert(Mat, InverseMat, solver_parameters_in) + SUBROUTINE Invert(InputMat, OutputMat, solver_parameters_in) !> The matrix to invert. - TYPE(Matrix_ps), INTENT(IN) :: Mat + TYPE(Matrix_ps), INTENT(IN) :: InputMat !> The inverse of that matrix. - TYPE(Matrix_ps), INTENT(INOUT) :: InverseMat + TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat !> Parameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Local Variables REAL(NTREAL) :: sigma TYPE(Matrix_ps) :: Temp1,Temp2,Identity TYPE(Matrix_ps) :: BalancedMat !! Temporary Variables - INTEGER :: outer_counter + INTEGER :: II REAL(NTREAL) :: norm_value TYPE(MatrixMemoryPool_p) :: pool !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Inverse Solver") CALL EnterSubLog CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("palser1998canonical") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF !! Construct All The Necessary Matrices - CALL ConstructEmptyMatrix(InverseMat, Mat) - CALL ConstructEmptyMatrix(Temp1, Mat) - CALL ConstructEmptyMatrix(Temp2, Mat) - CALL ConstructEmptyMatrix(Identity, Mat) - CALL ConstructEmptyMatrix(BalancedMat, Mat) + CALL ConstructEmptyMatrix(OutputMat, InputMat) + CALL ConstructEmptyMatrix(Temp1, InputMat) + CALL ConstructEmptyMatrix(Temp2, InputMat) + CALL ConstructEmptyMatrix(Identity, InputMat) + CALL ConstructEmptyMatrix(BalancedMat, InputMat) CALL FillMatrixIdentity(Identity) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) - CALL PermuteMatrix(Mat, BalancedMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) + CALL PermuteMatrix(InputMat, BalancedMat, & + & params%BalancePermutation, memorypool_in=pool) ELSE - CALL CopyMatrix(Mat,BalancedMat) + CALL CopyMatrix(InputMat, BalancedMat) END IF !! Compute Sigma - CALL MatrixSigma(BalancedMat,sigma) + CALL MatrixSigma(BalancedMat, sigma) !! Create Inverse Guess - CALL CopyMatrix(BalancedMat,InverseMat) - CALL ScaleMatrix(InverseMat,sigma) + CALL CopyMatrix(BalancedMat, OutputMat) + CALL ScaleMatrix(OutputMat, sigma) !! Iterate - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - outer_counter = 1 - norm_value = solver_parameters%converge_diff + 1.0_NTREAL - DO outer_counter = 1,solver_parameters%max_iterations - IF (solver_parameters%be_verbose .AND. outer_counter .GT. 1) THEN + II = 1 + norm_value = params%converge_diff + 1.0_NTREAL + DO II = 1, params%max_iterations + IF (params%be_verbose .AND. II .GT. 1) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) END IF - CALL MatrixMultiply(InverseMat,BalancedMat,Temp1, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + CALL MatrixMultiply(OutputMat, BalancedMat, Temp1, & + & threshold_in=params%threshold, memory_pool_in=pool) !! Check if Converged - CALL CopyMatrix(Identity,Temp2) - CALL IncrementMatrix(Temp1,Temp2,-1.0_NTREAL) + CALL CopyMatrix(Identity, Temp2) + CALL IncrementMatrix(Temp1, Temp2,-1.0_NTREAL) norm_value = MatrixNorm(Temp2) CALL DestructMatrix(Temp2) - CALL MatrixMultiply(Temp1,InverseMat,Temp2,alpha_in=-1.0_NTREAL, & - & threshold_in=solver_parameters%threshold,memory_pool_in=pool) + CALL MatrixMultiply(Temp1, OutputMat, Temp2, alpha_in=-1.0_NTREAL, & + & threshold_in=params%threshold, memory_pool_in=pool) !! Save a copy of the last inverse matrix - CALL CopyMatrix(InverseMat,Temp1) + CALL CopyMatrix(OutputMat, Temp1) - CALL ScaleMatrix(InverseMat,2.0_NTREAL) + CALL ScaleMatrix(OutputMat, 2.0_NTREAL) - CALL IncrementMatrix(Temp2,InverseMat, & - & threshold_in=solver_parameters%threshold) + CALL IncrementMatrix(Temp2, OutputMat, & + & threshold_in=params%threshold) - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. params%converge_diff) THEN EXIT END IF END DO - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=outer_counter-1) - CALL PrintMatrixInformation(InverseMat) + CALL WriteElement(key="Total_Iterations", VALUE=II-1) + CALL PrintMatrixInformation(OutputMat) END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN - CALL UndoPermuteMatrix(InverseMat,InverseMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + IF (params%do_load_balancing) THEN + CALL UndoPermuteMatrix(OutputMat, OutputMat, & + & params%BalancePermutation, memorypool_in=pool) END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF @@ -139,119 +141,152 @@ SUBROUTINE Invert(Mat, InverseMat, solver_parameters_in) CALL DestructMatrix(Temp2) CALL DestructMatrix(BalancedMat) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(params) END SUBROUTINE Invert +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the inverse of a matrix using the eigendecomposition. + SUBROUTINE DenseInvert(InputMat, OutputMat, solver_parameters_in) + !> The matrix to compute the pseudo inverse of. + TYPE(Matrix_ps), INTENT(IN) :: InputMat + !> The pseudoinverse of the input matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat + !> Parameters for the solver + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Handling Optional Parameters + TYPE(SolverParameters_t) :: params + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + + IF (params%be_verbose) THEN + CALL WriteHeader("Inverse Solver") + CALL EnterSubLog + END IF + + !! Apply + CALL DenseMatrixFunction(InputMat, OutputMat, InvertLambda, params) + + IF (params%be_verbose) THEN + CALL ExitSubLog + END IF + + !! Cleanup + CALL DestructSolverParameters(params) + END SUBROUTINE DenseInvert !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the pseudoinverse of a matrix. !> An implementation of the method of Hotelling \cite palser1998canonical. - SUBROUTINE PseudoInverse(Mat, InverseMat, solver_parameters_in) + SUBROUTINE PseudoInverse(InputMat, OutputMat, solver_parameters_in) !> The matrix to compute the pseudo inverse of. - TYPE(Matrix_ps), INTENT(IN) :: Mat + TYPE(Matrix_ps), INTENT(IN) :: InputMat !> The pseudoinverse of the input matrix. - TYPE(Matrix_ps), INTENT(INOUT) :: InverseMat + TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat !> Parameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Local Variables REAL(NTREAL) :: sigma TYPE(Matrix_ps) :: Temp1,Temp2,Identity TYPE(Matrix_ps) :: BalancedMat !! Temporary Variables - INTEGER :: outer_counter + INTEGER :: II REAL(NTREAL) :: norm_value TYPE(MatrixMemoryPool_p) :: pool !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Inverse Solver") CALL EnterSubLog CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("palser1998canonical") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF !! Construct All The Necessary Matrices - CALL ConstructEmptyMatrix(InverseMat, Mat) - CALL ConstructEmptyMatrix(Temp1, Mat) - CALL ConstructEmptyMatrix(Temp2, Mat) - CALL ConstructEmptyMatrix(Identity, Mat) - CALL ConstructEmptyMatrix(BalancedMat, Mat) + CALL ConstructEmptyMatrix(OutputMat, InputMat) + CALL ConstructEmptyMatrix(Temp1, InputMat) + CALL ConstructEmptyMatrix(Temp2, InputMat) + CALL ConstructEmptyMatrix(Identity, InputMat) + CALL ConstructEmptyMatrix(BalancedMat, InputMat) CALL FillMatrixIdentity(Identity) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) - CALL PermuteMatrix(Mat, BalancedMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) + CALL PermuteMatrix(InputMat, BalancedMat, & + & params%BalancePermutation, memorypool_in=pool) ELSE - CALL CopyMatrix(Mat,BalancedMat) + CALL CopyMatrix(InputMat, BalancedMat) END IF !! Compute Sigma - CALL MatrixSigma(BalancedMat,sigma) + CALL MatrixSigma(BalancedMat, sigma) !! Create Inverse Guess - CALL CopyMatrix(BalancedMat,InverseMat) - CALL ScaleMatrix(InverseMat,sigma) + CALL CopyMatrix(BalancedMat, OutputMat) + CALL ScaleMatrix(OutputMat, sigma) !! Iterate - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - outer_counter = 1 - norm_value = solver_parameters%converge_diff + 1.0_NTREAL - DO outer_counter = 1,solver_parameters%max_iterations - IF (solver_parameters%be_verbose .AND. outer_counter .GT. 1) THEN + II = 1 + norm_value = params%converge_diff + 1.0_NTREAL + DO II = 1,params%max_iterations + IF (params%be_verbose .AND. II .GT. 1) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) END IF - CALL MatrixMultiply(InverseMat,BalancedMat,Temp1, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) - CALL MatrixMultiply(Temp1,InverseMat,Temp2,alpha_in=-1.0_NTREAL, & - & threshold_in=solver_parameters%threshold,memory_pool_in=pool) + CALL MatrixMultiply(OutputMat, BalancedMat, Temp1, & + & threshold_in=params%threshold, memory_pool_in=pool) + CALL MatrixMultiply(Temp1, OutputMat, Temp2,alpha_in=-1.0_NTREAL, & + & threshold_in=params%threshold,memory_pool_in=pool) !! Save a copy of the last inverse matrix - CALL CopyMatrix(InverseMat,Temp1) + CALL CopyMatrix(OutputMat, Temp1) - CALL ScaleMatrix(InverseMat,2.0_NTREAL) - CALL IncrementMatrix(Temp2,InverseMat, & - & threshold_in=solver_parameters%threshold) + CALL ScaleMatrix(OutputMat, 2.0_NTREAL) + CALL IncrementMatrix(Temp2, OutputMat, & + & threshold_in=params%threshold) !! Check if Converged - CALL IncrementMatrix(InverseMat,Temp1,-1.0_NTREAL) + CALL IncrementMatrix(OutputMat, Temp1, -1.0_NTREAL) norm_value = MatrixNorm(Temp1) !! Sometimes the first few values don't change so much, so that's why !! I added the outer counter check - IF (norm_value .LE. solver_parameters%converge_diff .AND. & - & outer_counter .GT. 3) THEN + IF (norm_value .LE. params%converge_diff .AND. II .GT. 3) THEN EXIT END IF END DO - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=outer_counter-1) - CALL PrintMatrixInformation(InverseMat) + CALL WriteElement(key="Total_Iterations", VALUE=II-1) + CALL PrintMatrixInformation(OutputMat) END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN - CALL UndoPermuteMatrix(InverseMat,InverseMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + IF (params%do_load_balancing) THEN + CALL UndoPermuteMatrix(OutputMat, OutputMat, & + & params%BalancePermutation, memorypool_in=pool) END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF @@ -260,7 +295,15 @@ SUBROUTINE PseudoInverse(Mat, InverseMat, solver_parameters_in) CALL DestructMatrix(Temp2) CALL DestructMatrix(BalancedMat) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(params) END SUBROUTINE PseudoInverse +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Prototypical inversion for mapping. + FUNCTION InvertLambda(val) RESULT(outval) + REAL(KIND=NTREAL), INTENT(IN) :: val + REAL(KIND=NTREAL) :: outval + + outval = 1.0 / val + END FUNCTION InvertLambda !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE InverseSolversModule diff --git a/Source/Fortran/LinearSolversModule.F90 b/Source/Fortran/LinearSolversModule.F90 index 6e3dd333..7fb083b9 100644 --- a/Source/Fortran/LinearSolversModule.F90 +++ b/Source/Fortran/LinearSolversModule.F90 @@ -38,7 +38,7 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) !> Parameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Local Variables TYPE(Matrix_ps) :: Identity TYPE(Matrix_ps) :: ABalanced @@ -47,24 +47,24 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) TYPE(Matrix_ps) :: RMatT, PMatT TYPE(Matrix_ps) :: TempMat !! Temporary Variables - INTEGER :: outer_counter + INTEGER :: II REAL(NTREAL) :: norm_value TYPE(MatrixMemoryPool_p) :: pool REAL(NTREAL) :: top, bottom, new_top, step_size !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF !! Print out parameters - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Linear Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="CG") - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF !! Setup all the matrices @@ -78,13 +78,13 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) CALL ConstructEmptyMatrix(TempMat, AMat) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) CALL PermuteMatrix(AMat, ABalanced, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) CALL PermuteMatrix(BMat, BBalanced, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) ELSE CALL CopyMatrix(AMat,ABalanced) CALL CopyMatrix(BMat,BBalanced) @@ -94,42 +94,42 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) CALL CopyMatrix(Identity, XMat) !! Compute residual CALL MatrixMultiply(ABalanced, Xmat, TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL CopyMatrix(BBalanced,RMat) CALL IncrementMatrix(TempMat, RMat, -1.0_NTREAL) CALL CopyMatrix(RMat,PMat) !! Iterate - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - norm_value = solver_parameters%converge_diff + 1.0_NTREAL - DO outer_counter = 1,solver_parameters%max_iterations - IF (solver_parameters%be_verbose .AND. outer_counter .GT. 1) THEN + norm_value = params%converge_diff + 1.0_NTREAL + DO II = 1, params%max_iterations + IF (params%be_verbose .AND. II .GT. 1) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) END IF - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. params%converge_diff) THEN EXIT END IF !! Compute the Step Size CALL MatrixMultiply(ABalanced, PMat, QMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL TransposeMatrix(RMat,RMatT) IF (RMatT%is_complex) THEN CALL ConjugateMatrix(RMatT) END IF CALL MatrixMultiply(RMatT, RMat, TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL MatrixTrace(TempMat, top) CALL TransposeMatrix(PMat,PMatT) IF (PMatT%is_complex) THEN CALL ConjugateMatrix(PMatT) END IF CALL MatrixMultiply(PMatT, QMat, TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL MatrixTrace(TempMat, bottom) step_size = top/bottom @@ -144,27 +144,27 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) CALL ConjugateMatrix(RMatT) END IF CALL MatrixMultiply(RMatT, RMat, TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL MatrixTrace(TempMat, new_top) step_size = new_top / top CALL ScaleMatrix(PMat, step_size) CALL IncrementMatrix(RMat, PMat) END DO - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=outer_counter-1) + CALL WriteElement(key="Total_Iterations", VALUE=II-1) CALL PrintMatrixInformation(XMat) END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(XMat,XMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructMatrix(TempMat) @@ -175,7 +175,7 @@ SUBROUTINE CGSolver(AMat, XMat, BMat, solver_parameters_in) CALL DestructMatrix(ABalanced) CALL DestructMatrix(BBalanced) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(params) END SUBROUTINE CGSolver !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute The Cholesky Decomposition of a Hermitian Positive Definite matrix. @@ -188,7 +188,7 @@ SUBROUTINE CholeskyDecomposition(AMat, LMat, solver_parameters_in) !> Parameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Local Variables TYPE(Matrix_lsr) :: sparse_a TYPE(Matrix_ldr) :: dense_a @@ -208,17 +208,17 @@ SUBROUTINE CholeskyDecomposition(AMat, LMat, solver_parameters_in) !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF !! Print out parameters - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Linear Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="Cholesky Decomposition") - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF CALL ConstructEmptyMatrix(LMat, AMat) @@ -287,7 +287,7 @@ SUBROUTINE CholeskyDecomposition(AMat, LMat, solver_parameters_in) local_row = JJ - AMat%start_row + 1 Aval = dense_a%DATA(local_row, local_II) insert_value = inverse_factor * (Aval - dot_values(local_II)) - IF (ABS(insert_value) .GT. solver_parameters%threshold) THEN + IF (ABS(insert_value) .GT. params%threshold) THEN CALL AppendToVector(values_per_column_l(local_II), & & index_l(:,local_II), values_l(:, local_II), & & local_row, insert_value) @@ -300,7 +300,7 @@ SUBROUTINE CholeskyDecomposition(AMat, LMat, solver_parameters_in) CALL UnpackCholesky(values_per_column_l, index_l, values_l, LMat) !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL PrintMatrixInformation(LMat) CALL ExitSubLog END IF @@ -313,6 +313,7 @@ SUBROUTINE CholeskyDecomposition(AMat, LMat, solver_parameters_in) DEALLOCATE(dot_values) DEALLOCATE(col_root_lookup) CALL DestructMatrix(sparse_a) + CALL DestructSolverParameters(params) END SUBROUTINE CholeskyDecomposition !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE LinearSolversModule diff --git a/Source/Fortran/PSMatrixModule.F90 b/Source/Fortran/PSMatrixModule.F90 index 93ca0bc1..b348a761 100644 --- a/Source/Fortran/PSMatrixModule.F90 +++ b/Source/Fortran/PSMatrixModule.F90 @@ -1739,7 +1739,7 @@ END SUBROUTINE ResizeMatrix_psc !> still be replicated across slices. SUBROUTINE GatherMatrixToProcess_psr_id(this, local_mat, within_slice_id) !> The matrix to gather. - TYPE(Matrix_ps), INTENT(INOUT) :: this + TYPE(Matrix_ps), INTENT(IN) :: this !> The full matrix, stored in a local matrix. TYPE(Matrix_lsr), INTENT(INOUT) :: local_mat !> Which process to gather on. @@ -1755,7 +1755,7 @@ END SUBROUTINE GatherMatrixToProcess_psr_id !> every process. SUBROUTINE GatherMatrixToProcess_psr_all(this, local_mat) !> The matrix to gather. - TYPE(Matrix_ps), INTENT(INOUT) :: this + TYPE(Matrix_ps), INTENT(IN) :: this !> The full matrix, stored in a local matrix. TYPE(Matrix_lsr), INTENT(INOUT) :: local_mat !! Local Variables @@ -1772,7 +1772,7 @@ END SUBROUTINE GatherMatrixToProcess_psr_all !> still be replicated across slices. SUBROUTINE GatherMatrixToProcess_psc_id(this, local_mat, within_slice_id) !> The matrix to gather. - TYPE(Matrix_ps), INTENT(INOUT) :: this + TYPE(Matrix_ps), INTENT(IN) :: this !> The full matrix, stored in a local matrix. TYPE(Matrix_lsc), INTENT(INOUT) :: local_mat !> Which process to gather on. @@ -1788,7 +1788,7 @@ END SUBROUTINE GatherMatrixToProcess_psc_id !> every process. SUBROUTINE GatherMatrixToProcess_psc_all(this, local_mat) !> The matrix to gather. - TYPE(Matrix_ps), INTENT(INOUT) :: this + TYPE(Matrix_ps), INTENT(IN) :: this !> The full matrix, stored in a local matrix. TYPE(Matrix_lsc), INTENT(INOUT) :: local_mat !! Local Variables diff --git a/Source/Fortran/PolynomialSolversModule.F90 b/Source/Fortran/PolynomialSolversModule.F90 index 58b7cd22..2ba22f10 100644 --- a/Source/Fortran/PolynomialSolversModule.F90 +++ b/Source/Fortran/PolynomialSolversModule.F90 @@ -89,29 +89,29 @@ SUBROUTINE Compute_stand(InputMat, OutputMat, poly, solver_parameters_in) !> Parameters for the solver. TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Local Variables TYPE(Matrix_ps) :: Identity TYPE(Matrix_ps) :: BalancedInput TYPE(Matrix_ps) :: Temporary INTEGER :: degree - INTEGER :: counter + INTEGER :: II TYPE(MatrixMemoryPool_p) :: pool !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF degree = SIZE(poly%coefficients) - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Polynomial Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="Horner") - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) CALL WriteElement(key="Degree", VALUE=degree-1) END IF @@ -119,16 +119,16 @@ SUBROUTINE Compute_stand(InputMat, OutputMat, poly, solver_parameters_in) CALL ConstructEmptyMatrix(Identity, InputMat) CALL FillMatrixIdentity(Identity) CALL ConstructEmptyMatrix(Temporary, InputMat) - CALL CopyMatrix(InputMat,BalancedInput) + CALL CopyMatrix(InputMat, BalancedInput) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) CALL PermuteMatrix(BalancedInput, BalancedInput, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF - CALL CopyMatrix(Identity,OutputMat) + CALL CopyMatrix(Identity, OutputMat) IF (SIZE(poly%coefficients) .EQ. 1) THEN CALL ScaleMatrix(OutputMat, poly%coefficients(degree)) @@ -136,29 +136,29 @@ SUBROUTINE Compute_stand(InputMat, OutputMat, poly, solver_parameters_in) CALL ScaleMatrix(OutputMat,poly%coefficients(degree-1)) CALL IncrementMatrix(BalancedInput,OutputMat, & & poly%coefficients(degree)) - DO counter = degree-2,1,-1 + DO II = degree-2, 1, -1 CALL MatrixMultiply(BalancedInput,OutputMat,Temporary, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL CopyMatrix(Temporary,OutputMat) CALL IncrementMatrix(Identity, & - & OutputMat, alpha_in=poly%coefficients(counter)) + & OutputMat, alpha_in=poly%coefficients(II)) END DO END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructMatrix(Temporary) CALL DestructMatrix(Identity) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(params) END SUBROUTINE Compute_stand !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute A Matrix Polynomial Using The Paterson and Stockmeyer method. @@ -175,7 +175,7 @@ SUBROUTINE FactorizedCompute_stand(InputMat, OutputMat, poly, & !> Parameters for the solver. TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Local Variables TYPE(Matrix_ps) :: Identity TYPE(Matrix_ps), DIMENSION(:), ALLOCATABLE :: x_powers @@ -185,15 +185,15 @@ SUBROUTINE FactorizedCompute_stand(InputMat, OutputMat, poly, & INTEGER :: degree INTEGER :: m_value, s_value, r_value INTEGER :: k_value - INTEGER :: counter + INTEGER :: II INTEGER :: c_index TYPE(MatrixMemoryPool_p) :: pool !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF !! Parameters for splitting up polynomial. @@ -202,7 +202,7 @@ SUBROUTINE FactorizedCompute_stand(InputMat, OutputMat, poly, & s_value = INT(SQRT(REAL(m_value))) r_value = m_value/s_value - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Polynomial Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="Paterson Stockmeyer") @@ -210,7 +210,7 @@ SUBROUTINE FactorizedCompute_stand(InputMat, OutputMat, poly, & CALL EnterSubLog CALL WriteListElement("paterson1973number") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) CALL WriteElement(key="Degree", VALUE=degree-1) END IF @@ -223,8 +223,8 @@ SUBROUTINE FactorizedCompute_stand(InputMat, OutputMat, poly, & !! Create the X Powers CALL ConstructEmptyMatrix(x_powers(1), InputMat) CALL FillMatrixIdentity(x_powers(1)) - DO counter=1,s_value+1-1 - CALL MatrixMultiply(InputMat,x_powers(counter-1+1),x_powers(counter+1),& + DO II = 1, s_value+1-1 + CALL MatrixMultiply(InputMat,x_powers(II-1+1),x_powers(II+1),& & memory_pool_in=pool) END DO CALL CopyMatrix(x_powers(s_value+1),Xs) @@ -232,20 +232,20 @@ SUBROUTINE FactorizedCompute_stand(InputMat, OutputMat, poly, & !! S_k = bmX CALL CopyMatrix(Identity,Bk) CALL ScaleMatrix(Bk, poly%coefficients(s_value*r_value+1)) - DO counter=1,m_value-s_value*r_value+1-1 - c_index = s_value*r_value + counter - CALL IncrementMatrix(x_powers(counter+1),Bk, & + DO II = 1, m_value-s_value*r_value+1-1 + c_index = s_value*r_value + II + CALL IncrementMatrix(x_powers(II+1),Bk, & & alpha_in=poly%coefficients(c_index+1)) END DO - CALL MatrixMultiply(Bk,Xs,OutputMat, memory_pool_in=pool) + CALL MatrixMultiply(Bk, Xs, OutputMat, memory_pool_in=pool) !! S_k += bmx + bm-1I k_value = r_value - 1 - CALL CopyMatrix(Identity,Bk) - CALL ScaleMatrix(Bk,poly%coefficients(s_value*k_value+1)) - DO counter=1,s_value-1+1-1 - c_index = s_value*k_value + counter - CALL IncrementMatrix(x_powers(counter+1),Bk, & + CALL CopyMatrix(Identity, Bk) + CALL ScaleMatrix(Bk, poly%coefficients(s_value*k_value+1)) + DO II = 1, s_value-1+1-1 + c_index = s_value*k_value + II + CALL IncrementMatrix(x_powers(II+1),Bk, & & alpha_in=poly%coefficients(c_index+1)) END DO CALL IncrementMatrix(Bk,OutputMat) @@ -253,11 +253,10 @@ SUBROUTINE FactorizedCompute_stand(InputMat, OutputMat, poly, & !! Loop over the rest. DO k_value=r_value-2,-1+1,-1 CALL CopyMatrix(Identity,Bk) - CALL ScaleMatrix(Bk, & - & poly%coefficients(s_value*k_value+1)) - DO counter=1,s_value-1+1-1 - c_index = s_value*k_value + counter - CALL IncrementMatrix(x_powers(counter+1),Bk, & + CALL ScaleMatrix(Bk, poly%coefficients(s_value*k_value+1)) + DO II=1,s_value-1+1-1 + c_index = s_value*k_value + II + CALL IncrementMatrix(x_powers(II+1),Bk, & & alpha_in=poly%coefficients(c_index+1)) END DO CALL MatrixMultiply(Xs,OutputMat,Temp) @@ -266,18 +265,18 @@ SUBROUTINE FactorizedCompute_stand(InputMat, OutputMat, poly, & END DO !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF - DO counter=1,s_value+1 - CALL DestructMatrix(x_powers(counter)) + DO II = 1, s_value+1 + CALL DestructMatrix(x_powers(II)) END DO DEALLOCATE(x_powers) CALL DestructMatrix(Bk) CALL DestructMatrix(Xs) CALL DestructMatrix(Temp) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(params) END SUBROUTINE FactorizedCompute_stand !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE PolynomialSolversModule diff --git a/Source/Fortran/RootSolversModule.F90 b/Source/Fortran/RootSolversModule.F90 index cc6eefd4..bb04c846 100644 --- a/Source/Fortran/RootSolversModule.F90 +++ b/Source/Fortran/RootSolversModule.F90 @@ -37,54 +37,53 @@ RECURSIVE SUBROUTINE ComputeRoot(InputMat, OutputMat, root, & !> Parameters for the solver TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Local Variables TYPE(Matrix_ps) :: TempMat !! Handle The Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Root Solver") CALL EnterSubLog CALL WriteElement(key="Root", VALUE=root) - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF !! Handle base cases, or call to general implementation. IF (root .EQ. 1) THEN CALL CopyMatrix(InputMat, OutputMat) ELSE IF (root .EQ. 2) THEN - CALL SquareRoot(InputMat, OutputMat, solver_parameters) + CALL SquareRoot(InputMat, OutputMat, params) ELSE IF (root .EQ. 3) THEN CALL MatrixMultiply(InputMat, InputMat, TempMat, & - & threshold_in=solver_parameters%threshold) + & threshold_in=params%threshold) CALL ComputeRootImplementation(TempMat, OutputMat, 6, & - & solver_parameters) + & params) ELSE IF (root .EQ. 4) THEN - CALL SquareRoot(InputMat, TempMat, solver_parameters) - CALL SquareRoot(TempMat, OutputMat, solver_parameters) + CALL SquareRoot(InputMat, TempMat, params) + CALL SquareRoot(TempMat, OutputMat, params) CALL DestructMatrix(TempMat) ELSE CALL ComputeRootImplementation(InputMat, OutputMat, root, & - & solver_parameters) + & params) END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(params) END SUBROUTINE ComputeRoot !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Actual implementation of computing a general matrix root. - SUBROUTINE ComputeRootImplementation(InputMat, OutputMat, root, & - & solver_parameters) + SUBROUTINE ComputeRootImplementation(InputMat, OutputMat, root, params) !> The input matrix TYPE(Matrix_ps), INTENT(IN) :: InputMat !> OutputMat = InputMat^1/root. @@ -92,38 +91,29 @@ SUBROUTINE ComputeRootImplementation(InputMat, OutputMat, root, & !> Which root to compute. INTEGER, INTENT(IN) :: root !> Parameters for the solver - TYPE(SolverParameters_t), INTENT(IN) :: solver_parameters - !! Handling Solver Parameters - TYPE(SolverParameters_t) :: fixed_parameters + TYPE(SolverParameters_t), INTENT(IN) :: params !! Local Variables TYPE(Matrix_ps) :: RaisedMat TYPE(Matrix_ps) :: TempMat TYPE(Polynomial_t) :: power_poly - INTEGER :: counter - - !! Set up the solver parameters - fixed_parameters%threshold = solver_parameters%threshold - fixed_parameters%be_verbose = solver_parameters%be_verbose - fixed_parameters%do_load_balancing = solver_parameters%do_load_balancing - fixed_parameters%BalancePermutation = solver_parameters%BalancePermutation + INTEGER :: II !! We will use the formula A^(1/x) = A*A^(1/x - 1) !! So first, we raise to the root-1 power - CALL ConstructPolynomial(power_poly,root) - DO counter=1,root-1 - CALL SetCoefficient(power_poly,counter,REAL(0.0,NTREAL)) + CALL ConstructPolynomial(power_poly, root) + DO II = 1, root-1 + CALL SetCoefficient(power_poly, II, REAL(0.0,NTREAL)) END DO - CALL SetCoefficient(power_poly,root,REAL(1.0,NTREAL)) - CALL FactorizedCompute(InputMat, RaisedMat, power_poly, & - & fixed_parameters) + CALL SetCoefficient(power_poly, root, REAL(1.0,NTREAL)) + CALL FactorizedCompute(InputMat, RaisedMat, power_poly, params) CALL DestructPolynomial(power_poly) !! Now compute the inverse pth root - CALL ComputeInverseRoot(RaisedMat, TempMat, root, solver_parameters) + CALL ComputeInverseRoot(RaisedMat, TempMat, root, params) !! Multiply by the original matrix CALL MatrixMultiply(InputMat, TempMat, OutputMat, & - & threshold_in=solver_parameters%threshold) + & threshold_in=params%threshold) !! Cleanup CALL DestructMatrix(RaisedMat) @@ -142,52 +132,50 @@ RECURSIVE SUBROUTINE ComputeInverseRoot(InputMat, OutputMat, root, & !> Parameters for the solver. TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Local Variables TYPE(Matrix_ps) :: TempMat !! Handle The Optional Parameters !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Inverse Root Solver") CALL EnterSubLog CALL WriteElement(key="Root", VALUE=root) - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF !! Handle base cases, or call to general implementation. IF (root .EQ. 1) THEN - CALL Invert(InputMat, OutputMat, solver_parameters) + CALL Invert(InputMat, OutputMat, params) ELSE IF (root .EQ. 2) THEN - CALL InverseSquareRoot(InputMat, OutputMat, solver_parameters) + CALL InverseSquareRoot(InputMat, OutputMat, params) ELSE IF (root .EQ. 3) THEN - CALL ComputeRoot(InputMat,TempMat,3,solver_parameters) - CALL Invert(TempMat, OutputMat, solver_parameters) + CALL ComputeRoot(InputMat,TempMat,3, params) + CALL Invert(TempMat, OutputMat, params) ELSE IF (root .EQ. 4) THEN - CALL SquareRoot(InputMat, TempMat, solver_parameters) - CALL InverseSquareRoot(TempMat, OutputMat, solver_parameters) + CALL SquareRoot(InputMat, TempMat, params) + CALL InverseSquareRoot(TempMat, OutputMat, params) CALL DestructMatrix(TempMat) ELSE - CALL ComputeInverseRootImplemention(InputMat, OutputMat, root, & - & solver_parameters) + CALL ComputeInverseRootImplemention(InputMat, OutputMat, root, params) END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(params) END SUBROUTINE ComputeInverseRoot !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute a general inverse matrix root for root > 4. - SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, & - & solver_parameters_in) + SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, params) !> Matrix to compute the root of. TYPE(Matrix_ps), INTENT(IN) :: InputMat !> The inverse nth root of that matrix. @@ -195,11 +183,9 @@ SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, & !> Which inverse root to compute. INTEGER, INTENT(IN) :: root !> Parameters for the solver. - TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + TYPE(SolverParameters_t), INTENT(IN) :: params !! Constants. REAL(NTREAL), PARAMETER :: NEGATIVE_ONE = -1.0 - !! Handling Solver Parameters - TYPE(SolverParameters_t) :: solver_parameters !! Local Matrices TYPE(Matrix_ps) :: SqrtMat, FthrtMat TYPE(Matrix_ps) :: IdentityMat @@ -214,26 +200,18 @@ SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, & REAL(NTREAL) :: scaling_factor REAL(NTREAL) :: norm_value !! Temporary Variables - INTEGER :: outer_counter - INTEGER :: inner_counter + INTEGER :: II + INTEGER :: JJ TYPE(MatrixMemoryPool_p) :: pool - !! Handle The Optional Parameters - !! Optional Parameters - IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in - ELSE - solver_parameters = SolverParameters_t() - END IF - - IF (solver_parameters_in%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Root Solver") CALL EnterSubLog CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("nicholas2008functions") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF !! Compute The Scaling Factor @@ -253,8 +231,8 @@ SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, & !! Initialize !! Fourth Root Matrix - CALL SquareRoot(InputMat, SqrtMat, solver_parameters) - CALL SquareRoot(SqrtMat, FthrtMat, solver_parameters) + CALL SquareRoot(InputMat, SqrtMat, params) + CALL SquareRoot(SqrtMat, FthrtMat, params) CALL DestructMatrix(SqrtMat) !! Setup the Matrices @@ -262,11 +240,11 @@ SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, & CALL FillMatrixIdentity(IdentityMat) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(FthrtMat, FthrtMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) CALL PermuteMatrix(IdentityMat, IdentityMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF CALL CopyMatrix(IdentityMat, OutputMat) @@ -280,14 +258,14 @@ SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, & CALL ConstructEmptyMatrix(IntermediateMatP, InputMat) CALL ConstructEmptyMatrix(Temp, InputMat) - outer_counter = 1 - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - norm_value = solver_parameters%converge_diff + 1.0_NTREAL - DO outer_counter = 1,solver_parameters%max_iterations - IF (solver_parameters%be_verbose .AND. outer_counter .GT. 1) THEN + II = 1 + norm_value = params%converge_diff + 1.0_NTREAL + DO II = 1, params%max_iterations + IF (params%be_verbose .AND. II .GT. 1) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) END IF @@ -300,53 +278,53 @@ SUBROUTINE ComputeInverseRootImplemention(InputMat, OutputMat, root, & & REAL(1.0,NTREAL)/target_root) CALL MatrixMultiply(OutputMat, IntermediateMat, Temp, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL CopyMatrix(Temp, OutputMat) CALL CopyMatrix(IntermediateMat, IntermediateMatP) - DO inner_counter = 1, target_root-1 + DO JJ = 1, target_root-1 CALL MatrixMultiply(IntermediateMat, IntermediateMatP, Temp, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL CopyMatrix(Temp, IntermediateMatP) END DO CALL MatrixMultiply(IntermediateMatP, Mk, Temp, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL CopyMatrix(Temp, Mk) CALL IncrementMatrix(IdentityMat, Temp, & & alpha_in=NEGATIVE_ONE) norm_value = MatrixNorm(Temp) - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. params%converge_diff) THEN EXIT END IF END DO - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=outer_counter-1) + CALL WriteElement(key="Total_Iterations", VALUE=II-1) CALL PrintMatrixInformation(OutputMat) END IF IF (MOD(root,4) .EQ. 1 .OR. MOD(root,4) .EQ. 3) THEN CALL MatrixMultiply(OutputMat, OutputMat, Temp, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL MatrixMultiply(Temp, Temp, OutputMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) ELSE IF (MOD(root,4) .NE. 0) THEN CALL MatrixMultiply(OutputMat, OutputMat, Temp, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL CopyMatrix(Temp, OutputMat) END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF !! Cleanup - IF (solver_parameters_in%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructMatrix(IdentityMat) diff --git a/Source/Fortran/SignSolversModule.F90 b/Source/Fortran/SignSolversModule.F90 index b5a8e4ad..8a6cb24a 100644 --- a/Source/Fortran/SignSolversModule.F90 +++ b/Source/Fortran/SignSolversModule.F90 @@ -3,6 +3,7 @@ MODULE SignSolversModule USE DataTypesModule, ONLY : NTREAL USE EigenBoundsModule, ONLY : GershgorinBounds + USE EigenSolversModule, ONLY : DenseMatrixFunction USE LoadBalancerModule, ONLY : PermuteMatrix, UndoPermuteMatrix USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteHeader, & & WriteListElement, WriteElement @@ -19,50 +20,82 @@ MODULE SignSolversModule PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: SignFunction + PUBLIC :: DenseSignFunction PUBLIC :: PolarDecomposition CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Computes the matrix sign function. - SUBROUTINE SignFunction(Mat, SignMat, solver_parameters_in) + SUBROUTINE SignFunction(InMat, OutMat, solver_parameters_in) !> The input matrix. - TYPE(Matrix_ps), INTENT(IN) :: Mat + TYPE(Matrix_ps), INTENT(IN) :: InMat !> The sign of Mat. - TYPE(Matrix_ps), INTENT(INOUT) :: SignMat + TYPE(Matrix_ps), INTENT(INOUT) :: OutMat !> Parameters for the solver. TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Sign Function Solver") CALL EnterSubLog CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("nicholas2008functions") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF - CALL CoreComputation(Mat, SignMat, solver_parameters, .FALSE.) + CALL CoreComputation(InMat, OutMat, params, .FALSE.) !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(params) END SUBROUTINE SignFunction +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Computes the matrix sign function (dense version). + SUBROUTINE DenseSignFunction(InMat, OutputMat, solver_parameters_in) + !> The matrix to compute the sign of. + TYPE(Matrix_ps), INTENT(IN) :: InMat + !> The sign of the input matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat + !> Parameters for the solver + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Handling Optional Parameters + TYPE(SolverParameters_t) :: params + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + + IF (params%be_verbose) THEN + CALL WriteHeader("Sign Function Solver") + CALL EnterSubLog + END IF + + !! Apply + CALL DenseMatrixFunction(InMat, OutputMat, SignLambda, params) + + IF (params%be_verbose) THEN + CALL ExitSubLog + END IF + END SUBROUTINE DenseSignFunction !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Computes the polar decomposition of a matrix Mat = U*H. - SUBROUTINE PolarDecomposition(Mat, Umat, Hmat, solver_parameters_in) + SUBROUTINE PolarDecomposition(InMat, Umat, Hmat, solver_parameters_in) !> The input matrix. - TYPE(Matrix_ps), INTENT(IN) :: Mat + TYPE(Matrix_ps), INTENT(IN) :: InMat !> The unitary polar factor. TYPE(Matrix_ps), INTENT(INOUT) :: Umat !> The hermitian matrix factor. @@ -70,55 +103,55 @@ SUBROUTINE PolarDecomposition(Mat, Umat, Hmat, solver_parameters_in) !> Parameters for the solver. TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params TYPE(Matrix_ps) :: UmatT !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Polar Decomposition Solver") CALL EnterSubLog CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("nicholas2008functions") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF - CALL CoreComputation(Mat, Umat, solver_parameters, .TRUE.) + CALL CoreComputation(InMat, Umat, params, .TRUE.) IF (PRESENT(Hmat)) THEN CALL TransposeMatrix(Umat, UmatT) IF (UmatT%is_complex) THEN CALL ConjugateMatrix(UmatT) END IF - CALL MatrixMultiply(UmatT, Mat, Hmat, & - & threshold_in=solver_parameters%threshold) + CALL MatrixMultiply(UmatT, InMat, Hmat, & + & threshold_in=params%threshold) CALL DestructMatrix(UmatT) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(params) END SUBROUTINE PolarDecomposition !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> This is the implementation routine for both the sign function and !> polar decomposition. - SUBROUTINE CoreComputation(Mat, OutMat, solver_parameters, needs_transpose) + SUBROUTINE CoreComputation(InMat, OutMat, params, needs_transpose) !> The matrix to compute. - TYPE(Matrix_ps), INTENT(IN) :: Mat + TYPE(Matrix_ps), INTENT(IN) :: InMat !> Output of the routine. TYPE(Matrix_ps), INTENT(INOUT) :: OutMat !> Parameters for the solver. - TYPE(SolverParameters_t), INTENT(IN) :: solver_parameters + TYPE(SolverParameters_t), INTENT(IN) :: params !> Whether we need to perform transposes in this routine (for polar). LOGICAL, INTENT(IN) :: needs_transpose !! Local Matrices @@ -133,39 +166,39 @@ SUBROUTINE CoreComputation(Mat, OutMat, solver_parameters, needs_transpose) REAL(NTREAL) :: alpha_k REAL(NTREAL) :: xk REAL(NTREAL) :: norm_value - INTEGER :: outer_counter + INTEGER :: II !! Construct All The Necessary Matrices - CALL ConstructEmptyMatrix(Identity, Mat) - CALL ConstructEmptyMatrix(Temp1, Mat) - CALL ConstructEmptyMatrix(Temp2, Mat) + CALL ConstructEmptyMatrix(Identity, InMat) + CALL ConstructEmptyMatrix(Temp1, InMat) + CALL ConstructEmptyMatrix(Temp2, InMat) CALL FillMatrixIdentity(Identity) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN !! Permute Matrices CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=pool) - CALL PermuteMatrix(Mat, OutMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) + CALL PermuteMatrix(InMat, OutMat, & + & params%BalancePermutation, memorypool_in=pool) ELSE - CALL CopyMatrix(Mat,OutMat) + CALL CopyMatrix(InMat, OutMat) END IF !! Initialize - CALL GershgorinBounds(Mat,e_min,e_max) + CALL GershgorinBounds(InMat, e_min, e_max) xk = ABS(e_min/e_max) - CALL ScaleMatrix(OutMat,1.0_NTREAL/ABS(e_max)) + CALL ScaleMatrix(OutMat, 1.0_NTREAL/ABS(e_max)) !! Iterate. - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - outer_counter = 1 - norm_value = solver_parameters%converge_diff + 1.0_NTREAL - iterate: DO outer_counter = 1,solver_parameters%max_iterations - IF (solver_parameters%be_verbose .AND. outer_counter .GT. 1) THEN + II = 1 + norm_value = params%converge_diff + 1.0_NTREAL + iterate: DO II = 1, params%max_iterations + IF (params%be_verbose .AND. II .GT. 1) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) END IF @@ -180,35 +213,35 @@ SUBROUTINE CoreComputation(Mat, OutMat, solver_parameters, needs_transpose) END IF CALL MatrixMultiply(OutMatT, OutMat, Temp1, & & alpha_in=-1.0_NTREAL*alpha_k**2, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) ELSE CALL MatrixMultiply(OutMat, OutMat, Temp1, & & alpha_in=-1.0_NTREAL*alpha_k**2, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) END IF - CALL IncrementMatrix(Identity,Temp1,alpha_in=3.0_NTREAL) + CALL IncrementMatrix(Identity, Temp1, alpha_in=3.0_NTREAL) CALL MatrixMultiply(OutMat, Temp1, Temp2, alpha_in=0.5_NTREAL*alpha_k, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + & threshold_in=params%threshold, memory_pool_in=pool) CALL IncrementMatrix(Temp2, OutMat, alpha_in=-1.0_NTREAL) norm_value = MatrixNorm(OutMat) - CALL CopyMatrix(Temp2,OutMat) + CALL CopyMatrix(Temp2, OutMat) - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. params%converge_diff) THEN EXIT END IF END DO iterate - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations",VALUE=outer_counter-1) + CALL WriteElement(key="Total_Iterations", VALUE=II-1) CALL PrintMatrixInformation(OutMat) END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutMat,OutMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF CALL DestructMatrix(Temp1) @@ -217,5 +250,17 @@ SUBROUTINE CoreComputation(Mat, OutMat, solver_parameters, needs_transpose) CALL DestructMatrix(Identity) CALL DestructMatrixMemoryPool(pool) END SUBROUTINE CoreComputation +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Prototypical sign function for mapping. + FUNCTION SignLambda(val) RESULT(outval) + REAL(KIND=NTREAL), INTENT(IN) :: val + REAL(KIND=NTREAL) :: outval + + IF (val < 0.0_NTREAL) THEN + outval = -1.0_NTREAL + ELSE + outval = 1.0_NTREAL + END IF + END FUNCTION SignLambda !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE SignSolversModule diff --git a/Source/Fortran/SingularValueSolversModule.F90 b/Source/Fortran/SingularValueSolversModule.F90 new file mode 100644 index 00000000..23f9e013 --- /dev/null +++ b/Source/Fortran/SingularValueSolversModule.F90 @@ -0,0 +1,69 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> A module for computing the singular values of a matrix. +MODULE SingularValueSolversModule + USE EigenSolversModule, ONLY : EigenDecomposition + USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteHeader, WriteElement + USE PSMatrixAlgebraModule, ONLY : MatrixMultiply + USE PSMatrixModule, ONLY : Matrix_ps, DestructMatrix + USE SignSolversModule, ONLY : PolarDecomposition + USE SolverParametersModule, ONLY : SolverParameters_t, PrintParameters, & + & DestructSolverParameters + IMPLICIT NONE + PRIVATE +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + PUBLIC :: SingularValueDecomposition +CONTAINS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the singular values and singular vectors of a matrix. + SUBROUTINE SingularValueDecomposition(this, left_vectors, & + & right_vectors, singularvalues, solver_parameters_in) + !> The matrix to decompose. + TYPE(Matrix_ps), INTENT(IN) :: this + !> A matrix containing the left singular vectors. + TYPE(Matrix_ps), INTENT(INOUT) :: left_vectors + !> A matrix containing the right singular vectors. + TYPE(Matrix_ps), INTENT(INOUT) :: right_vectors + !> A diagonal matrix containing the singularvalues. + TYPE(Matrix_ps), INTENT(INOUT) :: singularvalues + !> Parameters for the solver + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Handling Optional Parameters + TYPE(SolverParameters_t) :: params + !! Local Variables + TYPE(Matrix_ps) :: UMat, HMat + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + + IF (params%be_verbose) THEN + CALL WriteHeader("Singular Value Solver") + CALL EnterSubLog + CALL WriteElement(key="Method", VALUE="Polar") + CALL PrintParameters(params) + END IF + + !! First compute the polar decomposition of the matrix. + CALL PolarDecomposition(this, UMat, HMat, params) + + !! Compute the eigen decomposition of the hermitian matrix + CALL EigenDecomposition(HMat, singularvalues, & + & eigenvectors_in=right_vectors, solver_parameters_in=params) + + !! Compute the left singular vectors + CALL MatrixMultiply(UMat, right_vectors, left_vectors, & + & threshold_in=params%threshold) + + !! Cleanup + IF (params%be_verbose) THEN + CALL ExitSubLog + END IF + + CALL DestructSolverParameters(params) + CALL DestructMatrix(UMat) + CALL DestructMatrix(HMat) + END SUBROUTINE SingularValueDecomposition +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +END MODULE SingularValueSolversModule diff --git a/Source/Fortran/SquareRootSolversModule.F90 b/Source/Fortran/SquareRootSolversModule.F90 index 75bf816a..109b7a72 100644 --- a/Source/Fortran/SquareRootSolversModule.F90 +++ b/Source/Fortran/SquareRootSolversModule.F90 @@ -3,6 +3,7 @@ MODULE SquareRootSolversModule USE DataTypesModule, ONLY : NTREAL USE EigenBoundsModule, ONLY : GershgorinBounds + USE EigenSolversModule, ONLY : DenseMatrixFunction USE LoadBalancerModule, ONLY : PermuteMatrix, UndoPermuteMatrix USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteListElement, & & WriteHeader, WriteElement @@ -19,7 +20,9 @@ MODULE SquareRootSolversModule !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Solvers PUBLIC :: SquareRoot + PUBLIC :: DenseSquareRoot PUBLIC :: InverseSquareRoot + PUBLIC :: DenseInverseSquareRoot CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the square root of a matrix. SUBROUTINE SquareRoot(InputMat, OutputMat, solver_parameters_in, order_in) @@ -32,31 +35,65 @@ SUBROUTINE SquareRoot(InputMat, OutputMat, solver_parameters_in, order_in) !> Order of polynomial for calculation (default 5). INTEGER, INTENT(IN), OPTIONAL :: order_in !! Local Variables - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF IF (PRESENT(order_in)) THEN - CALL SquareRootSelector(InputMat, OutputMat, solver_parameters, .FALSE.,& + CALL SquareRootSelector(InputMat, OutputMat, params, .FALSE.,& & order_in) ELSE - CALL SquareRootSelector(InputMat, OutputMat, solver_parameters, .FALSE.) + CALL SquareRootSelector(InputMat, OutputMat, params, .FALSE.) END IF !! Cleanup - CALL DestructSolverParameters(solver_parameters) - + CALL DestructSolverParameters(params) END SUBROUTINE SquareRoot +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Computes the matrix square root function (dense version). + SUBROUTINE DenseSquareRoot(Mat, OutputMat, solver_parameters_in) + !> The matrix to compute the square root of. + TYPE(Matrix_ps), INTENT(IN) :: Mat + !> The computed matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat + !> Parameters for the solver + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Handling Optional Parameters + TYPE(SolverParameters_t) :: params + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + + IF (params%be_verbose) THEN + CALL WriteHeader("Square Root Solver") + CALL EnterSubLog + END IF + + !! Apply + CALL DenseMatrixFunction(Mat, OutputMat, SquareRootLambda, & + & params) + + IF (params%be_verbose) THEN + CALL ExitSubLog + END IF + + !! Cleanup + CALL DestructSolverParameters(params) + END SUBROUTINE DenseSquareRoot !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the inverse square root of a matrix. SUBROUTINE InverseSquareRoot(InputMat, OutputMat, solver_parameters_in, & & order_in) !> The matrix to compute. - TYPE(Matrix_ps), INTENT(IN) :: InputMat + TYPE(Matrix_ps), INTENT(IN) :: InputMat !> The resulting matrix. TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat !> Parameters for the solver. @@ -64,35 +101,68 @@ SUBROUTINE InverseSquareRoot(InputMat, OutputMat, solver_parameters_in, & !> Order of polynomial for calculation (default 5). INTEGER, INTENT(IN), OPTIONAL :: order_in !! Local Variables - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t) :: params IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in + params = solver_parameters_in ELSE - solver_parameters = SolverParameters_t() + params = SolverParameters_t() END IF IF (PRESENT(order_in)) THEN - CALL SquareRootSelector(InputMat, OutputMat, solver_parameters, .TRUE., & - & order_in) + CALL SquareRootSelector(InputMat, OutputMat, params, .TRUE., order_in) ELSE - CALL SquareRootSelector(InputMat, OutputMat, solver_parameters, .TRUE.) + CALL SquareRootSelector(InputMat, OutputMat, params, .TRUE.) END IF !! Cleanup - CALL DestructSolverParameters(solver_parameters) + CALL DestructSolverParameters(params) END SUBROUTINE InverseSquareRoot +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Computes the matrix inverse square root function (dense version). + SUBROUTINE DenseInverseSquareRoot(Mat, OutputMat, solver_parameters_in) + !> The matrix to compute the inverse square root of. + TYPE(Matrix_ps), INTENT(IN) :: Mat + !> The computed matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat + !> Parameters for the solver + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Handling Optional Parameters + TYPE(SolverParameters_t) :: params + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + + IF (params%be_verbose) THEN + CALL WriteHeader("Square Root Solver") + CALL EnterSubLog + END IF + + !! Apply + CALL DenseMatrixFunction(Mat, OutputMat, InverseSquareRootLambda, params) + + IF (params%be_verbose) THEN + CALL ExitSubLog + END IF + + !! Cleanup + CALL DestructSolverParameters(params) + END SUBROUTINE DenseInverseSquareRoot !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> This routine picks the appropriate solver method - SUBROUTINE SquareRootSelector(InputMat, OutputMat, solver_parameters, & + SUBROUTINE SquareRootSelector(InputMat, OutputMat, params, & & compute_inverse, order_in) !> The matrix to compute. TYPE(Matrix_ps), INTENT(IN) :: InputMat !> The Matrix computed. TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat !> Parameters about how to solve. - TYPE(SolverParameters_t),INTENT(IN) :: solver_parameters + TYPE(SolverParameters_t),INTENT(IN) :: params !> True if we are computing the inverse square root. LOGICAL, INTENT(IN) :: compute_inverse !> The polynomial degree to use (optional, default=5) @@ -108,10 +178,10 @@ SUBROUTINE SquareRootSelector(InputMat, OutputMat, solver_parameters, & SELECT CASE(order) CASE(2) - CALL NewtonSchultzISROrder2(InputMat, OutputMat, solver_parameters, & + CALL NewtonSchultzISROrder2(InputMat, OutputMat, params, & & compute_inverse) CASE DEFAULT - CALL NewtonSchultzISRTaylor(InputMat, OutputMat, solver_parameters, & + CALL NewtonSchultzISRTaylor(InputMat, OutputMat, params, & & order, compute_inverse) END SELECT @@ -119,14 +189,13 @@ END SUBROUTINE SquareRootSelector !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the square root or inverse square root of a matrix. !> Based on the Newton-Schultz algorithm presented in: \cite jansik2007linear - SUBROUTINE NewtonSchultzISROrder2(Mat, OutMat, solver_parameters, & - & compute_inverse) + SUBROUTINE NewtonSchultzISROrder2(InMat, OutMat, params, compute_inverse) !> The matrix to compute - TYPE(Matrix_ps), INTENT(IN) :: Mat + TYPE(Matrix_ps), INTENT(IN) :: InMat !> Mat^-1/2 or Mat^1/2. TYPE(Matrix_ps), INTENT(INOUT) :: OutMat !> Parameters for the solver - TYPE(SolverParameters_t), INTENT(IN) :: solver_parameters + TYPE(SolverParameters_t), INTENT(IN) :: params !> Whether to compute the inverse square root. LOGICAL, INTENT(IN) :: compute_inverse !! Local Variables @@ -137,99 +206,99 @@ SUBROUTINE NewtonSchultzISROrder2(Mat, OutMat, solver_parameters, & !! Temporary Variables REAL(NTREAL) :: e_min, e_max REAL(NTREAL) :: max_between - INTEGER :: outer_counter + INTEGER :: II REAL(NTREAL) :: norm_value TYPE(MatrixMemoryPool_p) :: mpool - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Newton Schultz Inverse Square Root") CALL EnterSubLog CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("jansik2007linear") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF !! Construct All The Necessary Matrices - CALL ConstructEmptyMatrix(X_k, Mat) - CALL ConstructEmptyMatrix(SquareRootMat, Mat) - CALL ConstructEmptyMatrix(InverseSquareRootMat, Mat) - CALL ConstructEmptyMatrix(T_k, Mat) - CALL ConstructEmptyMatrix(Temp, Mat) - CALL ConstructEmptyMatrix(Identity, Mat) + CALL ConstructEmptyMatrix(X_k, InMat) + CALL ConstructEmptyMatrix(SquareRootMat, InMat) + CALL ConstructEmptyMatrix(InverseSquareRootMat, InMat) + CALL ConstructEmptyMatrix(T_k, InMat) + CALL ConstructEmptyMatrix(Temp, InMat) + CALL ConstructEmptyMatrix(Identity, InMat) CALL FillMatrixIdentity(Identity) !! Compute the lambda scaling value. - CALL GershgorinBounds(Mat,e_min,e_max) - max_between = MAX(ABS(e_min),ABS(e_max)) + CALL GershgorinBounds(InMat, e_min, e_max) + max_between = MAX(ABS(e_min), ABS(e_max)) lambda = 1.0/max_between !! Initialize CALL FillMatrixIdentity(InverseSquareRootMat) - CALL CopyMatrix(Mat,SquareRootMat) + CALL CopyMatrix(InMat,SquareRootMat) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(SquareRootMat, SquareRootMat, & - & solver_parameters%BalancePermutation, memorypool_in=mpool) + & params%BalancePermutation, memorypool_in=mpool) CALL PermuteMatrix(Identity, Identity, & - & solver_parameters%BalancePermutation, memorypool_in=mpool) + & params%BalancePermutation, memorypool_in=mpool) CALL PermuteMatrix(InverseSquareRootMat, InverseSquareRootMat, & - & solver_parameters%BalancePermutation, memorypool_in=mpool) + & params%BalancePermutation, memorypool_in=mpool) END IF !! Iterate. - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - outer_counter = 1 - norm_value = solver_parameters%converge_diff + 1.0_NTREAL - DO outer_counter = 1,solver_parameters%max_iterations + II = 1 + norm_value = params%converge_diff + 1.0_NTREAL + DO II = 1,params%max_iterations !! Compute X_k - CALL MatrixMultiply(SquareRootMat,InverseSquareRootMat,X_k, & - & threshold_in=solver_parameters%threshold, memory_pool_in=mpool) - CALL GershgorinBounds(X_k,e_min,e_max) - max_between = MAX(ABS(e_min),ABS(e_max)) + CALL MatrixMultiply(SquareRootMat, InverseSquareRootMat, X_k, & + & threshold_in=params%threshold, memory_pool_in=mpool) + CALL GershgorinBounds(X_k, e_min, e_max) + max_between = MAX(ABS(e_min), ABS(e_max)) lambda = 1.0/max_between - CALL ScaleMatrix(X_k,lambda) + CALL ScaleMatrix(X_k, lambda) !! Check if Converged - CALL CopyMatrix(Identity,Temp) - CALL IncrementMatrix(X_k,Temp,REAL(-1.0,NTREAL)) + CALL CopyMatrix(Identity, Temp) + CALL IncrementMatrix(X_k, Temp, REAL(-1.0,NTREAL)) norm_value = MatrixNorm(Temp) !! Compute T_k - CALL CopyMatrix(Identity,T_k) - CALL ScaleMatrix(T_k,REAL(3.0,NTREAL)) - CALL IncrementMatrix(X_k,T_k,REAL(-1.0,NTREAL)) - CALL ScaleMatrix(T_k,REAL(0.5,NTREAL)) + CALL CopyMatrix(Identity, T_k) + CALL ScaleMatrix(T_k, REAL(3.0,NTREAL)) + CALL IncrementMatrix(X_k, T_k, REAL(-1.0,NTREAL)) + CALL ScaleMatrix(T_k, REAL(0.5,NTREAL)) !! Compute Z_k+1 - CALL CopyMatrix(InverseSquareRootMat,Temp) - CALL MatrixMultiply(Temp,T_k,InverseSquareRootMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=mpool) - CALL ScaleMatrix(InverseSquareRootMat,SQRT(lambda)) + CALL CopyMatrix(InverseSquareRootMat, Temp) + CALL MatrixMultiply(Temp, T_k, InverseSquareRootMat, & + & threshold_in=params%threshold, memory_pool_in=mpool) + CALL ScaleMatrix(InverseSquareRootMat, SQRT(lambda)) !! Compute Y_k+1 CALL CopyMatrix(SquareRootMat, Temp) - CALL MatrixMultiply(T_k,Temp,SquareRootMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=mpool) - CALL ScaleMatrix(SquareRootMat,SQRT(lambda)) + CALL MatrixMultiply(T_k, Temp, SquareRootMat, & + & threshold_in=params%threshold, memory_pool_in=mpool) + CALL ScaleMatrix(SquareRootMat, SQRT(lambda)) - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteElement(key="Convergence", VALUE=norm_value) END IF - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. params%converge_diff) THEN EXIT END IF END DO - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=outer_counter) + CALL WriteElement(key="Total_Iterations", VALUE=II) CALL PrintMatrixInformation(InverseSquareRootMat) END IF @@ -240,13 +309,13 @@ SUBROUTINE NewtonSchultzISROrder2(Mat, OutMat, solver_parameters, & END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutMat, OutMat, & - & solver_parameters%BalancePermutation, memorypool_in=mpool) + & params%BalancePermutation, memorypool_in=mpool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF @@ -260,14 +329,14 @@ END SUBROUTINE NewtonSchultzISROrder2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the square root or inverse square root of a matrix. !> Based on the Newton-Schultz algorithm with higher order polynomials. - SUBROUTINE NewtonSchultzISRTaylor(Mat, OutMat, solver_parameters, & + SUBROUTINE NewtonSchultzISRTaylor(InMat, OutMat, params, & & taylor_order, compute_inverse) !> Matrix to Compute - TYPE(Matrix_ps), INTENT(IN) :: Mat + TYPE(Matrix_ps), INTENT(IN) :: InMat !> Mat^-1/2 or Mat^1/2. TYPE(Matrix_ps), INTENT(INOUT) :: OutMat !> Parameters for the solver. - TYPE(SolverParameters_t), INTENT(IN) :: solver_parameters + TYPE(SolverParameters_t), INTENT(IN) :: params !> Order of polynomial to use. INTEGER, INTENT(IN) :: taylor_order !> Whether to compute the inverse square root or not. @@ -282,75 +351,75 @@ SUBROUTINE NewtonSchultzISRTaylor(Mat, OutMat, solver_parameters, & !! Temporary Variables REAL(NTREAL) :: e_min,e_max REAL(NTREAL) :: max_between - INTEGER :: outer_counter + INTEGER :: II REAL(NTREAL) :: norm_value TYPE(MatrixMemoryPool_p) :: mpool - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Newton Schultz Inverse Square Root") CALL EnterSubLog CALL WriteHeader("Citations") CALL EnterSubLog CALL WriteListElement("jansik2007linear") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF !! Construct All The Necessary Matrices - CALL ConstructEmptyMatrix(X_k, Mat) - CALL ConstructEmptyMatrix(SquareRootMat, Mat) - CALL ConstructEmptyMatrix(InverseSquareRootMat, Mat) - CALL ConstructEmptyMatrix(Temp, Mat) + CALL ConstructEmptyMatrix(X_k, InMat) + CALL ConstructEmptyMatrix(SquareRootMat, InMat) + CALL ConstructEmptyMatrix(InverseSquareRootMat, InMat) + CALL ConstructEmptyMatrix(Temp, InMat) IF (taylor_order == 5) THEN - CALL ConstructEmptyMatrix(Temp2, Mat) + CALL ConstructEmptyMatrix(Temp2, InMat) END IF - CALL ConstructEmptyMatrix(Identity, Mat) + CALL ConstructEmptyMatrix(Identity, InMat) CALL FillMatrixIdentity(Identity) !! Compute the lambda scaling value. - CALL GershgorinBounds(Mat,e_min,e_max) - max_between = MAX(ABS(e_min),ABS(e_max)) + CALL GershgorinBounds(InMat, e_min, e_max) + max_between = MAX(ABS(e_min), ABS(e_max)) lambda = 1.0_NTREAL/max_between !! Initialize CALL FillMatrixIdentity(InverseSquareRootMat) - CALL CopyMatrix(Mat,SquareRootMat) - CALL ScaleMatrix(SquareRootMat,lambda) + CALL CopyMatrix(InMat, SquareRootMat) + CALL ScaleMatrix(SquareRootMat, lambda) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN - CALL PermuteMatrix(SquareRootMat,SquareRootMat, & - & solver_parameters%BalancePermutation,memorypool_in=mpool) - CALL PermuteMatrix(Identity,Identity, & - & solver_parameters%BalancePermutation,memorypool_in=mpool) - CALL PermuteMatrix(InverseSquareRootMat,InverseSquareRootMat, & - & solver_parameters%BalancePermutation,memorypool_in=mpool) + IF (params%do_load_balancing) THEN + CALL PermuteMatrix(SquareRootMat, SquareRootMat, & + & params%BalancePermutation, memorypool_in=mpool) + CALL PermuteMatrix(Identity, Identity, & + & params%BalancePermutation, memorypool_in=mpool) + CALL PermuteMatrix(InverseSquareRootMat, InverseSquareRootMat, & + & params%BalancePermutation, memorypool_in=mpool) END IF !! Iterate. - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Iterations") CALL EnterSubLog END IF - outer_counter = 1 - norm_value = solver_parameters%converge_diff + 1.0_NTREAL - DO outer_counter = 1,solver_parameters%max_iterations + II = 1 + norm_value = params%converge_diff + 1.0_NTREAL + DO II = 1, params%max_iterations !! Compute X_k = Z_k * Y_k - I - CALL MatrixMultiply(InverseSquareRootMat,SquareRootMat,X_k, & - & threshold_in=solver_parameters%threshold,memory_pool_in=mpool) + CALL MatrixMultiply(InverseSquareRootMat, SquareRootMat, X_k, & + & threshold_in=params%threshold, memory_pool_in=mpool) CALL IncrementMatrix(Identity,X_k,-1.0_NTREAL) norm_value = MatrixNorm(X_k) SELECT CASE(taylor_order) CASE(3) !! Compute X_k^2 - CALL MatrixMultiply(X_k,X_k,Temp, & - & threshold_in=solver_parameters%threshold,memory_pool_in=mpool) + CALL MatrixMultiply(X_k, X_k, Temp, & + & threshold_in=params%threshold, memory_pool_in=mpool) !! X_k = I - 1/2 X_k + 3/8 X_k^2 + ... - CALL ScaleMatrix(X_k,-0.5_NTREAL) - CALL IncrementMatrix(Identity,X_k) - CALL IncrementMatrix(Temp,X_k,0.375_NTREAL) + CALL ScaleMatrix(X_k, -0.5_NTREAL) + CALL IncrementMatrix(Identity, X_k) + CALL IncrementMatrix(Temp,X_k, 0.375_NTREAL) CASE(5) !! Compute p(x) = x^4 + A*x^3 + B*x^2 + C*x + D !! Scale to make coefficient of x^4 equal to 1 @@ -372,68 +441,68 @@ SUBROUTINE NewtonSchultzISRTaylor(Mat, OutMat, solver_parameters, & d = dd-b*c !! Compute Temp = z = x * (x+a) - CALL MatrixMultiply(X_k,X_k,Temp, & - & threshold_in=solver_parameters%threshold,memory_pool_in=mpool) - CALL IncrementMatrix(X_k,Temp,a) + CALL MatrixMultiply(X_k, X_k, Temp, & + & threshold_in=params%threshold, memory_pool_in=mpool) + CALL IncrementMatrix(X_k, Temp, a) !! Compute Temp2 = z + x + b - CALL CopyMatrix(Identity,Temp2) - CALL ScaleMatrix(Temp2,b) - CALL IncrementMatrix(X_k,Temp2) - CALL IncrementMatrix(Temp,Temp2) + CALL CopyMatrix(Identity, Temp2) + CALL ScaleMatrix(Temp2, b) + CALL IncrementMatrix(X_k, Temp2) + CALL IncrementMatrix(Temp, Temp2) !! Compute Temp = z + c - CALL IncrementMatrix(Identity,Temp,c) + CALL IncrementMatrix(Identity, Temp, c) !! Compute X_k = (z+x+b) * (z+c) + d = Temp2 * Temp + d - CALL MatrixMultiply(Temp2,Temp,X_k, & - & threshold_in=solver_parameters%threshold,memory_pool_in=mpool) + CALL MatrixMultiply(Temp2, Temp, X_k, & + & threshold_in=params%threshold, memory_pool_in=mpool) CALL IncrementMatrix(Identity,X_k,d) !! Scale back to the target coefficients - CALL ScaleMatrix(X_k,35.0_NTREAL/128.0_NTREAL) + CALL ScaleMatrix(X_k, 35.0_NTREAL/128.0_NTREAL) END SELECT !! Compute Z_k+1 = Z_k * X_k - CALL CopyMatrix(InverseSquareRootMat,Temp) - CALL MatrixMultiply(X_k,Temp,InverseSquareRootMat, & - & threshold_in=solver_parameters%threshold,memory_pool_in=mpool) + CALL CopyMatrix(InverseSquareRootMat, Temp) + CALL MatrixMultiply(X_k, Temp, InverseSquareRootMat, & + & threshold_in=params%threshold,memory_pool_in=mpool) !! Compute Y_k+1 = X_k * Y_k - CALL CopyMatrix(SquareRootMat,Temp) - CALL MatrixMultiply(Temp,X_k,SquareRootMat, & - & threshold_in=solver_parameters%threshold,memory_pool_in=mpool) + CALL CopyMatrix(SquareRootMat, Temp) + CALL MatrixMultiply(Temp, X_k, SquareRootMat, & + & threshold_in=params%threshold,memory_pool_in=mpool) - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteListElement(key="Convergence", VALUE=norm_value) END IF - IF (norm_value .LE. solver_parameters%converge_diff) THEN + IF (norm_value .LE. params%converge_diff) THEN EXIT END IF END DO - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog - CALL WriteElement(key="Total_Iterations", VALUE=outer_counter) + CALL WriteElement(key="Total_Iterations", VALUE=II) CALL PrintMatrixInformation(InverseSquareRootMat) END IF IF (compute_inverse) THEN - CALL ScaleMatrix(InverseSquareRootMat,SQRT(lambda)) - CALL CopyMatrix(InverseSquareRootMat,OutMat) + CALL ScaleMatrix(InverseSquareRootMat, SQRT(lambda)) + CALL CopyMatrix(InverseSquareRootMat, OutMat) ELSE - CALL ScaleMatrix(SquareRootMat,1.0_NTREAL/SQRT(lambda)) - CALL CopyMatrix(SquareRootMat,OutMat) + CALL ScaleMatrix(SquareRootMat, 1.0_NTREAL/SQRT(lambda)) + CALL CopyMatrix(SquareRootMat, OutMat) END IF !! Undo Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN - CALL UndoPermuteMatrix(OutMat,OutMat, & - & solver_parameters%BalancePermutation,memorypool_in=mpool) + IF (params%do_load_balancing) THEN + CALL UndoPermuteMatrix(OutMat, OutMat, & + & params%BalancePermutation,memorypool_in=mpool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF @@ -447,5 +516,21 @@ SUBROUTINE NewtonSchultzISRTaylor(Mat, OutMat, solver_parameters, & CALL DestructMatrix(Identity) CALL DestructMatrixMemoryPool(mpool) END SUBROUTINE NewtonSchultzISRTaylor +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Prototypical square root function. + FUNCTION SquareRootLambda(val) RESULT(outval) + REAL(KIND=NTREAL), INTENT(IN) :: val + REAL(KIND=NTREAL) :: outval + + outval = SQRT(val) + END FUNCTION SquareRootLambda +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Prototypical inverse square root function. + FUNCTION InverseSquareRootLambda(val) RESULT(outval) + REAL(KIND=NTREAL), INTENT(IN) :: val + REAL(KIND=NTREAL) :: outval + + outval = 1.0/SQRT(val) + END FUNCTION InverseSquareRootLambda !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE SquareRootSolversModule diff --git a/Source/Fortran/TrigonometrySolversModule.F90 b/Source/Fortran/TrigonometrySolversModule.F90 index 9670a998..a6c569cd 100644 --- a/Source/Fortran/TrigonometrySolversModule.F90 +++ b/Source/Fortran/TrigonometrySolversModule.F90 @@ -3,6 +3,7 @@ MODULE TrigonometrySolversModule USE DataTypesModule, ONLY : NTREAL USE EigenBoundsModule, ONLY : GershgorinBounds + USE EigenSolversModule, ONLY : DenseMatrixFunction USE LoadBalancerModule, ONLY : PermuteMatrix, UndoPermuteMatrix USE LoggingModule, ONLY : EnterSubLog, ExitSubLog, WriteHeader, & & WriteListElement, WriteElement @@ -19,7 +20,9 @@ MODULE TrigonometrySolversModule !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! Solvers PUBLIC :: Sine + PUBLIC :: DenseSine PUBLIC :: Cosine + PUBLIC :: DenseCosine PUBLIC :: ScaleSquareTrigonometryTaylor CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the sine of a matrix. @@ -30,28 +33,67 @@ SUBROUTINE Sine(InputMat, OutputMat, solver_parameters_in) TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat !> Parameters for the solver. TYPE(SolverParameters_t),INTENT(IN),OPTIONAL :: solver_parameters_in + !! Optional parameters + TYPE(SolverParameters_t) :: params !! A temporary matrix to hold the transformation from sine to cosine. TYPE(Matrix_ps) :: ShiftedMat TYPE(Matrix_ps) :: IdentityMat REAL(NTREAL), PARAMETER :: PI = 4*ATAN(1.00_NTREAL) + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + !! Shift - CALL CopyMatrix(InputMat,ShiftedMat) + CALL CopyMatrix(InputMat, ShiftedMat) CALL ConstructEmptyMatrix(IdentityMat, InputMat) CALL FillMatrixIdentity(IdentityMat) - CALL IncrementMatrix(IdentityMat,ShiftedMat, & + CALL IncrementMatrix(IdentityMat, ShiftedMat, & & alpha_in=REAL(-1.0_NTREAL*PI/2.0_NTREAL,NTREAL)) CALL DestructMatrix(IdentityMat) + CALL ScaleSquareTrigonometry(ShiftedMat, OutputMat, solver_parameters_in) + + !! Cleanup + CALL DestructMatrix(ShiftedMat)!! Cleanup + CALL DestructSolverParameters(params) + END SUBROUTINE Sine +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the sine of a matrix. (dense version). + SUBROUTINE DenseSine(Mat, OutputMat, solver_parameters_in) + !> The matrix to compute. + TYPE(Matrix_ps), INTENT(IN) :: Mat + !> The sine of the input matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat + !> Parameters for the solver + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Handling Optional Parameters + TYPE(SolverParameters_t) :: params + + !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - CALL ScaleSquareTrigonometry(ShiftedMat, OutputMat, solver_parameters_in) + params = solver_parameters_in ELSE - CALL ScaleSquareTrigonometry(ShiftedMat, OutputMat) + params = SolverParameters_t() END IF + IF (params%be_verbose) THEN + CALL WriteHeader("Sine Function Solver") + CALL EnterSubLog + END IF + + !! Apply + CALL DenseMatrixFunction(Mat, OutputMat, SineLambda, params) + !! Cleanup - CALL DestructMatrix(ShiftedMat) - END SUBROUTINE Sine + IF (params%be_verbose) THEN + CALL ExitSubLog + END IF + CALL DestructSolverParameters(params) + END SUBROUTINE DenseSine !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the cosine of a matrix. SUBROUTINE Cosine(InputMat, OutputMat, solver_parameters_in) @@ -60,26 +102,64 @@ SUBROUTINE Cosine(InputMat, OutputMat, solver_parameters_in) !> The resulting matrix. TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat !> Parameters for the solver. - TYPE(SolverParameters_t),INTENT(IN),OPTIONAL :: solver_parameters_in + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Local variables + TYPE(SolverParameters_t) :: params + !! Optional Parameters IF (PRESENT(solver_parameters_in)) THEN - CALL ScaleSquareTrigonometry(InputMat, OutputMat, solver_parameters_in) + params = solver_parameters_in ELSE - CALL ScaleSquareTrigonometry(InputMat, OutputMat) + params = SolverParameters_t() END IF + + CALL ScaleSquareTrigonometry(InputMat, OutputMat, params) + + !! Cleanup + CALL DestructSolverParameters(params) END SUBROUTINE Cosine +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the cosine of a matrix. (dense version). + SUBROUTINE DenseCosine(Mat, OutputMat, solver_parameters_in) + !> The matrix to compute. + TYPE(Matrix_ps), INTENT(IN) :: Mat + !> The cosine of the input matrix. + TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat + !> Parameters for the solver + TYPE(SolverParameters_t), INTENT(IN), OPTIONAL :: solver_parameters_in + !! Handling Optional Parameters + TYPE(SolverParameters_t) :: params + + !! Optional Parameters + IF (PRESENT(solver_parameters_in)) THEN + params = solver_parameters_in + ELSE + params = SolverParameters_t() + END IF + + IF (params%be_verbose) THEN + CALL WriteHeader("Cosine Function Solver") + CALL EnterSubLog + END IF + + !! Apply + CALL DenseMatrixFunction(Mat, OutputMat, CosineLambda, params) + + !! Cleanup + IF (params%be_verbose) THEN + CALL ExitSubLog + END IF + CALL DestructSolverParameters(params) + END SUBROUTINE DenseCosine !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute trigonometric functions of a matrix using a taylor series. - SUBROUTINE ScaleSquareTrigonometryTaylor(InputMat, OutputMat, & - & solver_parameters_in) + SUBROUTINE ScaleSquareTrigonometryTaylor(InputMat, OutputMat, params) !> The matrix to compute. TYPE(Matrix_ps), INTENT(IN) :: InputMat !> The resulting matrix. TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat !> Parameters for the solver. - TYPE(SolverParameters_t),INTENT(IN),OPTIONAL :: solver_parameters_in - !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t),INTENT(IN) :: params !! Local Matrices TYPE(Matrix_ps) :: ScaledMat TYPE(Matrix_ps) :: Ak @@ -91,16 +171,9 @@ SUBROUTINE ScaleSquareTrigonometryTaylor(InputMat, OutputMat, & REAL(NTREAL) :: sigma_val REAL(NTREAL) :: taylor_denom INTEGER :: sigma_counter - INTEGER :: counter - - !! Optional Parameters - IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in - ELSE - solver_parameters = SolverParameters_t() - END IF + INTEGER :: II - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Trigonometry Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="Taylor") @@ -108,7 +181,7 @@ SUBROUTINE ScaleSquareTrigonometryTaylor(InputMat, OutputMat, & CALL EnterSubLog CALL WriteListElement("higham2003computing") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF !! Compute The Scaling Factor @@ -124,57 +197,57 @@ SUBROUTINE ScaleSquareTrigonometryTaylor(InputMat, OutputMat, & END DO CALL CopyMatrix(InputMat, ScaledMat) - CALL ScaleMatrix(ScaledMat,1.0_NTREAL/sigma_val) + CALL ScaleMatrix(ScaledMat, 1.0_NTREAL/sigma_val) CALL ConstructEmptyMatrix(OutputMat, InputMat) CALL FillMatrixIdentity(OutputMat) CALL ConstructEmptyMatrix(IdentityMat, InputMat) CALL FillMatrixIdentity(IdentityMat) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(ScaledMat, ScaledMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) CALL PermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) CALL PermuteMatrix(IdentityMat, IdentityMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF !! Square the scaled matrix. taylor_denom = -2.0_NTREAL CALL CopyMatrix(OutputMat, Ak) - CALL MatrixMultiply(ScaledMat,ScaledMat,TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + CALL MatrixMultiply(ScaledMat, ScaledMat, TempMat, & + & threshold_in=params%threshold, memory_pool_in=pool) CALL CopyMatrix(TempMat,ScaledMat) !! Expand Taylor Series - DO counter=2,40,2 - CALL MatrixMultiply(Ak,ScaledMat,TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + DO II = 2, 40, 2 + CALL MatrixMultiply(Ak, ScaledMat, TempMat, & + & threshold_in=params%threshold, memory_pool_in=pool) CALL CopyMatrix(TempMat,Ak) CALL IncrementMatrix(Ak,OutputMat, & & alpha_in=REAL(1.0_NTREAL/taylor_denom,NTREAL)) - taylor_denom = taylor_denom * (counter+1) - taylor_denom = -1.0_NTREAL*taylor_denom*(counter+1) + taylor_denom = taylor_denom * (II+1) + taylor_denom = -1.0_NTREAL*taylor_denom*(II+1) END DO !! Undo scaling - DO counter=1,sigma_counter-1 - CALL MatrixMultiply(OutputMat,OutputMat,TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) - CALL CopyMatrix(TempMat,OutputMat) - CALL ScaleMatrix(OutputMat,REAL(2.0_NTREAL,NTREAL)) - CALL IncrementMatrix(IdentityMat,OutputMat, & + DO II = 1, sigma_counter-1 + CALL MatrixMultiply(OutputMat, OutputMat, TempMat, & + & threshold_in=params%threshold, memory_pool_in=pool) + CALL CopyMatrix(TempMat, OutputMat) + CALL ScaleMatrix(OutputMat, REAL(2.0_NTREAL,NTREAL)) + CALL IncrementMatrix(IdentityMat, OutputMat, & & REAL(-1.0_NTREAL,NTREAL)) END DO - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructMatrix(ScaledMat) @@ -182,20 +255,17 @@ SUBROUTINE ScaleSquareTrigonometryTaylor(InputMat, OutputMat, & CALL DestructMatrix(TempMat) CALL DestructMatrix(IdentityMat) CALL DestructMatrix(Ak) - CALL DestructSolverParameters(solver_parameters) END SUBROUTINE ScaleSquareTrigonometryTaylor !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute trigonometric functions of a matrix. !> This method uses Chebyshev polynomials. - SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, solver_parameters_in) + SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, params) !> The matrix to compute. - TYPE(Matrix_ps), INTENT(IN) :: InputMat + TYPE(Matrix_ps), INTENT(IN) :: InputMat !> The resulting matrix. TYPE(Matrix_ps), INTENT(INOUT) :: OutputMat !> Parameters for the solver. - TYPE(SolverParameters_t),INTENT(IN), OPTIONAL :: solver_parameters_in - !! Handling Optional Parameters - TYPE(SolverParameters_t) :: solver_parameters + TYPE(SolverParameters_t), INTENT(IN) :: params !! Local Matrices TYPE(Matrix_ps) :: ScaledMat TYPE(Matrix_ps) :: TempMat @@ -211,16 +281,9 @@ SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, solver_parameters_in) REAL(NTREAL) :: e_min, e_max, spectral_radius REAL(NTREAL) :: sigma_val INTEGER :: sigma_counter - INTEGER :: counter + INTEGER :: II - !! Optional Parameters - IF (PRESENT(solver_parameters_in)) THEN - solver_parameters = solver_parameters_in - ELSE - solver_parameters = SolverParameters_t() - END IF - - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL WriteHeader("Trigonometry Solver") CALL EnterSubLog CALL WriteElement(key="Method", VALUE="Chebyshev") @@ -230,7 +293,7 @@ SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, solver_parameters_in) CALL WriteListElement("higham2003computing") CALL WriteListElement("yau1993reducing") CALL ExitSubLog - CALL PrintParameters(solver_parameters) + CALL PrintParameters(params) END IF !! Compute The Scaling Factor @@ -246,17 +309,17 @@ SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, solver_parameters_in) END DO CALL CopyMatrix(InputMat, ScaledMat) - CALL ScaleMatrix(ScaledMat,1.0_NTREAL/sigma_val) + CALL ScaleMatrix(ScaledMat, 1.0_NTREAL/sigma_val) CALL ConstructEmptyMatrix(OutputMat, InputMat) CALL ConstructEmptyMatrix(IdentityMat, InputMat) CALL FillMatrixIdentity(IdentityMat) !! Load Balancing Step - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL PermuteMatrix(ScaledMat, ScaledMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) CALL PermuteMatrix(IdentityMat, IdentityMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF !! Expand the Chebyshev Polynomial. @@ -279,58 +342,58 @@ SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, solver_parameters_in) coefficients(17) = 9.181480886537484e-17_NTREAL !! Basic T Values. - CALL MatrixMultiply(ScaledMat,ScaledMat,T2,alpha_in=2.0_NTREAL,& - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) - CALL IncrementMatrix(IdentityMat,T2, alpha_in=-1.0_NTREAL) - CALL MatrixMultiply(T2,T2,T4,alpha_in=2.0_NTREAL,& - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) - CALL IncrementMatrix(IdentityMat,T4, alpha_in=-1.0_NTREAL) - CALL MatrixMultiply(T4,T2,T6,alpha_in=2.0_NTREAL,& - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) - CALL IncrementMatrix(T2,T6, alpha_in=-1.0_NTREAL) - CALL MatrixMultiply(T6,T2,T8,alpha_in=2.0_NTREAL,& - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) - CALL IncrementMatrix(T4,T8, alpha_in=-1.0_NTREAL) + CALL MatrixMultiply(ScaledMat, ScaledMat,T2, alpha_in=2.0_NTREAL,& + & threshold_in=params%threshold, memory_pool_in=pool) + CALL IncrementMatrix(IdentityMat, T2, alpha_in=-1.0_NTREAL) + CALL MatrixMultiply(T2, T2, T4, alpha_in=2.0_NTREAL,& + & threshold_in=params%threshold, memory_pool_in=pool) + CALL IncrementMatrix(IdentityMat, T4, alpha_in=-1.0_NTREAL) + CALL MatrixMultiply(T4, T2, T6, alpha_in=2.0_NTREAL,& + & threshold_in=params%threshold, memory_pool_in=pool) + CALL IncrementMatrix(T2, T6, alpha_in=-1.0_NTREAL) + CALL MatrixMultiply(T6, T2, T8,alpha_in=2.0_NTREAL,& + & threshold_in=params%threshold, memory_pool_in=pool) + CALL IncrementMatrix(T4, T8, alpha_in=-1.0_NTREAL) !! Contribution from the second half. - CALL CopyMatrix(T8,OutputMat) - CALL ScaleMatrix(OutputMat,0.5_NTREAL*coefficients(17)) - CALL IncrementMatrix(T6,OutputMat,alpha_in=0.5_NTREAL*coefficients(15)) - CALL IncrementMatrix(T4,OutputMat,alpha_in=0.5_NTREAL*coefficients(13)) - CALL IncrementMatrix(T2,OutputMat,alpha_in=0.5_NTREAL*coefficients(11)) - CALL MatrixMultiply(T8,OutputMat,TempMat,& - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) + CALL CopyMatrix(T8, OutputMat) + CALL ScaleMatrix(OutputMat, 0.5_NTREAL*coefficients(17)) + CALL IncrementMatrix(T6, OutputMat, alpha_in=0.5_NTREAL*coefficients(15)) + CALL IncrementMatrix(T4, OutputMat, alpha_in=0.5_NTREAL*coefficients(13)) + CALL IncrementMatrix(T2, OutputMat, alpha_in=0.5_NTREAL*coefficients(11)) + CALL MatrixMultiply(T8, OutputMat, TempMat,& + & threshold_in=params%threshold, memory_pool_in=pool) !! Contribution from the first half. - CALL CopyMatrix(T8,OutputMat) - CALL ScaleMatrix(OutputMat,coefficients(9)) - CALL IncrementMatrix(T6,OutputMat,& + CALL CopyMatrix(T8, OutputMat) + CALL ScaleMatrix(OutputMat, coefficients(9)) + CALL IncrementMatrix(T6, OutputMat, & & alpha_in=coefficients(7)+0.5_NTREAL*coefficients(11)) - CALL IncrementMatrix(T4,OutputMat,& + CALL IncrementMatrix(T4, OutputMat, & & alpha_in=coefficients(5)+0.5_NTREAL*coefficients(13)) - CALL IncrementMatrix(T2,OutputMat,& + CALL IncrementMatrix(T2, OutputMat, & & alpha_in=coefficients(3)+0.5_NTREAL*coefficients(15)) - CALL IncrementMatrix(IdentityMat,OutputMat,& + CALL IncrementMatrix(IdentityMat, OutputMat, & & alpha_in=coefficients(1)+0.5_NTREAL*coefficients(17)) - CALL IncrementMatrix(TempMat,OutputMat) + CALL IncrementMatrix(TempMat, OutputMat) !! Undo scaling - DO counter=1,sigma_counter-1 - CALL MatrixMultiply(OutputMat,OutputMat,TempMat, & - & threshold_in=solver_parameters%threshold, memory_pool_in=pool) - CALL CopyMatrix(TempMat,OutputMat) - CALL ScaleMatrix(OutputMat,2.0_NTREAL) - CALL IncrementMatrix(IdentityMat,OutputMat,-1.0_NTREAL) + DO II = 1, sigma_counter-1 + CALL MatrixMultiply(OutputMat, OutputMat, TempMat, & + & threshold_in=params%threshold, memory_pool_in=pool) + CALL CopyMatrix(TempMat, OutputMat) + CALL ScaleMatrix(OutputMat, 2.0_NTREAL) + CALL IncrementMatrix(IdentityMat, OutputMat, -1.0_NTREAL) END DO - IF (solver_parameters%do_load_balancing) THEN + IF (params%do_load_balancing) THEN CALL UndoPermuteMatrix(OutputMat, OutputMat, & - & solver_parameters%BalancePermutation, memorypool_in=pool) + & params%BalancePermutation, memorypool_in=pool) END IF !! Cleanup - IF (solver_parameters%be_verbose) THEN + IF (params%be_verbose) THEN CALL ExitSubLog END IF CALL DestructMatrix(ScaledMat) @@ -341,7 +404,22 @@ SUBROUTINE ScaleSquareTrigonometry(InputMat, OutputMat, solver_parameters_in) CALL DestructMatrix(T6) CALL DestructMatrix(T8) CALL DestructMatrixMemoryPool(pool) - CALL DestructSolverParameters(solver_parameters) END SUBROUTINE ScaleSquareTrigonometry +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Prototypical sine function for mapping. + FUNCTION SineLambda(val) RESULT(outval) + REAL(KIND=NTREAL), INTENT(IN) :: val + REAL(KIND=NTREAL) :: outval + + outval = SIN(val) + END FUNCTION SineLambda +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Prototypical cosine function. + FUNCTION CosineLambda(val) RESULT(outval) + REAL(KIND=NTREAL), INTENT(IN) :: val + REAL(KIND=NTREAL) :: outval + + outval = COS(val) + END FUNCTION CosineLambda !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE TrigonometrySolversModule diff --git a/Source/Fortran/eigenexa_includes/Cleanup.f90 b/Source/Fortran/eigenexa_includes/Cleanup.f90 new file mode 100644 index 00000000..5f7a97f3 --- /dev/null +++ b/Source/Fortran/eigenexa_includes/Cleanup.f90 @@ -0,0 +1,5 @@ + IF(ALLOCATED(AD)) DEALLOCATE(AD) + IF(ALLOCATED(VD)) DEALLOCATE(VD) + IF(ALLOCATED(WD)) DEALLOCATE(WD) + + CALL eigen_free diff --git a/Source/Fortran/eigenexa_includes/Compute.f90 b/Source/Fortran/eigenexa_includes/Compute.f90 new file mode 100644 index 00000000..72d380a8 --- /dev/null +++ b/Source/Fortran/eigenexa_includes/Compute.f90 @@ -0,0 +1,7 @@ + !! Local Variables + INTEGER :: N, LDA, LDZ + + !! Setup EigenExa Parameters + N = exa%mat_dim + LDA = exa%local_rows + LDZ = exa%local_rows diff --git a/Source/Fortran/eigenexa_includes/EigenExa_s.F90 b/Source/Fortran/eigenexa_includes/EigenExa_s.F90 new file mode 100644 index 00000000..1a1ba466 --- /dev/null +++ b/Source/Fortran/eigenexa_includes/EigenExa_s.F90 @@ -0,0 +1,59 @@ + !! Allocate Eigen Exa + CALL InitializeEigenExa(A, nvals, PRESENT(eigenvectors_in), exa) + + !! Allocate Memory + ALLOCATE(AD(exa%local_rows, exa%local_cols)) + AD = 0 + ALLOCATE(VD(exa%local_rows, exa%local_cols)) + VD = 0 + ALLOCATE(WD(exa%mat_dim)) + WD = 0 + + !! Convert to EigenExa + CALL StartTimer("NTToEigen") +#ifdef ISCOMPLEX + CALL NTToEigen_c(A, AD, exa) +#else + CALL NTToEigen_r(A, AD, exa) +#endif + CALL StopTimer("NTToEigen") + + !! Calculate + CALL StartTimer("EigenExaCompute") +#ifdef ISCOMPLEX + CALL Compute_c(AD, VD, WD, exa) +#else + CALL Compute_r(AD, VD, WD, exa) +#endif + CALL StopTimer("EigenExaCompute") + + !! Convert Back + CALL StartTimer("EigenToNT") + + IF (PRESENT(eigenvectors_in)) THEN + CALL ConstructEmptyMatrix(eigenvectors_in, A) +#ifdef ISCOMPLEX + CALL EigenToNT_c(VD, eigenvectors_in, params, exa) +#else + CALL EigenToNT_r(VD, eigenvectors_in, params, exa) +#endif + END IF + + CALL ConstructEmptyMatrix(eigenvalues, A) + CALL ExtractEigenvalues(WD, eigenvalues, exa) + + CALL StopTimer("EigenToNT") + + !! Cleanup +#ifdef ISCOMPLEX + CALL CleanUp_c(AD, VD, WD) +#else + CALL CleanUp_r(AD, VD, WD) +#endif + + IF (params%be_verbose) THEN + IF (PRESENT(eigenvectors_in)) THEN + CALL PrintMatrixInformation(eigenvectors_in) + END IF + CALL ExitSubLog + END IF diff --git a/Source/Fortran/eigenexa_includes/EigenSerial.f90 b/Source/Fortran/eigenexa_includes/EigenSerial.f90 new file mode 100644 index 00000000..3df11b80 --- /dev/null +++ b/Source/Fortran/eigenexa_includes/EigenSerial.f90 @@ -0,0 +1,41 @@ + !! Gather as dense + CALL GatherMatrixToProcess(this, local_s) + CALL ConstructMatrixDFromS(local_s, local_d) + + !! Decompose + CALL EigenDecomposition(local_d, V, W) + + !! Filter if necessary + IF (nvals+1 .LE. V%rows) THEN + V%DATA(:, nvals+1:) = 0 + W%DATA(nvals+1:, :) = 0 + W%DATA(:, nvals+1:) = 0 + END IF + + !! Convert results to triplet lists + CALL ConstructMatrixSFromD(V, V_s, threshold_in=threshold) + CALL ConstructMatrixSFromD(W, W_s, threshold_in=threshold) + CALL MatrixToTripletList(V_s, V_t) + CALL MatrixToTripletList(W_s, W_t) + + !! Distribute + CALL ConstructEmptyMatrix(eigenvalues, this) + IF (eigenvalues%process_grid%within_slice_rank .NE. 0) THEN + CALL ConstructTripletList(W_t) + END IF + CALL FillMatrixFromTripletList(eigenvalues, W_t, preduplicated_in=.TRUE.) + + IF (PRESENT(eigenvectors_in)) THEN + CALL ConstructEmptyMatrix(eigenvectors_in, this) + IF (eigenvectors_in%process_grid%within_slice_rank .NE. 0) THEN + CALL ConstructTripletList(V_t) + END IF + CALL FillMatrixFromTripletList(eigenvectors_in, V_t, & + & preduplicated_in=.TRUE.) + END IF + + !! Cleanup + CALL DestructMatrix(local_s) + CALL DestructMatrix(local_d) + CALL DestructTripletList(V_t) + CALL DestructTripletList(W_t) diff --git a/Source/Fortran/eigenexa_includes/EigenToNT.f90 b/Source/Fortran/eigenexa_includes/EigenToNT.f90 new file mode 100644 index 00000000..ea1af8d8 --- /dev/null +++ b/Source/Fortran/eigenexa_includes/EigenToNT.f90 @@ -0,0 +1,39 @@ + !! Local Variables + INTEGER :: row_start, row_end, col_start, col_end + INTEGER :: II, JJ, ilookup, jlookup + INTEGER :: ind + + !! Get The Eigenvectors + row_start = eigen_loop_start(1, exa%proc_rows, exa%rowid) + row_end = eigen_loop_end(exa%mat_dim, exa%proc_rows, exa%rowid) + col_start = eigen_loop_start(1, exa%proc_cols, exa%colid) + col_end = eigen_loop_end(exa%mat_dim, exa%proc_cols, exa%colid) + + !! Convert to a 1D array for index ease. + ALLOCATE(VD1(SIZE(VD,DIM=1)*SIZE(VD,DIM=2))) + VD1 = PACK(VD, .TRUE.) + + CALL StartTimer("EigenExaFilter") + CALL ConstructTripletList(triplet_v) + ind = 1 + DO JJ = col_start, col_end + jlookup = eigen_translate_l2g(JJ, exa%proc_cols, exa%colid) + DO II = row_start, row_end + IF (ABS(VD1(ind+II-1)) .GT. params%threshold) THEN + ilookup = eigen_translate_l2g(II, exa%proc_rows, exa%rowid) + CALL SetTriplet(trip, jlookup, ilookup, VD1(ind+II-1)) + CALL AppendToTripletList(triplet_v, trip) + END IF + END DO + ind = ind + exa%offset + END DO + CALL StopTimer("EigenExaFilter") + + CALL StartTimer("EigenFill") + CALL FillMatrixFromTripletList(V, triplet_v) + CALL StopTimer("EigenFill") + + !! Cleanup + CALL DestructTripletList(triplet_v) + + DEALLOCATE(VD1) diff --git a/Source/Fortran/eigenexa_includes/NTToEigen.f90 b/Source/Fortran/eigenexa_includes/NTToEigen.f90 new file mode 100644 index 00000000..d5fe77d8 --- /dev/null +++ b/Source/Fortran/eigenexa_includes/NTToEigen.f90 @@ -0,0 +1,48 @@ + !! Local Variables + INTEGER :: ilookup, jlookup, iowner, jowner, ijowner + INTEGER :: lrow, lcol + INTEGER :: II + + !! We will fill a triplet list for each other process + ALLOCATE(send_list(exa%num_procs)) + DO II = 1, exa%num_procs + CALL ConstructTripletList(send_list(II)) + END DO + + !! Now Get The Triplet List, and adjust + CALL GetMatrixTripletList(A, triplet_a) + DO II = 1, triplet_a%CurrentSize + CALL GetTripletAt(triplet_a, II, trip) + + !! Determine where that triplet will reside + iowner = eigen_owner_node(trip%index_row, exa%proc_rows, exa%rowid) + jowner = eigen_owner_node(trip%index_column, exa%proc_cols, exa%colid) + ijowner = (jowner-1)*exa%proc_rows + iowner + + !! New indices + ilookup = eigen_translate_g2l(trip%index_row, exa%proc_rows, & + & exa%rowid) + jlookup = eigen_translate_g2l(trip%index_column, exa%proc_cols, & + & exa%colid) + CALL SetTriplet(shifted_trip, jlookup, ilookup, trip%point_value) + + CALL AppendToTripletList(send_list(ijowner), shifted_trip) + END DO + + !! Redistribute The Triplets + CALL RedistributeTripletLists(send_list, exa%comm, recv_list) + + !! Write To The Dense Array + DO II = 1, recv_list%CurrentSize + lrow = recv_list%DATA(II)%index_row + lcol = recv_list%DATA(II)%index_column + AD(lrow,lcol) = recv_list%DATA(II)%point_value + END DO + + !! Cleanup + DO II = 1, exa%num_procs + CALL DestructTripletList(send_list(II)) + END DO + DEALLOCATE(send_list) + CALL DestructTripletList(recv_list) + CALL DestructTripletList(triplet_a) diff --git a/Source/Fortran/solver_includes/EigenSerial.f90 b/Source/Fortran/solver_includes/EigenSerial.f90 deleted file mode 100644 index 6c6605c5..00000000 --- a/Source/Fortran/solver_includes/EigenSerial.f90 +++ /dev/null @@ -1,65 +0,0 @@ - !! Local Data - INTEGER :: counter, list_size - INTEGER :: mat_dim - - mat_dim = this%actual_matrix_dimension - - !! Gather on a single processor - CALL GetMatrixTripletList(this, triplet_list) - ALLOCATE(send_list(this%process_grid%slice_size)) - CALL ConstructTripletList(send_list(1), triplet_list%CurrentSize) - DO counter = 2, this%process_grid%slice_size - CALL ConstructTripletList(send_list(counter)) - END DO - list_size = triplet_list%CurrentSize - send_list(1)%DATA(:list_size) = triplet_list%DATA(:list_size) - CALL DestructTripletList(triplet_list) - CALL RedistributeTripletLists(send_list, & - & this%process_grid%within_slice_comm, triplet_list) - - !! Perform the local decomposition - CALL ConstructTripletList(triplet_w) - IF (this%process_grid%within_slice_rank .EQ. 0) THEN - CALL SortTripletList(triplet_list, mat_dim, mat_dim, & - & sorted_triplet_list, .TRUE.) - CALL ConstructMatrixFromTripletList(local_a, sorted_triplet_list, & - & mat_dim, mat_dim) - - CALL ConstructMatrixDFromS(local_a, dense_a) - IF (PRESENT(eigenvalues_out)) THEN - CALL EigenDecomposition(dense_a, dense_v, dense_w) - CALL ConstructTripletList(triplet_w, mat_dim) - DO counter = 1, mat_dim - triplet_w%DATA(counter)%index_row = counter - triplet_w%DATA(counter)%index_column = counter - triplet_w%DATA(counter)%point_value = dense_w%DATA(counter,1) - END DO - ELSE - CALL EigenDecomposition(dense_a, dense_v) - END IF - - CALL ConstructMatrixSFromD(dense_v, local_v, fixed_params%threshold) - CALL MatrixToTripletList(local_v, triplet_list) - END IF - - !! Build The Full Matrices - CALL ConstructEmptyMatrix(eigenvectors, this) - CALL FillMatrixFromTripletList(eigenvectors, triplet_list, .TRUE.) - - IF (PRESENT(eigenvalues_out)) THEN - CALL ConstructEmptyMatrix(eigenvalues_out, this) - CALL FillMatrixFromTripletList(eigenvalues_out, triplet_w, .TRUE.) - END IF - - !! Cleanup - CALL DestructMatrix(dense_a) - CALL DestructMatrix(dense_v) - CALL DestructMatrix(dense_w) - CALL DestructMatrix(sparse) - CALL DestructTripletList(triplet_list) - CALL DestructTripletList(triplet_w) - CALL DestructTripletList(sorted_triplet_list) - DO counter = 1, this%process_grid%slice_size - CALL DestructTripletList(send_list(counter)) - END DO - DEALLOCATE(send_list) diff --git a/Source/Swig/CMakeLists.txt b/Source/Swig/CMakeLists.txt index d2f90c13..07de606d 100644 --- a/Source/Swig/CMakeLists.txt +++ b/Source/Swig/CMakeLists.txt @@ -32,7 +32,8 @@ endif() if (APPLE) set(APPLE_SUPRESS "-flat_namespace -undefined suppress") endif() -swig_link_libraries(NTPolySwig NTPolyCPP NTPolyWrapper NTPoly +swig_link_libraries(NTPolySwig NTPolyCPP NTPolyWrapper NTPoly + ${EigenSolver_LIBRARIES} ${TOOLCHAIN_LIBS} ${APPLE_SUPRESS}) set_target_properties(_NTPolySwig PROPERTIES ARCHIVE_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/python diff --git a/Source/Swig/NTPolySwig.i b/Source/Swig/NTPolySwig.i index d22d6f94..ae3cf665 100644 --- a/Source/Swig/NTPolySwig.i +++ b/Source/Swig/NTPolySwig.i @@ -13,7 +13,9 @@ #include "ChebyshevSolvers.h" #include "DensityMatrixSolvers.h" #include "EigenBounds.h" +#include "EigenSolvers.h" #include "ExponentialSolvers.h" +#include "FermiOperator.h" #include "GeometryOptimization.h" #include "HermiteSolvers.h" #include "InverseSolvers.h" @@ -51,7 +53,9 @@ using namespace NTPoly; %include "ChebyshevSolvers.h" %include "DensityMatrixSolvers.h" %include "EigenBounds.h" +%include "EigenSolvers.h" %include "ExponentialSolvers.h" +%include "FermiOperator.h" %include "GeometryOptimization.h" %include "HermiteSolvers.h" %include "InverseSolvers.h" diff --git a/Source/Wrapper/CMakeLists.txt b/Source/Wrapper/CMakeLists.txt index 309d951f..c8b7fdc2 100644 --- a/Source/Wrapper/CMakeLists.txt +++ b/Source/Wrapper/CMakeLists.txt @@ -4,7 +4,9 @@ set(Wsrc ChebyshevSolversModule_wrp.F90 DensityMatrixSolversModule_wrp.F90 EigenBoundsModule_wrp.F90 + EigenSolversModule_wrp.F90 ExponentialSolversModule_wrp.F90 + FermiOperatorModule_wrp.F90 GeometryOptimizationModule_wrp.F90 HermiteSolversModule_wrp.F90 InverseSolversModule_wrp.F90 diff --git a/Source/Wrapper/DensityMatrixSolversModule_wrp.F90 b/Source/Wrapper/DensityMatrixSolversModule_wrp.F90 index af2a80ca..284d9ac7 100644 --- a/Source/Wrapper/DensityMatrixSolversModule_wrp.F90 +++ b/Source/Wrapper/DensityMatrixSolversModule_wrp.F90 @@ -3,7 +3,7 @@ MODULE DensityMatrixSolversModule_wrp USE DataTypesModule, ONLY : NTREAL USE DensityMatrixSolversModule, ONLY : TRS2, TRS4, HPCP, PM, ScaleAndFold, & - & EnergyDensityMatrix + & EnergyDensityMatrix, DenseDensity USE PSMatrixModule_wrp, ONLY : Matrix_ps_wrp USE SolverParametersModule_wrp, ONLY : SolverParameters_wrp USE WrapperModule, ONLY : SIZE_wrp @@ -15,6 +15,7 @@ MODULE DensityMatrixSolversModule_wrp PUBLIC :: TRS2_wrp PUBLIC :: TRS4_wrp PUBLIC :: HPCP_wrp + PUBLIC :: DenseDensity_wrp PUBLIC :: ScaleAndFold_wrp PUBLIC :: EnergyDensityMatrix_wrp ! PUBLIC :: HPCPPlus_wrp @@ -150,6 +151,33 @@ SUBROUTINE ScaleAndFold_wrp(ih_Hamiltonian, ih_InverseSquareRoot, trace, & & h_Density%DATA, homo, lumo, energy_value_out, & & h_solver_parameters%DATA) END SUBROUTINE ScaleAndFold_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the density matrix from a Hamiltonian using the PM method. + SUBROUTINE DenseDensity_wrp(ih_Hamiltonian, ih_InverseSquareRoot, trace, & + & ih_Density, energy_value_out, chemical_potential_out, & + & ih_solver_parameters) BIND(c,name="DenseDensity_wrp") + INTEGER(kind=c_int), INTENT(IN) :: ih_Hamiltonian(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_InverseSquareRoot(SIZE_wrp) + REAL(NTREAL), INTENT(IN) :: trace + INTEGER(kind=c_int), INTENT(INOUT) :: ih_Density(SIZE_wrp) + REAL(NTREAL), INTENT(OUT) :: energy_value_out + REAL(NTREAL), INTENT(OUT) :: chemical_potential_out + INTEGER(kind=c_int), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_Hamiltonian + TYPE(Matrix_ps_wrp) :: h_InverseSquareRoot + TYPE(Matrix_ps_wrp) :: h_Density + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_Hamiltonian = TRANSFER(ih_Hamiltonian,h_Hamiltonian) + h_InverseSquareRoot = TRANSFER(ih_InverseSquareRoot,h_InverseSquareRoot) + h_Density = TRANSFER(ih_Density,h_Density) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL DenseDensity(h_Hamiltonian%DATA, h_InverseSquareRoot%DATA, trace, & + & h_Density%DATA, energy_value_out=energy_value_out, & + & chemical_potential_out=chemical_potential_out, & + & solver_parameters_in=h_solver_parameters%DATA) + END SUBROUTINE DenseDensity_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the energy-weighted density matrix. SUBROUTINE EnergyDensityMatrix_wrp(ih_Hamiltonian, ih_Density, & diff --git a/Source/Wrapper/EigenSolversModule_wrp.F90 b/Source/Wrapper/EigenSolversModule_wrp.F90 new file mode 100644 index 00000000..35fbb2a3 --- /dev/null +++ b/Source/Wrapper/EigenSolversModule_wrp.F90 @@ -0,0 +1,87 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> Wraps the eigensolvers module for calling from other languages. +MODULE EigenSolversModule_wrp + USE EigenSolversModule, ONLY : EigenDecomposition + USE PSMatrixModule_wrp, ONLY : Matrix_ps_wrp + USE PSMAtrixModule, ONLY : PrintMatrix + USE SingularValueSolversModule, ONLY : SingularValueDecomposition + USE SolverParametersModule_wrp, ONLY : SolverParameters_wrp + USE WrapperModule, ONLY : SIZE_wrp + USE ISO_C_BINDING, ONLY : C_INT + IMPLICIT NONE + PRIVATE +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + PUBLIC :: EigenDecomposition_wrp +CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the eigendecomposition of a matrix. + SUBROUTINE EigenDecomposition_wrp(ih_this, ih_eigenvalues, nvals, & + & ih_eigenvectors, ih_solver_parameters) & + & BIND(c,name="EigenDecomposition_wrp") + INTEGER(KIND=C_INT), INTENT(IN) :: ih_this(SIZE_wrp) + INTEGER(KIND=C_INT), INTENT(IN) :: ih_eigenvalues(SIZE_wrp) + INTEGER(KIND=C_INT), INTENT(IN) :: nvals + INTEGER(KIND=C_INT), INTENT(IN) :: ih_eigenvectors(SIZE_wrp) + INTEGER(KIND=C_INT), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_this + TYPE(Matrix_ps_wrp) :: h_eigenvectors + TYPE(Matrix_ps_wrp) :: h_eigenvalues + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_this = TRANSFER(ih_this,h_this) + h_eigenvectors = TRANSFER(ih_eigenvectors,h_eigenvectors) + h_eigenvalues = TRANSFER(ih_eigenvalues,h_eigenvalues) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL EigenDecomposition(h_this%DATA, h_eigenvalues%DATA, nvals_in=nvals, & + & eigenvectors_in=h_eigenvectors%DATA, & + & solver_parameters_in=h_solver_parameters%DATA) + + END SUBROUTINE EigenDecomposition_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the eigendecomposition of a matrix. + SUBROUTINE EigenDecomposition_novec_wrp(ih_this, ih_eigenvalues, nvals, & + & ih_solver_parameters) & + & BIND(c,name="EigenDecomposition_novec_wrp") + INTEGER(KIND=C_INT), INTENT(IN) :: ih_this(SIZE_wrp) + INTEGER(KIND=C_INT), INTENT(IN) :: ih_eigenvalues(SIZE_wrp) + INTEGER(KIND=C_INT), INTENT(IN) :: nvals + INTEGER(KIND=C_INT), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_this + TYPE(Matrix_ps_wrp) :: h_eigenvalues + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_this = TRANSFER(ih_this,h_this) + h_eigenvalues = TRANSFER(ih_eigenvalues,h_eigenvalues) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL EigenDecomposition(h_this%DATA, h_eigenvalues%DATA, nvals_in=nvals, & + & solver_parameters_in=h_solver_parameters%DATA) + + END SUBROUTINE EigenDecomposition_novec_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the singularvalues and singularvectors of a matrix. + SUBROUTINE SingularValueDecompostion_wrp(ih_this, ih_leftvectors, & + & ih_rightvectors, ih_singularvalues, ih_solver_parameters) & + & BIND(c,name="SingularValueDecompostion_wrp") + INTEGER(kind=c_int), INTENT(IN) :: ih_this(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_leftvectors(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_rightvectors(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_singularvalues(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_this + TYPE(Matrix_ps_wrp) :: h_leftvectors + TYPE(Matrix_ps_wrp) :: h_rightvectors + TYPE(Matrix_ps_wrp) :: h_singularvalues + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_this = TRANSFER(ih_this,h_this) + h_leftvectors = TRANSFER(ih_leftvectors,h_leftvectors) + h_rightvectors = TRANSFER(ih_rightvectors,h_rightvectors) + h_singularvalues = TRANSFER(ih_singularvalues,h_singularvalues) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL SingularValueDecomposition(h_this%DATA, h_leftvectors%DATA, & + & h_rightvectors%DATA, h_singularvalues%DATA, h_solver_parameters%DATA) + END SUBROUTINE SingularValueDecompostion_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +END MODULE EigenSolversModule_wrp diff --git a/Source/Wrapper/ExponentialSolversModule_wrp.F90 b/Source/Wrapper/ExponentialSolversModule_wrp.F90 index 68f8c974..ccfc01bf 100644 --- a/Source/Wrapper/ExponentialSolversModule_wrp.F90 +++ b/Source/Wrapper/ExponentialSolversModule_wrp.F90 @@ -2,7 +2,8 @@ !> Wraps the exponential solvers module for calling from other languages. MODULE ExponentialSolversModule_wrp USE ExponentialSolversModule, ONLY : ComputeExponential, & - & ComputeExponentialPade, ComputeLogarithm + & ComputeExponentialPade, ComputeDenseExponential, & + & ComputeLogarithm, ComputeDenseLogarithm USE PSMatrixModule_wrp, ONLY : Matrix_ps_wrp USE SolverParametersModule_wrp, ONLY : SolverParameters_wrp USE WrapperModule, ONLY : SIZE_wrp @@ -11,7 +12,9 @@ MODULE ExponentialSolversModule_wrp PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: ComputeExponential_wrp + PUBLIC :: ComputeDenseExponential_wrp PUBLIC :: ComputeLogarithm_wrp + PUBLIC :: ComputeDenseLogarithm_wrp CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the exponential of a matrix. SUBROUTINE ComputeExponential_wrp(ih_InputMat, ih_OutputMat, & @@ -30,6 +33,24 @@ SUBROUTINE ComputeExponential_wrp(ih_InputMat, ih_OutputMat, & CALL ComputeExponential(h_InputMat%DATA, h_OutputMat%DATA, & & h_solver_parameters%DATA) END SUBROUTINE ComputeExponential_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the exponential of a matrix (dense version). + SUBROUTINE ComputeDenseExponential_wrp(ih_InputMat, ih_OutputMat, & + & ih_solver_parameters) BIND(c,name="ComputeDenseExponential_wrp") + INTEGER(kind=c_int), INTENT(IN) :: ih_InputMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(INOUT) :: ih_OutputMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_InputMat + TYPE(Matrix_ps_wrp) :: h_OutputMat + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_InputMat = TRANSFER(ih_InputMat,h_InputMat) + h_OutputMat = TRANSFER(ih_OutputMat, h_OutputMat) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL ComputeDenseExponential(h_InputMat%DATA, h_OutputMat%DATA, & + & h_solver_parameters%DATA) + END SUBROUTINE ComputeDenseExponential_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the exponential of a matrix with the pade approximation. SUBROUTINE ComputeExponentialPade_wrp(ih_InputMat, ih_OutputMat, & @@ -66,5 +87,23 @@ SUBROUTINE ComputeLogarithm_wrp(ih_InputMat, ih_OutputMat, & CALL ComputeLogarithm(h_InputMat%DATA, h_OutputMat%DATA, & & h_solver_parameters%DATA) END SUBROUTINE ComputeLogarithm_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the logarithm of a matrix (dense version). + SUBROUTINE ComputeDenseLogarithm_wrp(ih_InputMat, ih_OutputMat, & + & ih_solver_parameters) BIND(c,name="ComputeDenseLogarithm_wrp") + INTEGER(kind=c_int), INTENT(IN) :: ih_InputMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(INOUT) :: ih_OutputMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_InputMat + TYPE(Matrix_ps_wrp) :: h_OutputMat + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_InputMat = TRANSFER(ih_InputMat,h_InputMat) + h_OutputMat = TRANSFER(ih_OutputMat, h_OutputMat) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL ComputeDenseLogarithm(h_InputMat%DATA, h_OutputMat%DATA, & + & h_solver_parameters%DATA) + END SUBROUTINE ComputeDenseLogarithm_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE ExponentialSolversModule_wrp diff --git a/Source/Wrapper/FermiOperatorModule_wrp.F90 b/Source/Wrapper/FermiOperatorModule_wrp.F90 new file mode 100644 index 00000000..e2186dfd --- /dev/null +++ b/Source/Wrapper/FermiOperatorModule_wrp.F90 @@ -0,0 +1,44 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> Wraps the density matrix solvers module for calling from other languages. +MODULE FermiOperatorModule_wrp + USE DataTypesModule, ONLY : NTREAL + USE FermiOperatorModule, ONLY : ComputeDenseFOE + USE PSMatrixModule_wrp, ONLY : Matrix_ps_wrp + USE SolverParametersModule_wrp, ONLY : SolverParameters_wrp + USE WrapperModule, ONLY : SIZE_wrp + USE ISO_C_BINDING, ONLY : c_int + IMPLICIT NONE + PRIVATE +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + PUBLIC :: ComputeDenseFOE_wrp +CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the density matrix from a Hamiltonian using the PM method. + SUBROUTINE ComputeDenseFOE_wrp(ih_Hamiltonian, ih_InverseSquareRoot, trace, & + & ih_Density, inv_temp_in, energy_value_out, chemical_potential_out, & + & ih_solver_parameters) BIND(c,name="ComputeDenseFOE_wrp") + INTEGER(kind=c_int), INTENT(IN) :: ih_Hamiltonian(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_InverseSquareRoot(SIZE_wrp) + REAL(NTREAL), INTENT(IN) :: trace + INTEGER(kind=c_int), INTENT(INOUT) :: ih_Density(SIZE_wrp) + REAL(NTREAL), INTENT(IN) :: inv_temp_in + REAL(NTREAL), INTENT(OUT) :: energy_value_out + REAL(NTREAL), INTENT(OUT) :: chemical_potential_out + INTEGER(kind=c_int), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_Hamiltonian + TYPE(Matrix_ps_wrp) :: h_InverseSquareRoot + TYPE(Matrix_ps_wrp) :: h_Density + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_Hamiltonian = TRANSFER(ih_Hamiltonian,h_Hamiltonian) + h_InverseSquareRoot = TRANSFER(ih_InverseSquareRoot,h_InverseSquareRoot) + h_Density = TRANSFER(ih_Density,h_Density) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL ComputeDenseFOE(h_Hamiltonian%DATA, h_InverseSquareRoot%DATA, & + & trace, h_Density%DATA, inv_temp_in=inv_temp_in, & + & energy_value_out=energy_value_out, & + & chemical_potential_out=chemical_potential_out, & + & solver_parameters_in=h_solver_parameters%DATA) + END SUBROUTINE ComputeDenseFOE_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +END MODULE FermiOperatorModule_wrp diff --git a/Source/Wrapper/InverseSolversModule_wrp.F90 b/Source/Wrapper/InverseSolversModule_wrp.F90 index 3612dd08..f3f9bbbc 100644 --- a/Source/Wrapper/InverseSolversModule_wrp.F90 +++ b/Source/Wrapper/InverseSolversModule_wrp.F90 @@ -1,7 +1,7 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Wraps the matrix inversion module for calling from other languages. MODULE InverseSolversModule_wrp - USE InverseSolversModule, ONLY : Invert, PseudoInverse + USE InverseSolversModule, ONLY : Invert, DenseInvert, PseudoInverse USE PSMatrixModule_wrp, ONLY : Matrix_ps_wrp USE SolverParametersModule_wrp, ONLY : SolverParameters_wrp USE WrapperModule, ONLY : SIZE_wrp @@ -10,6 +10,7 @@ MODULE InverseSolversModule_wrp PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: Invert_wrp + PUBLIC :: DenseInvert_wrp PUBLIC :: PseudoInverse_wrp CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the inverse of a matrix. @@ -28,6 +29,23 @@ SUBROUTINE Invert_wrp(ih_Mat1, ih_InverseMat, ih_solver_parameters) & CALL Invert(h_Mat1%DATA, h_InverseMat%DATA, h_solver_parameters%DATA) END SUBROUTINE Invert_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the inverse of a matrix (dense version). + SUBROUTINE DenseInvert_wrp(ih_Mat1, ih_InverseMat, ih_solver_parameters) & + & BIND(c,name="DenseInvert_wrp") + INTEGER(kind=c_int), INTENT(IN) :: ih_Mat1(SIZE_wrp) + INTEGER(kind=c_int), INTENT(INOUT) :: ih_InverseMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_Mat1 + TYPE(Matrix_ps_wrp) :: h_InverseMat + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_Mat1 = TRANSFER(ih_Mat1,h_Mat1) + h_InverseMat = TRANSFER(ih_InverseMat,h_InverseMat) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL DenseInvert(h_Mat1%DATA, h_InverseMat%DATA, h_solver_parameters%DATA) + END SUBROUTINE DenseInvert_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the pseudoinverse of a matrix. SUBROUTINE PseudoInverse_wrp(ih_Mat1, ih_InverseMat, ih_solver_parameters) & diff --git a/Source/Wrapper/SignSolversModule_wrp.F90 b/Source/Wrapper/SignSolversModule_wrp.F90 index c09831d1..b1ac3d78 100644 --- a/Source/Wrapper/SignSolversModule_wrp.F90 +++ b/Source/Wrapper/SignSolversModule_wrp.F90 @@ -2,7 +2,8 @@ !> Wraps the sign solvers module for calling from other languages. MODULE SignSolversModule_wrp USE PSMatrixModule_wrp, ONLY : Matrix_ps_wrp - USE SignSolversModule, ONLY : SignFunction, PolarDecomposition + USE SignSolversModule, ONLY : SignFunction, DenseSignFunction, & + & PolarDecomposition USE SolverParametersModule_wrp, ONLY : SolverParameters_wrp USE WrapperModule, ONLY : SIZE_wrp USE ISO_C_BINDING, ONLY : c_int @@ -10,6 +11,7 @@ MODULE SignSolversModule_wrp PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: SignFunction_wrp + PUBLIC :: DenseSignFunction_wrp PUBLIC :: PolarDecomposition_wrp CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Computes the matrix sign function. @@ -28,6 +30,24 @@ SUBROUTINE SignFunction_wrp(ih_Mat1, ih_SignMat, ih_solver_parameters) & CALL SignFunction(h_Mat1%DATA, h_SignMat%DATA, h_solver_parameters%DATA) END SUBROUTINE SignFunction_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Computes the matrix sign function (dense versoin). + SUBROUTINE DenseSignFunction_wrp(ih_Mat1, ih_SignMat, ih_solver_parameters) & + & BIND(c,name="DenseSignFunction_wrp") + INTEGER(kind=c_int), INTENT(IN) :: ih_Mat1(SIZE_wrp) + INTEGER(kind=c_int), INTENT(INOUT) :: ih_SignMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_Mat1 + TYPE(Matrix_ps_wrp) :: h_SignMat + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_Mat1 = TRANSFER(ih_Mat1,h_Mat1) + h_SignMat = TRANSFER(ih_SignMat,h_SignMat) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL DenseSignFunction(h_Mat1%DATA, h_SignMat%DATA, & + & h_solver_parameters%DATA) + END SUBROUTINE DenseSignFunction_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Computes the polar decomposition of a matrix Mat1 = U*H. SUBROUTINE PolarDecomposition_wrp(ih_Mat1, ih_Umat, ih_Hmat, & diff --git a/Source/Wrapper/SquareRootSolversModule_wrp.F90 b/Source/Wrapper/SquareRootSolversModule_wrp.F90 index 8d97129e..d600073e 100644 --- a/Source/Wrapper/SquareRootSolversModule_wrp.F90 +++ b/Source/Wrapper/SquareRootSolversModule_wrp.F90 @@ -3,14 +3,17 @@ MODULE SquareRootSolversModule_wrp USE PSMatrixModule_wrp, ONLY : Matrix_ps_wrp USE SolverParametersModule_wrp, ONLY : SolverParameters_wrp - USE SquareRootSolversModule, ONLY : SquareRoot, InverseSquareRoot + USE SquareRootSolversModule, ONLY : SquareRoot, InverseSquareRoot, & + & DenseSquareRoot, DenseInverseSquareRoot USE WrapperModule, ONLY : SIZE_wrp USE ISO_C_BINDING, ONLY : c_int, c_bool IMPLICIT NONE PRIVATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: SquareRoot_wrp + PUBLIC :: DenseSquareRoot_wrp PUBLIC :: InverseSquareRoot_wrp + PUBLIC :: DenseInverseSquareRoot_wrp CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the inverse square root of a matrix. SUBROUTINE InverseSquareRoot_wrp(ih_Mat1, ih_InverseSquareRootMat, & @@ -30,6 +33,25 @@ SUBROUTINE InverseSquareRoot_wrp(ih_Mat1, ih_InverseSquareRootMat, & CALL InverseSquareRoot(h_Mat1%DATA, h_InverseSquareRootMat%DATA, & & h_solver_parameters%DATA) END SUBROUTINE InverseSquareRoot_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the inverse square root of a matrix (dense version). + SUBROUTINE DenseInverseSquareRoot_wrp(ih_Mat1, ih_InverseSquareRootMat, & + & ih_solver_parameters) BIND(c,name="DenseInverseSquareRoot_wrp") + INTEGER(kind=c_int), INTENT(IN) :: ih_Mat1(SIZE_wrp) + INTEGER(kind=c_int), INTENT(INOUT) :: ih_InverseSquareRootMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_Mat1 + TYPE(Matrix_ps_wrp) :: h_InverseSquareRootMat + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_Mat1 = TRANSFER(ih_Mat1,h_Mat1) + h_InverseSquareRootMat = TRANSFER(ih_InverseSquareRootMat, & + & h_InverseSquareRootMat) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL DenseInverseSquareRoot(h_Mat1%DATA, h_InverseSquareRootMat%DATA, & + & h_solver_parameters%DATA) + END SUBROUTINE DenseInverseSquareRoot_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the square root of a matrix. SUBROUTINE SquareRoot_wrp(ih_Mat1, ih_SquareRootMat, ih_solver_parameters) & @@ -48,5 +70,23 @@ SUBROUTINE SquareRoot_wrp(ih_Mat1, ih_SquareRootMat, ih_solver_parameters) & CALL SquareRoot(h_Mat1%DATA, h_SquareRootMat%DATA, & & h_solver_parameters%DATA) END SUBROUTINE SquareRoot_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the square root of a matrix (dense version). + SUBROUTINE DenseSquareRoot_wrp(ih_Mat1, ih_SquareRootMat, & + & ih_solver_parameters) BIND(c,name="DenseSquareRoot_wrp") + INTEGER(kind=c_int), INTENT(IN) :: ih_Mat1(SIZE_wrp) + INTEGER(kind=c_int), INTENT(INOUT) :: ih_SquareRootMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_Mat1 + TYPE(Matrix_ps_wrp) :: h_SquareRootMat + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_Mat1 = TRANSFER(ih_Mat1,h_Mat1) + h_SquareRootMat = TRANSFER(ih_SquareRootMat, h_SquareRootMat) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL DenseSquareRoot(h_Mat1%DATA, h_SquareRootMat%DATA, & + & h_solver_parameters%DATA) + END SUBROUTINE DenseSquareRoot_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE SquareRootSolversModule_wrp diff --git a/Source/Wrapper/TrigonometrySolversModule_wrp.F90 b/Source/Wrapper/TrigonometrySolversModule_wrp.F90 index 2271be9a..c1023285 100644 --- a/Source/Wrapper/TrigonometrySolversModule_wrp.F90 +++ b/Source/Wrapper/TrigonometrySolversModule_wrp.F90 @@ -3,7 +3,7 @@ MODULE TrigonometrySolversModule_wrp USE PSMatrixModule_wrp, ONLY : Matrix_ps_wrp USE SolverParametersModule_wrp, ONLY : SolverParameters_wrp - USE TrigonometrySolversModule, ONLY : Sine, Cosine + USE TrigonometrySolversModule, ONLY : Sine, Cosine, DenseSine, DenseCosine USE WrapperModule, ONLY : SIZE_wrp USE iso_c_binding, ONLY : c_int, c_bool IMPLICIT NONE @@ -29,6 +29,24 @@ SUBROUTINE Sine_wrp(ih_InputMat, ih_OutputMat, ih_solver_parameters) & CALL Sine(h_InputMat%DATA, h_OutputMat%DATA, & & h_solver_parameters%DATA) END SUBROUTINE Sine_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the sine of a matrix (dense version). + SUBROUTINE DenseSine_wrp(ih_InputMat, ih_OutputMat, ih_solver_parameters) & + & BIND(c,name="DenseSine_wrp") + INTEGER(kind=c_int), INTENT(IN) :: ih_InputMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(INOUT) :: ih_OutputMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_InputMat + TYPE(Matrix_ps_wrp) :: h_OutputMat + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_InputMat = TRANSFER(ih_InputMat,h_InputMat) + h_OutputMat = TRANSFER(ih_OutputMat, h_OutputMat) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL DenseSine(h_InputMat%DATA, h_OutputMat%DATA, & + & h_solver_parameters%DATA) + END SUBROUTINE DenseSine_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Compute the cosine of a matrix. SUBROUTINE Cosine_wrp(ih_InputMat, ih_OutputMat, ih_solver_parameters) & @@ -47,5 +65,23 @@ SUBROUTINE Cosine_wrp(ih_InputMat, ih_OutputMat, ih_solver_parameters) & CALL Cosine(h_InputMat%DATA, h_OutputMat%DATA, & & h_solver_parameters%DATA) END SUBROUTINE Cosine_wrp +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> Compute the cosine of a matrix (dense version). + SUBROUTINE DenseCosine_wrp(ih_InputMat, ih_OutputMat, ih_solver_parameters) & + & BIND(c,name="DenseCosine_wrp") + INTEGER(kind=c_int), INTENT(IN) :: ih_InputMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(INOUT) :: ih_OutputMat(SIZE_wrp) + INTEGER(kind=c_int), INTENT(IN) :: ih_solver_parameters(SIZE_wrp) + TYPE(Matrix_ps_wrp) :: h_InputMat + TYPE(Matrix_ps_wrp) :: h_OutputMat + TYPE(SolverParameters_wrp) :: h_solver_parameters + + h_InputMat = TRANSFER(ih_InputMat,h_InputMat) + h_OutputMat = TRANSFER(ih_OutputMat, h_OutputMat) + h_solver_parameters = TRANSFER(ih_solver_parameters, h_solver_parameters) + + CALL DenseCosine(h_InputMat%DATA, h_OutputMat%DATA, & + & h_solver_parameters%DATA) + END SUBROUTINE DenseCosine_wrp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE TrigonometrySolversModule_wrp diff --git a/Targets/Mac-conda.cmake b/Targets/Mac-conda.cmake index 973936a7..021ac56e 100644 --- a/Targets/Mac-conda.cmake +++ b/Targets/Mac-conda.cmake @@ -9,7 +9,8 @@ set(PYTHON_EXECUTABLE python) set(Python_FIND_STRATEGY LOCATION) # Library Files -set(TOOLCHAIN_LIBS "-framework Accelerate -lgomp") +set(TOOLCHAIN_LIBS "-framework Accelerate -lgomp \ + -L/usr/local/Cellar/scalapack/2.2.0/lib/ -lscalapack") # Release Suggestions set(CXX_TOOLCHAINFLAGS_RELEASE "-O3 -openmp") diff --git a/UnitTests/test_chemistry.py b/UnitTests/test_chemistry.py index 55626277..3927617f 100644 --- a/UnitTests/test_chemistry.py +++ b/UnitTests/test_chemistry.py @@ -159,6 +159,28 @@ def compute_cp(self): cp = eig_vals[homo] + (eig_vals[lumo] - eig_vals[homo]) / 2.0 return cp, eig_vals[homo], eig_vals[lumo] + def check_energy(self, energy): + '''Compute the chemical potential, homo, lumo''' + from scipy.io import mmread + from helpers import THRESHOLD + from scipy.linalg import eigh + from numpy import floor, ceil + + fock_matrix = mmread(self.hamiltonian) + overlap_matrix = mmread(self.overlap) + + eig_vals = eigh(a=fock_matrix.todense(), b=overlap_matrix.todense(), + eigvals_only=True) + + computed = 0 + for i, v in enumerate(eig_vals): + if i < floor(self.nel): + computed += 2.0*v + elif ceil(self.nel) == i: + computed += 2.0*(ceil(self.nel) - self.nel) * v + + self.assertLessEqual(abs(energy - computed), THRESHOLD) + def check_cp(self, computed): '''Compare two computed chemical potentials.''' cp, homo, lumo = self.compute_cp() @@ -168,7 +190,7 @@ def check_cp(self, computed): else: self.assertTrue(False) - def basic_solver(self, SRoutine, cpcheck=True): + def basic_solver(self, SRoutine, cpcheck=True, temp=None): '''Test various kinds of density matrix solvers.''' from helpers import result_file @@ -185,10 +207,21 @@ def basic_solver(self, SRoutine, cpcheck=True): nt.SquareRootSolvers.InverseSquareRoot(overlap_matrix, inverse_sqrt_matrix, self.solver_parameters) - energy_value, chemical_potential = SRoutine(fock_matrix, - inverse_sqrt_matrix, - self.nel, density_matrix, - self.solver_parameters) + if temp is None: + energy_value, chemical_potential = SRoutine(fock_matrix, + inverse_sqrt_matrix, + self.nel, + density_matrix, + self.solver_parameters) + else: + inv_temp = 1/(temp * 3.166811563*10**(-6)) + print("::: Temperature", temp, inv_temp, self.nel) + energy_value, chemical_potential = SRoutine(fock_matrix, + inverse_sqrt_matrix, + self.nel, + density_matrix, + inv_temp, + self.solver_parameters) density_matrix.WriteToMatrixMarket(result_file) comm.barrier() @@ -196,6 +229,7 @@ def basic_solver(self, SRoutine, cpcheck=True): self.check_full() if cpcheck: self.check_cp(chemical_potential) + self.check_energy(energy_value) comm.barrier() def test_scaleandfold(self): @@ -245,6 +279,14 @@ def test_HPCP(self): '''Test routines to compute the density matrix with HPCP.''' self.basic_solver(nt.DensityMatrixSolvers.HPCP) + def test_densedensity(self): + '''Test routines to compute the density matrix with Dense Method.''' + self.basic_solver(nt.DensityMatrixSolvers.DenseDensity) + + def test_foe_low(self): + '''Test the fermi operator expansion at a low temperature.''' + self.basic_solver(nt.FermiOperator.ComputeDenseFOE, temp=50) + def test_energy_density(self): '''Test the routines to compute the weighted-energy density matrix.''' from helpers import THRESHOLD, result_file diff --git a/UnitTests/test_solvers.py b/UnitTests/test_solvers.py index 53207cd6..a0bdac13 100644 --- a/UnitTests/test_solvers.py +++ b/UnitTests/test_solvers.py @@ -159,6 +159,28 @@ def test_invert(self): self.check_result() + def test_denseinvert(self): + '''Test routines to invert matrices.''' + from scipy.sparse.linalg import inv + from scipy.sparse import csc_matrix + # Starting Matrix + matrix1 = self.create_matrix() + self.write_matrix(matrix1, self.input_file) + + # Check Matrix + self.CheckMat = inv(csc_matrix(matrix1)) + + # Result Matrix + overlap_matrix = nt.Matrix_ps(self.input_file, False) + inverse_matrix = nt.Matrix_ps(self.mat_dim) + + nt.InverseSolvers.DenseInvert(overlap_matrix, inverse_matrix, self.isp) + + inverse_matrix.WriteToMatrixMarket(result_file) + comm.barrier() + + self.check_result() + def test_pseudoinverse(self): '''Test routines to compute the pseudoinverse of matrices.''' from scipy.linalg import pinv @@ -209,6 +231,29 @@ def test_inversesquareroot(self): self.check_result() + def test_denseinversesquareroot(self): + '''Test routines to compute the inverse square root of matrices.''' + from scipy.linalg import funm + from numpy import sqrt + # Starting Matrix. Care taken to make sure eigenvalues are positive. + matrix1 = self.create_matrix(SPD=True, diag_dom=True) + self.write_matrix(matrix1, self.input_file) + + # Check Matrix + dense_check = funm(matrix1.todense(), lambda x: 1.0 / sqrt(x)) + self.CheckMat = csr_matrix(dense_check) + + # Result Matrix + overlap_matrix = nt.Matrix_ps(self.input_file, False) + inverse_matrix = nt.Matrix_ps(self.mat_dim) + nt.SquareRootSolvers.DenseInverseSquareRoot(overlap_matrix, + inverse_matrix, + self.isp) + inverse_matrix.WriteToMatrixMarket(result_file) + comm.barrier() + + self.check_result() + def test_squareroot(self): '''Test routines to compute the square root of matrices.''' from scipy.linalg import funm @@ -233,6 +278,28 @@ def test_squareroot(self): self.check_result() + def test_densesquareroot(self): + '''Test routines to compute the square root of matrices.''' + from scipy.linalg import funm + from numpy import sqrt + # Starting Matrix. Care taken to make sure eigenvalues are positive. + matrix1 = self.create_matrix(SPD=True) + self.write_matrix(matrix1, self.input_file) + + # Check Matrix + dense_check = funm(matrix1.todense(), lambda x: sqrt(x)) + self.CheckMat = csr_matrix(dense_check) + + # Result Matrix + input_matrix = nt.Matrix_ps(self.input_file, False) + root_matrix = nt.Matrix_ps(self.mat_dim) + nt.SquareRootSolvers.DenseSquareRoot(input_matrix, root_matrix, + self.isp) + root_matrix.WriteToMatrixMarket(result_file) + comm.barrier() + + self.check_result() + def test_inverseroot(self): '''Test routines to compute general matrix inverse root.''' from scipy.linalg import funm @@ -316,6 +383,27 @@ def test_signfunction(self): self.check_result() + def test_densesignfunction(self): + '''Test routines to compute the matrix sign function.''' + from scipy.linalg import funm + from numpy import sign + # Starting Matrix + matrix1 = self.create_matrix() + self.write_matrix(matrix1, self.input_file) + + # Check Matrix + dense_check = funm(matrix1.todense(), lambda x: sign(x)) + self.CheckMat = csr_matrix(dense_check) + + # Result Matrix + input_matrix = nt.Matrix_ps(self.input_file, False) + sign_matrix = nt.Matrix_ps(self.mat_dim) + nt.SignSolvers.ComputeDenseSign(input_matrix, sign_matrix, self.isp) + sign_matrix.WriteToMatrixMarket(result_file) + comm.barrier() + + self.check_result() + def test_exponentialfunction(self): '''Test routines to compute the matrix exponential.''' from scipy.linalg import funm @@ -341,6 +429,29 @@ def test_exponentialfunction(self): self.check_result() + def test_denseexponential(self): + '''Test routines to compute the matrix exponential.''' + from scipy.linalg import funm + from numpy import exp + # Starting Matrix + matrix1 = 8 * self.create_matrix(scaled=True) + self.write_matrix(matrix1, self.input_file) + + # Check Matrix + dense_check = funm(matrix1.todense(), lambda x: exp(x)) + self.CheckMat = csr_matrix(dense_check) + + # Result Matrix + input_matrix = nt.Matrix_ps(self.input_file, False) + exp_matrix = nt.Matrix_ps(self.mat_dim) + nt.ExponentialSolvers.ComputeDenseExponential(input_matrix, + exp_matrix, + self.fsp) + exp_matrix.WriteToMatrixMarket(result_file) + comm.barrier() + + self.check_result() + def test_exponentialpade(self): ''' Test routines to compute the matrix exponential using the pade method. @@ -393,6 +504,28 @@ def test_logarithmfunction(self): self.check_result() + def test_denselogarithm(self): + '''Test routines to compute the matrix logarithm.''' + from scipy.linalg import funm + from numpy import log + # Starting Matrix. Care taken to make sure eigenvalues are positive. + matrix1 = self.create_matrix(scaled=True, diag_dom=True) + self.write_matrix(matrix1, self.input_file) + + # Check Matrix + dense_check = funm(matrix1.todense(), lambda x: log(x)) + self.CheckMat = csr_matrix(dense_check) + + # Result Matrix + input_matrix = nt.Matrix_ps(self.input_file, False) + log_matrix = nt.Matrix_ps(self.mat_dim) + nt.ExponentialSolvers.ComputeDenseLogarithm(input_matrix, log_matrix, + self.fsp) + log_matrix.WriteToMatrixMarket(result_file) + comm.barrier() + + self.check_result() + def test_exponentialround(self): ''' Test routines to compute the matrix exponential using a round @@ -441,6 +574,27 @@ def test_sinfunction(self): self.check_result() + def test_densesinfunction(self): + '''Test routines to compute the matrix sine.''' + from scipy.linalg import funm + from numpy import sin + # Starting Matrix + matrix1 = self.create_matrix() + self.write_matrix(matrix1, self.input_file) + + # Check Matrix + dense_check = funm(matrix1.todense(), lambda x: sin(x)) + self.CheckMat = csr_matrix(dense_check) + + # Result Matrix + input_matrix = nt.Matrix_ps(self.input_file, False) + sin_matrix = nt.Matrix_ps(self.mat_dim) + nt.TrigonometrySolvers.DenseSine(input_matrix, sin_matrix, self.fsp) + sin_matrix.WriteToMatrixMarket(result_file) + comm.barrier() + + self.check_result() + def test_cosfunction(self): '''Test routines to compute the matrix cosine.''' from scipy.linalg import funm @@ -465,6 +619,27 @@ def test_cosfunction(self): self.check_result() + def test_densecosfunction(self): + '''Test routines to compute the matrix cosine.''' + from scipy.linalg import funm + from numpy import cos + # Starting Matrix + matrix1 = self.create_matrix() + self.write_matrix(matrix1, self.input_file) + + # Check Matrix + dense_check = funm(matrix1.todense(), lambda x: cos(x)) + self.CheckMat = csr_matrix(dense_check) + + # Result Matrix + input_matrix = nt.Matrix_ps(self.input_file, False) + cos_matrix = nt.Matrix_ps(self.mat_dim) + nt.TrigonometrySolvers.DenseCosine(input_matrix, cos_matrix, self.fsp) + cos_matrix.WriteToMatrixMarket(result_file) + comm.barrier() + + self.check_result() + def test_hornerfunction(self): ''' Test routines to compute a matrix polynomial using horner's @@ -731,6 +906,155 @@ def test_polarfunction(self): self.check_result() + def test_eigendecomposition(self): + '''Test routines to compute eigendecomposition of matrices.''' + from scipy.linalg import eigh + from scipy.sparse import csc_matrix, diags + # Starting Matrix + matrix1 = self.create_matrix() + self.write_matrix(matrix1, self.input_file) + + # Check Matrix + vals, vecs = eigh(matrix1.todense()) + + # Result Matrix + matrix = nt.Matrix_ps(self.input_file, False) + vec_matrix = nt.Matrix_ps(self.mat_dim) + val_matrix = nt.Matrix_ps(self.mat_dim) + + nt.EigenSolvers.EigenDecomposition(matrix, val_matrix, self.mat_dim, + vec_matrix, self.isp) + + # Check the eigenvalues + val_matrix.WriteToMatrixMarket(result_file) + self.CheckMat = csc_matrix(diags(vals)) + comm.barrier() + self.check_result() + + # Check the eigenvectors + reconstructed = nt.Matrix_ps(self.mat_dim) + temp = nt.Matrix_ps(self.mat_dim) + vec_matrix_t = nt.Matrix_ps(self.mat_dim) + memory_pool = nt.PMatrixMemoryPool(matrix) + temp.Gemm(vec_matrix, val_matrix, memory_pool) + vec_matrix_t.Transpose(vec_matrix) + vec_matrix_t.Conjugate() + reconstructed.Gemm(temp, vec_matrix_t, memory_pool) + reconstructed.WriteToMatrixMarket(result_file) + + self.CheckMat = matrix1 + comm.barrier() + self.check_result() + + def test_eigendecomposition_partial(self): + '''Test routines to compute partial eigendecomposition of matrices.''' + from scipy.linalg import eigh + from scipy.sparse import csc_matrix, diags + # Starting Matrix + matrix1 = self.create_matrix() + self.write_matrix(matrix1, self.input_file) + nvals = int(self.mat_dim/2) + + # Check Matrix + vals, vecs = eigh(matrix1.todense()) + + # Result Matrix + matrix = nt.Matrix_ps(self.input_file, False) + vec_matrix = nt.Matrix_ps(self.mat_dim) + val_matrix = nt.Matrix_ps(self.mat_dim) + + nt.EigenSolvers.EigenDecomposition(matrix, val_matrix, nvals, + vec_matrix, self.isp) + + # Check the eigenvalues + val_matrix.WriteToMatrixMarket(result_file) + vals[nvals:] = 0 + self.CheckMat = csc_matrix(diags(vals)) + comm.barrier() + self.check_result() + + # Check the eigenvectors + reconstructed = nt.Matrix_ps(self.mat_dim) + temp = nt.Matrix_ps(self.mat_dim) + vec_matrix_t = nt.Matrix_ps(self.mat_dim) + memory_pool = nt.PMatrixMemoryPool(matrix) + temp.Gemm(vec_matrix, val_matrix, memory_pool) + vec_matrix_t.Transpose(vec_matrix) + vec_matrix_t.Conjugate() + reconstructed.Gemm(temp, vec_matrix_t, memory_pool) + reconstructed.WriteToMatrixMarket(result_file) + + self.CheckMat = csc_matrix((vecs*vals).dot(vecs.conj().T)) + comm.barrier() + self.check_result() + + def test_eigendecomposition_novecs(self): + '''Test routines to compute eigenvalues (only) of matrices.''' + from scipy.linalg import eigh + from scipy.sparse import csc_matrix, diags + # Starting Matrix + matrix1 = self.create_matrix() + self.write_matrix(matrix1, self.input_file) + nvals = int(self.mat_dim/2) + + # Check Matrix + vals, _ = eigh(matrix1.todense()) + + # Result Matrix + matrix = nt.Matrix_ps(self.input_file, False) + val_matrix = nt.Matrix_ps(self.mat_dim) + + nt.EigenSolvers.EigenValues(matrix, val_matrix, nvals, self.isp) + + # Check the eigenvalues + val_matrix.WriteToMatrixMarket(result_file) + vals[nvals:] = 0 + self.CheckMat = csc_matrix(diags(vals)) + comm.barrier() + self.check_result() + + def test_svd(self): + '''Test routines to compute the SVD of matrices.''' + from scipy.linalg import svd + from scipy.sparse import csc_matrix, diags + # Starting Matrix + matrix1 = self.create_matrix() + self.write_matrix(matrix1, self.input_file) + + # Check Matrix + u, s, vh = svd(matrix1.todense()) + + # Result Matrix + matrix = nt.Matrix_ps(self.input_file, False) + left_matrix = nt.Matrix_ps(self.mat_dim) + right_matrix = nt.Matrix_ps(self.mat_dim) + val_matrix = nt.Matrix_ps(self.mat_dim) + + nt.EigenSolvers.SingularValueDecomposition(matrix, left_matrix, + right_matrix, val_matrix, + self.isp) + + # Check the singular values. + val_matrix.WriteToMatrixMarket(result_file) + self.CheckMat = csc_matrix(diags(sorted(s))) + comm.barrier() + self.check_result() + + # Check the singular vectors. + reconstructed = nt.Matrix_ps(self.mat_dim) + temp = nt.Matrix_ps(self.mat_dim) + right_matrix_t = nt.Matrix_ps(self.mat_dim) + right_matrix_t.Transpose(right_matrix) + right_matrix_t.Conjugate() + memory_pool = nt.PMatrixMemoryPool(matrix) + temp.Gemm(left_matrix, val_matrix, memory_pool) + reconstructed.Gemm(temp, right_matrix_t, memory_pool) + reconstructed.WriteToMatrixMarket(result_file) + + self.CheckMat = matrix1 + comm.barrier() + self.check_result() + class TestSolvers_r(TestSolvers): def test_cholesky(self):